From 64455dcb0317949fd476297aec2c1cf7cd046fe3 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Sun, 29 Dec 2002 06:08:26 +0000 Subject: [PATCH] r3685: *** empty log message *** --- .cvsignore | 9 ++ COPYING | 26 ++++++ base64.asd | 27 ++++++ base64.lisp | 225 +++++++++++++++++++++++++++++++++++++++++++++++ debian/changelog | 17 ++++ debian/control | 18 ++++ debian/copyright | 39 ++++++++ debian/postinst | 47 ++++++++++ debian/prerm | 41 +++++++++ debian/rules | 69 +++++++++++++++ debian/upload.sh | 4 + 11 files changed, 522 insertions(+) create mode 100755 .cvsignore create mode 100644 COPYING create mode 100644 base64.asd create mode 100644 base64.lisp create mode 100644 debian/changelog create mode 100644 debian/control create mode 100644 debian/copyright create mode 100755 debian/postinst create mode 100755 debian/prerm create mode 100755 debian/rules create mode 100755 debian/upload.sh diff --git a/.cvsignore b/.cvsignore new file mode 100755 index 0000000..469a95c --- /dev/null +++ b/.cvsignore @@ -0,0 +1,9 @@ +.bin +*.fasl* +*.dfsl +*.pfsl +*.ufsl +*.fas +*.x86f +*.sparcf +*.cfsl diff --git a/COPYING b/COPYING new file mode 100644 index 0000000..acae269 --- /dev/null +++ b/COPYING @@ -0,0 +1,26 @@ +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. diff --git a/base64.asd b/base64.asd new file mode 100644 index 0000000..565cb5e --- /dev/null +++ b/base64.asd @@ -0,0 +1,27 @@ +;;;; -*- 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 " + :licence "Public domain" + :description "Base64 encode and decoding" + + :perform (load-op :after (op base64) + (pushnew :base64 cl:*features*)) + + :components + ((:file "base64"))) diff --git a/base64.lisp b/base64.lisp new file mode 100644 index 0000000..f329223 --- /dev/null +++ b/base64.lisp @@ -0,0 +1,225 @@ +;;;; 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 +;;;; +;;;; Extended by Kevin M. Rosenberg : +;;;; - .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))) diff --git a/debian/changelog b/debian/changelog new file mode 100644 index 0000000..6727233 --- /dev/null +++ b/debian/changelog @@ -0,0 +1,17 @@ +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 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 Thu, 26 Dec 2002 19:17:51 -0700 diff --git a/debian/control b/debian/control new file mode 100644 index 0000000..2da249a --- /dev/null +++ b/debian/control @@ -0,0 +1,18 @@ +Source: cl-base64 +Section: devel +Priority: optional +Maintainer: Kevin M. Rosenberg +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. + + + diff --git a/debian/copyright b/debian/copyright new file mode 100644 index 0000000..9ce4ac3 --- /dev/null +++ b/debian/copyright @@ -0,0 +1,39 @@ +This package was debianized by Kevin M. Rosenberg in +Dec 2002. + +It was downloaded from ftp://ftp.b9.com/base64/ + +Upstream Author: Kevin M. Rosenberg + This code is based on code placed in the public domain by Juri Pakaste + 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. + diff --git a/debian/postinst b/debian/postinst new file mode 100755 index 0000000..d645276 --- /dev/null +++ b/debian/postinst @@ -0,0 +1,47 @@ +#! /bin/sh +# +# see: dh_installdeb(1) + +set -e + +# package name according to lisp +LISP_PKG=base64 + +# summary of how this script can be called: +# * `configure' +# * `abort-upgrade' +# * `abort-remove' `in-favour' +# +# * `abort-deconfigure' `in-favour' +# `removing' +# +# 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 + + diff --git a/debian/prerm b/debian/prerm new file mode 100755 index 0000000..e70aee4 --- /dev/null +++ b/debian/prerm @@ -0,0 +1,41 @@ +#! /bin/sh +# +# see: dh_installdeb(1) + +set -e + +# package name according to lisp +LISP_PKG=base64 + +# summary of how this script can be called: +# * `remove' +# * `upgrade' +# * `failed-upgrade' +# * `remove' `in-favour' +# * `deconfigure' `in-favour' +# `removing' +# +# 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 + + diff --git a/debian/rules b/debian/rules new file mode 100755 index 0000000..54ac3fe --- /dev/null +++ b/debian/rules @@ -0,0 +1,69 @@ +#!/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 + diff --git a/debian/upload.sh b/debian/upload.sh new file mode 100755 index 0000000..4b8111a --- /dev/null +++ b/debian/upload.sh @@ -0,0 +1,4 @@ +#!/bin/bash -e + +dup uffi -Uftp.med-info.com -D/home/ftp/base64 -su $* + -- 2.34.1