--- /dev/null
+.bin
+*.fasl*
+*.dfsl
+*.pfsl
+*.ufsl
+*.fas
+*.x86f
+*.sparcf
+*.cfsl
--- /dev/null
+Copyright (c) 2002-2003 by Kevin Rosenberg
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+3. The name of the Authors may not be used to endorse or promote products
+ derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
+BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
+IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: base64.asd
+;;;; Purpose: ASDF definition file for Base64
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Dec 2002
+;;;;
+;;;; $Id: base64.asd,v 1.1 2002/12/29 06:08:15 kevin Exp $
+;;;; *************************************************************************
+
+(in-package :asdf)
+
+(defsystem :base64
+ :name "cl-base64"
+ :author "Kevin M. Rosenberg and Juri Pakaste"
+ :version "1.0"
+ :maintainer "Kevin M. Rosenberg <kmr@debian.org>"
+ :licence "Public domain"
+ :description "Base64 encode and decoding"
+
+ :perform (load-op :after (op base64)
+ (pushnew :base64 cl:*features*))
+
+ :components
+ ((:file "base64")))
--- /dev/null
+;;;; This file implements the Base64 transfer encoding algorithm as
+;;;; defined in RFC 1521 by Borensten & Freed, September 1993.
+;;;; See: http://www.ietf.org/rfc/rfc1521.txt
+;;;;
+;;;; Based on initial public domain code by Juri Pakaste <juri@iki.fi>
+;;;;
+;;;; Extended by Kevin M. Rosenberg <kevin@rosenberg.net>:
+;;;; - .asd file
+;;;; - numerous speed optimizations
+;;;; - conversion to and from integers
+;;;; - Renamed functions now that supporting integer conversions
+;;;; - URI-compatible encoding using :uri key
+;;;;
+;;;; Copyright 2002-2003 Kevin M. Rosenberg
+;;;; Permission to use with BSD-style license included in the COPYING file
+;;;;
+;;;; $Id: base64.lisp,v 1.1 2002/12/29 06:08:15 kevin Exp $
+
+(defpackage #:base64
+ (:use #:cl)
+ (:export #:base64-to-string #:base64-to-integer
+ #:string-to-base64 #:integer-to-base64))
+
+(in-package #:base64)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defparameter *encode-table*
+ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
+ (declaim (type simple-string *encode-table*))
+
+ (defparameter *uri-encode-table*
+ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_")
+ (declaim (type simple-string *uri-encode-table*))
+
+ (deftype decode-table () '(simple-array fixnum (256)))
+
+ (defparameter *decode-table*
+ (let ((da (make-array 256 :adjustable nil :fill-pointer nil
+ :element-type 'fixnum
+ :initial-element -1)))
+ (loop for char of-type character across *encode-table*
+ for index of-type fixnum from 0 below 64
+ do (setf (aref da (the fixnum (char-code char))) index))
+ da))
+
+ (defparameter *uri-decode-table*
+ (let ((da (make-array 256 :adjustable nil :fill-pointer nil
+ :element-type 'fixnum
+ :initial-element -1)))
+ (loop
+ for char of-type character across *uri-encode-table*
+ for index of-type fixnum from 0 below 64
+ do (setf (aref da (the fixnum (char-code char))) index))
+ da))
+
+ (declaim (type decode-table *decode-table* *uri-decode-table*))
+
+ (defparameter *pad-char* #\=)
+ (defparameter *uri-pad-char* #\.))
+
+(defun string-to-base64 (string &key (uri nil))
+ "Encode a string array to base64."
+ (declare (string string)
+ (optimize (speed 3)))
+ (let ((pad (if uri *uri-pad-char* *pad-char*))
+ (encode-table (if uri *uri-encode-table* *encode-table*)))
+ (declare (simple-string encode-table)
+ (character pad))
+ (let* ((string-length (length string))
+ (result (make-string
+ (* 4 (truncate (/ (+ 2 string-length) 3))))))
+ (declare (fixnum string-length)
+ (simple-string result))
+ (do ((sidx 0 (the fixnum (+ sidx 3)))
+ (didx 0 (the fixnum (+ didx 4)))
+ (chars 2 2)
+ (value 0 0))
+ ((>= sidx string-length) t)
+ (declare (fixnum sidx didx chars value))
+ (setf value (ash (logand #xFF (char-code (char string sidx))) 8))
+ (dotimes (n 2)
+ (declare (fixnum n))
+ (when (< (the fixnum (+ sidx n 1)) string-length)
+ (setf value
+ (logior value
+ (the fixnum
+ (logand #xFF
+ (the fixnum
+ (char-code (char string
+ (the fixnum
+ (+ sidx n 1)))))))))
+ (incf chars))
+ (when (zerop n)
+ (setf value (the fixnum (ash value 8)))))
+ (setf (schar result (the fixnum (+ didx 3)))
+ (if (> chars 3)
+ (schar encode-table (logand value #x3F))
+ pad))
+ (setf value (the fixnum (ash value -6)))
+ (setf (schar result (the fixnum (+ didx 2)))
+ (if (> chars 2)
+ (schar encode-table (logand value #x3F))
+ pad))
+ (setf value (the fixnum (ash value -6)))
+ (setf (schar result (the fixnum (1+ didx)))
+ (schar encode-table (logand value #x3F)))
+ (setf value (the fixnum (ash value -6)))
+ (setf (schar result didx)
+ (schar encode-table (logand value #x3F))))
+ result)))
+
+
+(defun round-next-multiple (x n)
+ "Round x up to the next highest multiple of n"
+ (declare (fixnum n)
+ (optimize (speed 3)))
+ (let ((remainder (mod x n)))
+ (declare (fixnum remainder))
+ (if (zerop remainder)
+ x
+ (the fixnum (+ x (the fixnum (- n remainder)))))))
+
+(defun integer-to-base64 (input &key (uri nil))
+ "Encode an integer to base64 format."
+ (declare (integer input)
+ (optimize (speed 3)))
+ (let ((pad (if uri *uri-pad-char* *pad-char*))
+ (encode-table (if uri *uri-encode-table* *encode-table*)))
+ (declare (simple-string encode-table)
+ (character pad))
+ (do* ((input-bits (integer-length input))
+ (byte-bits (round-next-multiple input-bits 8))
+ (padded-bits (round-next-multiple byte-bits 6))
+ (remainder-padding (mod padded-bits 24))
+ (padding-bits (if (zerop remainder-padding)
+ 0
+ (- 24 remainder-padding)))
+ (strlen (/ (+ padded-bits padding-bits) 6))
+ (padding-chars (/ padding-bits 6))
+ (nonpad-chars (- strlen padding-chars))
+ (last-nonpad-char (1- nonpad-chars))
+ (str (make-string strlen))
+ (strpos 0 (1+ strpos))
+ (int (ash input (/ padding-bits 3)) (ash int -6))
+ (6bit-value (logand int #x3f) (logand int #x3f)))
+ ((= strpos nonpad-chars)
+ (dotimes (ipad padding-chars)
+ (setf (schar str strpos) pad)
+ (incf strpos))
+ str)
+ (declare (fixnum 6bit-value strpos strlen last-nonpad-char)
+ (integer int))
+ (setf (schar str (the fixnum (- last-nonpad-char strpos)))
+ (schar encode-table 6bit-value)))))
+
+;;; Decoding
+
+(defun base64-to-string (string &key (uri nil))
+ "Decode a base64 string to a string array."
+ (declare (string string)
+ (optimize (speed 3)))
+ (let ((pad (if uri *uri-pad-char* *pad-char*))
+ (decode-table (if uri *uri-decode-table* *decode-table*)))
+ (declare (type decode-table decode-table)
+ (character pad))
+ (let ((result (make-string (* 3 (truncate (/ (length string) 4)))))
+ (ridx 0))
+ (declare (simple-string result)
+ (fixnum ridx))
+ (loop
+ for char of-type character across string
+ for svalue of-type fixnum = (aref decode-table (the fixnum (char-code char)))
+ with bitstore of-type fixnum = 0
+ with bitcount of-type fixnum = 0
+ do
+ (cond
+ ((char= char pad)
+ ;; Could add checks to make sure padding is correct
+ ;; Currently, padding is ignored
+ )
+ ((minusp svalue)
+ (warn "Bad character ~W in base64 decode" char))
+ (t
+ (setf bitstore (logior
+ (the fixnum (ash bitstore 6))
+ svalue))
+ (incf bitcount 6)
+ (when (>= bitcount 8)
+ (decf bitcount 8)
+ (setf (char result ridx)
+ (code-char (the fixnum
+ (logand
+ (the fixnum
+ (ash bitstore
+ (the fixnum (- bitcount))))
+ #xFF))))
+ (incf ridx)
+ (setf bitstore (the fixnum (logand bitstore #xFF)))))))
+ (subseq result 0 ridx))))
+
+
+(defun base64-to-integer (string &key (uri nil))
+ "Decodes a base64 string to an integer"
+ (declare (string string)
+ (optimize (speed 3)))
+ (let ((pad (if uri *uri-pad-char* *pad-char*))
+ (decode-table (if uri *uri-decode-table* *decode-table*)))
+ (declare (type decode-table decode-table)
+ (character pad))
+ (let ((value 0))
+ (declare (integer value))
+ (loop
+ for char of-type character across string
+ for svalue of-type fixnum =
+ (aref decode-table (the fixnum (char-code char)))
+ do
+ (cond
+ ((char= char pad)
+ (setq value (the fixnum (ash value -2))))
+ ((minusp svalue)
+ (warn "Bad character ~W in base64 decode" char))
+ (t
+ (setq value (the fixnum
+ (+ svalue (the fixnum (ash value 6))))))))
+ value)))
--- /dev/null
+cl-base64 (1.1-1) unstable; urgency=low
+
+ * Rewritten version, significant optimizations
+ * BSD-style license
+ * Adds conversion to and from integers
+ * Renamed functions
+
+ -- Kevin M. Rosenberg <kmr@debian.org> Sat, 28 Dec 2002 21:28:42 -0700
+
+cl-base64 (1.0-1) unstable; urgency=low
+
+ * Initial upload
+ * Changes compared to upstream:
+ - Added .asd file for use with Common Lisp Controller
+ - Changes for Allegro's case sensitive mode
+
+ -- Kevin M. Rosenberg <kmr@debian.org> Thu, 26 Dec 2002 19:17:51 -0700
--- /dev/null
+Source: cl-base64
+Section: devel
+Priority: optional
+Maintainer: Kevin M. Rosenberg <kmr@debian.org>
+Build-Depends-Indep: debhelper (>= 4.0.0)
+Standards-Version: 3.5.8.0
+
+Package: cl-base64
+Architecture: all
+Depends: ${shlibs:Depends}, common-lisp-controller (>= 3.47)
+Description: Common Lisp package to encode and decode base64 with URI support
+ This package provides highly optimized base64 encoding and decoding.
+ Besides conversion to and from strings, integer conversions are supported.
+ Encoding with Uniform Resource Indentifiers is supported by using
+ a modified encoding table that uses only URI-compatible characters.
+
+
+
--- /dev/null
+This package was debianized by Kevin M. Rosenberg <kmr@debian.org> in
+Dec 2002.
+
+It was downloaded from ftp://ftp.b9.com/base64/
+
+Upstream Author: Kevin M. Rosenberg <kevin@rosenberg.net>
+ This code is based on code placed in the public domain by Juri Pakaste
+ <juri@iki.fr> and available for download at
+ http://www.helsinki.fi/~pakaste/store/dl/base64.lisp
+
+Copyright:
+
+Copyright (c) 2002-2003 by Kevin Rosenberg
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+3. The name of the Authors may not be used to endorse or promote products
+ derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
+BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
+IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
--- /dev/null
+#! /bin/sh
+#
+# see: dh_installdeb(1)
+
+set -e
+
+# package name according to lisp
+LISP_PKG=base64
+
+# summary of how this script can be called:
+# * <postinst> `configure' <most-recently-configured-version>
+# * <old-postinst> `abort-upgrade' <new version>
+# * <conflictor's-postinst> `abort-remove' `in-favour' <package>
+# <new-version>
+# * <deconfigured's-postinst> `abort-deconfigure' `in-favour'
+# <failed-install-package> <version> `removing'
+# <conflicting-package> <version>
+# for details, see http://www.debian.org/doc/debian-policy/ or
+# the debian-policy package
+#
+# quoting from the policy:
+# Any necessary prompting should almost always be confined to the
+# post-installation script, and should be protected with a conditional
+# so that unnecessary prompting doesn't happen if a package's
+# installation fails and the `postinst' is called with `abort-upgrade',
+# `abort-remove' or `abort-deconfigure'.
+
+case "$1" in
+ configure)
+ /usr/sbin/register-common-lisp-source ${LISP_PKG}
+ ;;
+ abort-upgrade|abort-remove|abort-deconfigure)
+ ;;
+ *)
+ echo "postinst called with unknown argument \`$1'" >&2
+ exit 1
+ ;;
+esac
+
+# dh_installdeb will replace this with shell code automatically
+# generated by other debhelper scripts.
+
+#DEBHELPER#
+
+exit 0
+
+
--- /dev/null
+#! /bin/sh
+#
+# see: dh_installdeb(1)
+
+set -e
+
+# package name according to lisp
+LISP_PKG=base64
+
+# summary of how this script can be called:
+# * <prerm> `remove'
+# * <old-prerm> `upgrade' <new-version>
+# * <new-prerm> `failed-upgrade' <old-version>
+# * <conflictor's-prerm> `remove' `in-favour' <package> <new-version>
+# * <deconfigured's-prerm> `deconfigure' `in-favour'
+# <package-being-installed> <version> `removing'
+# <conflicting-package> <version>
+# for details, see http://www.debian.org/doc/debian-policy/ or
+# the debian-policy package
+
+
+case "$1" in
+ remove|upgrade|deconfigure)
+ /usr/sbin/unregister-common-lisp-source ${LISP_PKG}
+ ;;
+ failed-upgrade)
+ ;;
+ *)
+ echo "prerm called with unknown argument \`$1'" >&2
+ exit 1
+ ;;
+esac
+
+# dh_installdeb will replace this with shell code automatically
+# generated by other debhelper scripts.
+
+#DEBHELPER#
+
+exit 0
+
+
--- /dev/null
+#!/usr/bin/make -f
+
+export DH_COMPAT=4
+
+pkg := base64
+debpkg := cl-base64
+
+
+clc-source := usr/share/common-lisp/source
+clc-systems := usr/share/common-lisp/systems
+clc-base64 := $(clc-source)/$(pkg)
+
+doc-dir := usr/share/doc/$(debpkg)
+
+
+configure: configure-stamp
+configure-stamp:
+ dh_testdir
+ # Add here commands to configure the package.
+
+ touch configure-stamp
+
+
+build: build-stamp
+
+build-stamp: configure-stamp
+ dh_testdir
+ # Add here commands to compile the package.
+ touch build-stamp
+
+clean:
+ dh_testdir
+ dh_testroot
+ rm -f build-stamp configure-stamp
+ # Add here commands to clean up after the build process.
+ rm -f debian/cl-base64.postinst.* debian/cl-base64.prerm.*
+ dh_clean
+
+install: build
+ dh_testdir
+ dh_testroot
+ dh_clean -k
+ # Add here commands to install the package into debian/base64.
+ dh_installdirs $(clc-systems) $(clc-base64)
+ dh_install base64.asd $(shell echo *.lisp) $(clc-base64)
+ dh_link $(clc-base64)/base64.asd $(clc-systems)/base64.asd
+
+# Build architecture-independent files here.
+binary-indep: build install
+
+
+# Build architecture-dependent files here.
+binary-arch: build install
+ dh_testdir
+ dh_testroot
+ dh_installdocs
+ dh_installchangelogs
+ dh_strip
+ dh_compress
+ dh_fixperms
+ dh_installdeb
+ dh_shlibdeps
+ dh_gencontrol
+ dh_md5sums
+ dh_builddeb
+
+binary: binary-indep binary-arch
+.PHONY: build clean binary-indep binary-arch binary install configure
+
--- /dev/null
+#!/bin/bash -e
+
+dup uffi -Uftp.med-info.com -D/home/ftp/base64 -su $*
+
projects / cl-base64.git / commitdiff