X-Git-Url: http://git.kpe.io/?p=cl-base64.git;a=blobdiff_plain;f=package.lisp;fp=package.lisp;h=71524cf05565f68162387e854ccd93592aff2c4e;hp=5eac24111e5430a80ac41ebf410d46356def62a3;hb=ecff5c5549684a5636a0436961b879177dc1039f;hpb=9d5a88ecfd67b28c1c2b3b3497f2237e37032691 diff --git a/package.lisp b/package.lisp index 5eac241..71524cf 100644 --- a/package.lisp +++ b/package.lisp @@ -15,13 +15,13 @@ (:nicknames #:base64) (:use #:cl) (:export #:base64-stream-to-integer + #:base64-stream-to-string + #:base64-stream-to-stream + #:base64-stream-to-usb8-array #:base64-string-to-integer #:base64-string-to-string - #:base64-stream-to-string #:base64-string-to-stream - #:base64-stream-to-stream #:base64-string-to-usb8-array - #:base64-stream-to-usb8-array #:string-to-base64-string #:string-to-base64-stream #:usb8-array-to-base64-string @@ -31,17 +31,23 @@ #:integer-to-base64-string #:integer-to-base64-stream - ;; For creating custom encode/decode tables + ;; Conditions. + #:base64-error + #:bad-base64-character + #:incomplete-base64-data + + ;; For creating custom encode/decode tables. + #:make-decode-table + #:+decode-table+ + #:+uri-decode-table+ + ;; What's the point of exporting these? #:*uri-encode-table* #:*uri-decode-table* - #:make-decode-table - - #:test-base64 )) (in-package #:cl-base64) - +(eval-when (:compile-toplevel :load-toplevel :execute) (defvar *encode-table* "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/") (declaim (type simple-string *encode-table*)) @@ -50,22 +56,38 @@ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_") (declaim (type simple-string *uri-encode-table*)) -(deftype decode-table () '(simple-array fixnum (256))) - -(defun make-decode-table (encode-table) - (let ((dt (make-array 256 :adjustable nil :fill-pointer nil - :element-type 'fixnum - :initial-element -1))) - (declare (type decode-table dt)) - (loop for char of-type character across encode-table - for index of-type fixnum from 0 below 64 - do (setf (aref dt (the fixnum (char-code char))) index)) - dt)) - -(defvar *decode-table* (make-decode-table *encode-table*)) - -(defvar *uri-decode-table* (make-decode-table *uri-encode-table*)) - (defvar *pad-char* #\=) (defvar *uri-pad-char* #\.) (declaim (type character *pad-char* *uri-pad-char*)) + + (deftype decode-table () '(simple-array (signed-byte 8) (128))) + (defun make-decode-table (encode-table pad-char + &key (whitespace-chars + '(#\Linefeed #\Return #\Space #\Tab))) + (assert (< (length encode-table) 128) + (encode-table) + "Encode table too big: ~S" encode-table) + (let ((dt (make-array 128 :element-type '(signed-byte 8) + :initial-element -1))) + (declare (type decode-table dt)) + (loop for char across encode-table + for index upfrom 0 + do (setf (aref dt (char-code char)) index)) + (setf (aref dt (char-code pad-char)) -2) + (loop for char in whitespace-chars + do (setf (aref dt (char-code char)) -3)) + dt))) + +(defconstant +decode-table+ + (if (boundp '+decode-table+) + (symbol-value '+decode-table+) + (make-decode-table *encode-table* *pad-char*))) +(defvar *decode-table* +decode-table+ "Deprecated.") +(declaim (type decode-table +decode-table+ *decode-table*)) + +(defconstant +uri-decode-table+ + (if (boundp '+uri-decode-table+) + (symbol-value '+uri-decode-table+) + (make-decode-table *uri-encode-table* *uri-pad-char*))) +(defvar *uri-decode-table* +uri-decode-table+ "Deprecated.") +(declaim (type decode-table +uri-decode-table+ *uri-decode-table*))