blob: f6b799f32f0607c5dbfe0dc10ac88623ff7fa84c (
plain)
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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
;;;; -*- mode: lisp -*-
;;;;
;;;; $Id: base64.lisp,v 1.3 2005/02/07 17:45:41 scaekenberghe Exp $
;;;;
;;;; This is a Common Lisp implementation of Base64 encoding and decoding.
;;;;
;;;; Copyright (C) 2002-2005 Sven Van Caekenberghe, Beta Nine BVBA.
;;;;
;;;; You are granted the rights to distribute and use this software
;;;; as governed by the terms of the Lisp Lesser General Public License
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
(in-package :s-base64)
(defparameter +base64-alphabet+
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
(defparameter +inverse-base64-alphabet+
(let ((inverse-base64-alphabet (make-array 127)))
(dotimes (i 127 inverse-base64-alphabet)
(setf (aref inverse-base64-alphabet i)
(position (code-char i) +base64-alphabet+)))))
(defun core-encode-base64 (byte1 byte2 byte3)
(values (char +base64-alphabet+ (ash byte1 -2))
(char +base64-alphabet+ (logior (ash (logand byte1 #B11) 4)
(ash (logand byte2 #B11110000) -4)))
(char +base64-alphabet+ (logior (ash (logand byte2 #B00001111) 2)
(ash (logand byte3 #B11000000) -6)))
(char +base64-alphabet+ (logand byte3 #B111111))))
(defun core-decode-base64 (char1 char2 char3 char4)
(let ((v1 (aref +inverse-base64-alphabet+ (char-code char1)))
(v2 (aref +inverse-base64-alphabet+ (char-code char2)))
(v3 (aref +inverse-base64-alphabet+ (char-code char3)))
(v4 (aref +inverse-base64-alphabet+ (char-code char4))))
(values (logior (ash v1 2)
(ash v2 -4))
(logior (ash (logand v2 #B1111) 4)
(ash v3 -2))
(logior (ash (logand v3 #B11) 6)
v4))))
(defun skip-base64-whitespace (stream)
(loop
(let ((char (peek-char nil stream nil nil)))
(cond ((null char) (return nil))
((null (aref +inverse-base64-alphabet+ (char-code char))) (read-char stream))
(t (return char))))))
(defun decode-base64-bytes (stream)
"Decode a base64 encoded character stream, returns a byte array"
(let ((out (make-array 256
:element-type '(unsigned-byte 8)
:adjustable t
:fill-pointer 0)))
(loop
(skip-base64-whitespace stream)
(let ((in1 (read-char stream nil nil))
(in2 (read-char stream nil nil))
(in3 (read-char stream nil nil))
(in4 (read-char stream nil nil)))
(if (null in1) (return))
(if (or (null in2) (null in3) (null in4)) (error "input not aligned/padded for base64 encoding"))
(multiple-value-bind (out1 out2 out3)
(core-decode-base64 in1
in2
(if (char= in3 #\=) #\A in3)
(if (char= in4 #\=) #\A in4))
(vector-push-extend out1 out)
(when (char/= in3 #\=)
(vector-push-extend out2 out)
(when (char/= in4 #\=)
(vector-push-extend out3 out))))))
out))
(defun encode-base64-bytes (array stream &optional (break-lines t))
"Encode a byte array into a base64 encoded character stream"
(let ((index 0)
(counter 0)
(len (length array)))
(loop
(when (>= index len) (return))
(let ((in1 (aref array index))
(in2 (if (< (+ index 1) len) (aref array (+ index 1)) nil))
(in3 (if (< (+ index 2) len) (aref array (+ index 2)) nil)))
(multiple-value-bind (out1 out2 out3 out4)
(core-encode-base64 in1
(if (null in2) 0 in2)
(if (null in3) 0 in3))
(write-char out1 stream)
(write-char out2 stream)
(if (null in2)
(progn
(write-char #\= stream)
(write-char #\= stream))
(progn
(write-char out3 stream)
(if (null in3)
(write-char #\= stream)
(write-char out4 stream))))
(incf index 3)
(incf counter 4)
(when (and break-lines (= counter 76))
(terpri stream)
(setf counter 0)))))))
(defun decode-base64 (in out)
"Decode a base64 encoded character input stream into a binary output stream"
(loop
(skip-base64-whitespace in)
(let ((in1 (read-char in nil nil))
(in2 (read-char in nil nil))
(in3 (read-char in nil nil))
(in4 (read-char in nil nil)))
(if (null in1) (return))
(if (or (null in2) (null in3) (null in4)) (error "input not aligned/padded for base64 encoding"))
(multiple-value-bind (out1 out2 out3)
(core-decode-base64 in1 in2 (if (char= in3 #\=) #\A in3) (if (char= in4 #\=) #\A in4))
(write-byte out1 out)
(when (char/= in3 #\=)
(write-byte out2 out)
(when (char/= in4 #\=)
(write-byte out3 out)))))))
(defun encode-base64 (in out &optional (break-lines t))
"Encode a binary input stream into a base64 encoded character output stream"
(let ((counter 0))
(loop
(let ((in1 (read-byte in nil nil))
(in2 (read-byte in nil nil))
(in3 (read-byte in nil nil)))
(if (null in1) (return))
(multiple-value-bind (out1 out2 out3 out4)
(core-encode-base64 in1 (if (null in2) 0 in2) (if (null in3) 0 in3))
(write-char out1 out)
(write-char out2 out)
(if (null in2)
(progn
(write-char #\= out)
(write-char #\= out))
(progn
(write-char out3 out)
(if (null in3)
(write-char #\= out)
(write-char out4 out))))
(incf counter 4)
(when (and break-lines (= counter 76))
(terpri out)
(setf counter 0)))))))
;;;; eof
|
