-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathBASE64
More file actions
363 lines (262 loc) · 14.1 KB
/
BASE64
File metadata and controls
363 lines (262 loc) · 14.1 KB
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
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "S-BASE64" ( USE "LISP") ( EXPORT "DECODE-BASE64"
"ENCODE-BASE64" "DECODE-BASE64-BYTES" "ENCODE-BASE64-BYTES" "ENCODE-BASE64-GEN")) READTABLE "XCL"
BASE 10)
(IL:FILECREATED " 2-Dec-2024 16:25:14" IL:|{DSK}<Users>hjellinek>Projects>TrySVG>Lisp>BASE64.;16| 13953
:CHANGES-TO (IL:FUNCTIONS TEST-ENCODE-FILE ENCODE-BASE64 CORE-ENCODE-BASE64 ENCODE-BASE64-BYTES
ENCODE-BASE64-GEN)
(IL:VARS IL:BASE64COMS)
(XCL:FILE-ENVIRONMENTS IL:BASE64)
:PREVIOUS-DATE "26-Nov-2024 15:55:40" IL:|{DSK}<Users>hjellinek>Projects>TrySVG>Lisp>BASE64.;13|
)
(IL:PRETTYCOMPRINT IL:BASE64COMS)
(IL:RPAQQ IL:BASE64COMS
(
(IL:* IL:|;;;;| "This is a Common Lisp implementation of Base64 encoding and decoding.")
(IL:* IL:|;;;;| "")
(IL:* IL:|;;;;| " Copyright (C) 2002-2005 Sven Van Caekenberghe, Beta Nine BVBA.")
(IL:* IL:|;;;;| "")
(IL:* IL:|;;;;| " You are granted the rights to distribute and use this software")
(IL:* IL:|;;;;| " as governed by the terms of the Lisp Lesser General Public License")
(IL:* IL:|;;;;| " (http://opensource.franz.com/preamble.html), also known as the LLGPL.")
(IL:* IL:|;;;;| "")
(IL:* IL:|;;;;| "See https://github.com/svenvc/s-base64.")
(IL:* IL:|;;;;| "Medley packaging by Herb Jellinek, jellinek@interlisp.org.")
(IL:* IL:|;;;;| "")
(XCL:FILE-ENVIRONMENTS IL:BASE64)
(IL:P (XCL:DEFPACKAGE "S-BASE64" (:USE "LISP")
(:EXPORT "DECODE-BASE64" "ENCODE-BASE64" "DECODE-BASE64-BYTES"
"ENCODE-BASE64-BYTES" "ENCODE-BASE64-GEN")))
(IL:VARIABLES +BASE64-ALPHABET+ +INVERSE-BASE64-ALPHABET+)
(IL:FUNCTIONS CORE-DECODE-BASE64 CORE-ENCODE-BASE64 SKIP-BASE64-WHITESPACE)
(IL:FUNCTIONS DECODE-BASE64 DECODE-BASE64-BYTES)
(IL:FUNCTIONS ENCODE-BASE64 ENCODE-BASE64-BYTES ENCODE-BASE64-GEN)
(IL:* IL:|;;| "testing")
(IL:FUNCTIONS TEST-ENCODE-FILE)))
(IL:* IL:|;;;;| "This is a Common Lisp implementation of Base64 encoding and decoding.")
(IL:* IL:|;;;;| "")
(IL:* IL:|;;;;| " Copyright (C) 2002-2005 Sven Van Caekenberghe, Beta Nine BVBA.")
(IL:* IL:|;;;;| "")
(IL:* IL:|;;;;| " You are granted the rights to distribute and use this software")
(IL:* IL:|;;;;| " as governed by the terms of the Lisp Lesser General Public License")
(IL:* IL:|;;;;| " (http://opensource.franz.com/preamble.html), also known as the LLGPL.")
(IL:* IL:|;;;;| "")
(IL:* IL:|;;;;| "See https://github.com/svenvc/s-base64.")
(IL:* IL:|;;;;| "Medley packaging by Herb Jellinek, jellinek@interlisp.org.")
(IL:* IL:|;;;;| "")
(XCL:DEFINE-FILE-ENVIRONMENT IL:BASE64 :PACKAGE (XCL:DEFPACKAGE "S-BASE64" (:USE "LISP")
(:EXPORT "DECODE-BASE64" "ENCODE-BASE64"
"DECODE-BASE64-BYTES"
"ENCODE-BASE64-BYTES"
"ENCODE-BASE64-GEN"))
:READTABLE "XCL")
(XCL:DEFPACKAGE "S-BASE64" (:USE "LISP")
(:EXPORT "DECODE-BASE64" "ENCODE-BASE64" "DECODE-BASE64-BYTES" "ENCODE-BASE64-BYTES"
"ENCODE-BASE64-GEN"))
(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-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 15)
4)
(ASH V3 -2))
(LOGIOR (ASH (LOGAND V3 3)
6)
V4))))
(DEFUN CORE-ENCODE-BASE64 (BYTE1 BYTE2 BYTE3)
(LIST (CHAR +BASE64-ALPHABET+ (ASH BYTE1 -2))
(CHAR +BASE64-ALPHABET+ (LOGIOR (ASH (LOGAND BYTE1 3)
4)
(ASH (LOGAND BYTE2 240)
-4)))
(CHAR +BASE64-ALPHABET+ (LOGIOR (ASH (LOGAND BYTE2 15)
2)
(ASH (LOGAND BYTE3 192)
-6)))
(CHAR +BASE64-ALPHABET+ (LOGAND BYTE3 63))))
(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 (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 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 (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))
(XCL:DESTRUCTURING-BIND (OUT1 OUT2 OUT3 OUT4)
(CORE-ENCODE-BASE64-LIST 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)))))))
(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)))
(XCL:DESTRUCTURING-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 ENCODE-BASE64-GEN (IN OUT &OPTIONAL (BREAK-LINES T))
"Encode a binary input GENNERATOR into a BASE64 encoded character output stream"
(LET ((DONE! (LIST))
(EXPIRED NIL))
(FLET ((GET-NEXT NIL (IF (NOT EXPIRED)
(LET ((NEXT-VALUE (IL:GENERATE IN)))
(IF (EQ NEXT-VALUE IN)
(PROG1 DONE! (SETF EXPIRED T))
NEXT-VALUE))
DONE!))
(EOS? (V)
(EQ V DONE!)))
(LET ((COUNTER 0))
(LOOP (LET ((IN1 (GET-NEXT))
(IN2 (GET-NEXT))
(IN3 (GET-NEXT)))
(IF (EOS? IN1)
(RETURN))
(XCL:DESTRUCTURING-BIND (OUT1 OUT2 OUT3 OUT4)
(CORE-ENCODE-BASE64 IN1 (IF (EOS? IN2)
0
IN2)
(IF (EOS? IN3)
0
IN3))
(WRITE-CHAR OUT1 OUT)
(WRITE-CHAR OUT2 OUT)
(IF (EOS? IN2)
(PROGN (WRITE-CHAR #\= OUT)
(WRITE-CHAR #\= OUT))
(PROGN (WRITE-CHAR OUT3 OUT)
(IF (EOS? IN3)
(WRITE-CHAR #\= OUT)
(WRITE-CHAR OUT4 OUT))))
(INCF COUNTER 4)
(WHEN (AND BREAK-LINES (= COUNTER 76))
(TERPRI OUT)
(SETF COUNTER 0)))))))))
(IL:* IL:|;;| "testing")
(DEFUN TEST-ENCODE-FILE (&OPTIONAL (INPUT-FILE "/tmp/bitmap.png"))
(WITH-OPEN-STREAM (IN (IL:OPENSTREAM INPUT-FILE 'IL:INPUT NIL '((IL:FORMAT :THROUGH))))
(WITH-OPEN-STREAM (OUT (IL:OPENSTREAM (CONCATENATE 'STRING INPUT-FILE ".base64")
'IL:OUTPUT NIL '((IL:FORMAT :THROUGH))))
(ENCODE-BASE64 IN OUT NIL))))
(IL:DECLARE\: IL:DONTCOPY
(IL:FILEMAP (NIL (4000 4598 (CORE-DECODE-BASE64 4000 . 4598)) (4600 5207 (CORE-ENCODE-BASE64 4600 .
5207)) (5209 5539 (SKIP-BASE64-WHITESPACE 5209 . 5539)) (5541 6663 (DECODE-BASE64 5541 . 6663)) (6665
8070 (DECODE-BASE64-BYTES 6665 . 8070)) (8072 9535 (ENCODE-BASE64 8072 . 9535)) (9537 11335 (
ENCODE-BASE64-BYTES 9537 . 11335)) (11337 13505 (ENCODE-BASE64-GEN 11337 . 13505)) (13540 13924 (
TEST-ENCODE-FILE 13540 . 13924)))))
IL:STOP