Permalink
Switch branches/tags
Find file
Fetching contributors…
Cannot retrieve contributors at this time
39 lines (36 sloc) 1.41 KB
(in-package #:trivial-http)
; This is from Juri Pakaste's <juri@iki.fi> base64.lisp
(defparameter *encode-table*
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=")
;; can probably be sped up a _lot_
(defun base64-encode (string)
(declare (optimize (speed 3) (debug 0)))
(let ((result (make-array
(list (* 4 (truncate (/ (+ 2 (length string)) 3))))
:element-type 'base-char)))
(do ((sidx 0 (+ sidx 3))
(didx 0 (+ didx 4))
(chars 2 2)
(value nil nil))
((>= sidx (length string)) t)
(setf value (ash (logand #xFF (char-code (char string sidx))) 8))
(dotimes (n 2)
(when (< (+ sidx n 1) (length string))
(setf value
(logior value
(logand #xFF (char-code (char string (+ sidx n 1))))))
(incf chars))
(when (= n 0)
(setf value (ash value 8))))
(setf (elt result (+ didx 3))
(elt *encode-table* (if (> chars 3) (logand value #x3F) 64)))
(setf value (ash value -6))
(setf (elt result (+ didx 2))
(elt *encode-table* (if (> chars 2) (logand value #x3F) 64)))
(setf value (ash value -6))
(setf (elt result (+ didx 1))
(elt *encode-table* (logand value #x3F)))
(setf value (ash value -6))
(setf (elt result didx)
(elt *encode-table* (logand value #x3F))))
result))