[5398b3]: share / stringproc / base64.lisp Maximize Restore History

Download this file

base64.lisp    117 lines (87 with data), 4.3 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
#|
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
MA 02110-1301, USA.
**** base64 ********************************************************************
Copyright Volker van Nek, 2013
base64(string) returns a base 64 representation of a string.
base64_decode(base64) returns a decoded base 64 string.
(%i2) base64 : base64("foo bar baz");
(%o2) Zm9vIGJhciBiYXo=
(%i3) string : base64_decode(base64);
(%o3) foo bar baz
Note that if the string contains umlauts the base64 string is platform
dependend. But in every case the decoded string is equal to the original.
|#
(defvar *str64* "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
;; encode : 0 (6bit) --> base64 = *chr64*[0] = 'A' = 65 : number --> character
(defvar *chr64* (make-array 64. :element-type 'char :initial-element #\0))
(do ((i 0 (1+ i)) (ch (coerce *str64* 'list) (cdr ch)))
((= i 64.))
(setf (svref *chr64* i) (car ch)) )
;; decode : 'A' = 65 --> *num64*[65] = 0 (6bit) : character --> number
;; range of *num64* : '+' = 43 ... 'z' = 122
(defvar *num64* (make-array 123. :element-type 'integer :initial-element 0))
(do ((i 0 (1+ i)))
((= i 64.))
(setf (svref *num64* (char-code (svref *chr64* i))) i) )
(defmfun $base64 (s)
(unless (stringp s)
(merror "`base64': Argument must be a string.") )
(let* ((bytes (mapcar #'char-code (coerce s 'list)))
(len (length s))
(base64 (make-array (* 4. (floor (+ len 2.) 3.)) :element-type 'char :initial-element #\0))
(k 0) b ind )
(do ()
((null bytes))
(setq b `#(,(pop bytes)
,(if (null bytes) 0 (pop bytes))
,(if (null bytes) 0 (pop bytes)) ))
(setq ind `#(
,(ash (svref b 0) -2)
,(logior (logand (ash (svref b 0) 4) #x30) (ash (svref b 1) -4))
,(logior (logand (ash (svref b 1) 2) #x3c) (ash (svref b 2) -6))
,(logand (svref b 2) #x3f) ))
(do ((i 0 (1+ i)))
((= i 4.))
(setf (svref base64 k) (svref *chr64* (svref ind i)))
(incf k) ))
(setq len (mod len 3))
(unless (= len 0) (setf (svref base64 (decf k)) #\=))
(when (= len 1) (setf (svref base64 (decf k)) #\=))
(coerce base64 'string) ))
(defmfun $base64_decode (s)
(unless (stringp s)
(merror "`base64_decode': Argument must be a string.") )
(let* ((len (length s))
(nrof= (count-if #'(lambda (c) (char= c #\=)) (subseq s (- len 2.))))
(size (- (ash (* 3. len) -2.) nrof=))
(res (make-array size :element-type 'integer :initial-element 0))
(w (make-array 4. :element-type 'integer :initial-element 0))
(bytes (mapcar #'char-code (coerce s 'list))) )
(prog ((j 0))
a
(setf (svref w 0) (svref *num64* (pop bytes))
(svref w 1) (svref *num64* (pop bytes))
(svref res j)
(logior (logand (ash (svref w 0) 2.) #xff) (ash (svref w 1) -4.)) )
(when (= (incf j) size) (return))
(setf (svref w 2.) (svref *num64* (pop bytes))
(svref res j)
(logior (logand (ash (svref w 1) 4.) #xff) (ash (svref w 2.) -2.)) )
(when (= (incf j) size) (return))
(setf (svref w 3.) (svref *num64* (pop bytes))
(svref res j)
(logior (logand (ash (svref w 2.) 6.) #xff) (svref w 3.) ) )
(when (= (incf j) size) (return))
(go a) )
(coerce (map 'vector #'code-char res) 'string) ))