1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: package.lisp
6 ;;;; Purpose: Package definition for cl-base64
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: Dec 2002
12 ;;;; *************************************************************************
14 (defpackage #:cl-base64
17 (:export #:base64-stream-to-integer
18 #:base64-stream-to-string
19 #:base64-stream-to-stream
20 #:base64-stream-to-usb8-array
21 #:base64-string-to-integer
22 #:base64-string-to-string
23 #:base64-string-to-stream
24 #:base64-string-to-usb8-array
25 #:string-to-base64-string
26 #:string-to-base64-stream
27 #:usb8-array-to-base64-string
28 #:usb8-array-to-base64-stream
29 #:stream-to-base64-string
30 #:stream-to-base64-stream
31 #:integer-to-base64-string
32 #:integer-to-base64-stream
36 #:bad-base64-character
37 #:incomplete-base64-data
39 ;; For creating custom encode/decode tables.
43 ;; What's the point of exporting these?
48 (in-package #:cl-base64)
50 (eval-when (:compile-toplevel :load-toplevel :execute)
51 (defvar *encode-table*
52 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
53 (declaim (type simple-string *encode-table*))
55 (defvar *uri-encode-table*
56 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_")
57 (declaim (type simple-string *uri-encode-table*))
59 (defvar *pad-char* #\=)
60 (defvar *uri-pad-char* #\.)
61 (declaim (type character *pad-char* *uri-pad-char*))
63 (deftype decode-table () '(simple-array (signed-byte 8) (128)))
64 (defun make-decode-table (encode-table pad-char
65 &key (whitespace-chars
66 '(#\Linefeed #\Return #\Space #\Tab)))
67 (assert (< (length encode-table) 128)
69 "Encode table too big: ~S" encode-table)
70 (let ((dt (make-array 128 :element-type '(signed-byte 8)
71 :initial-element -1)))
72 (declare (type decode-table dt))
73 (loop for char across encode-table
75 do (setf (aref dt (char-code char)) index))
76 (setf (aref dt (char-code pad-char)) -2)
77 (loop for char in whitespace-chars
78 do (setf (aref dt (char-code char)) -3))
81 (defconstant +decode-table+
82 (if (boundp '+decode-table+)
83 (symbol-value '+decode-table+)
84 (make-decode-table *encode-table* *pad-char*)))
85 (defvar *decode-table* +decode-table+ "Deprecated.")
86 (declaim (type decode-table +decode-table+ *decode-table*))
88 (defconstant +uri-decode-table+
89 (if (boundp '+uri-decode-table+)
90 (symbol-value '+uri-decode-table+)
91 (make-decode-table *uri-encode-table* *uri-pad-char*)))
92 (defvar *uri-decode-table* +uri-decode-table+ "Deprecated.")
93 (declaim (type decode-table +uri-decode-table+ *uri-decode-table*))