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
|
;;; -*- 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-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
#:usb8-array-to-base64-stream
#:stream-to-base64-string
#:stream-to-base64-stream
#:integer-to-base64-string
#:integer-to-base64-stream
;; For creating custom encode/decode tables
#:*uri-encode-table*
#:*uri-decode-table*
#:make-decode-table
#:test-base64
))
(in-package #:cl-base64)
(defvar *encode-table*
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
(declaim (type simple-string *encode-table*))
(defvar *uri-encode-table*
"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*))
|
