1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
|
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name: package.lisp
;;;; Purpose: Package definition for cl-base64
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Dec 2002
;;;;
;;;; $Id$
;;;;
;;;; *************************************************************************
(defpackage #:cl-base64
(: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-string-to-stream
#:base64-string-to-usb8-array
#:string-to-base64-string
#:string-to-base64-stream
#:usb8-array-to-base64-string
#:usb8-array-to-base64-stream
#:stream-to-base64-string
#:stream-to-base64-stream
#:integer-to-base64-string
#:integer-to-base64-stream
;; 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*
))
(in-package #:cl-base64)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defvar *encode-table*
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
(declaim (type simple-string *encode-table*))
(defvar *uri-encode-table*
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_")
(declaim (type simple-string *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*))
|
