1 files changed, 152 insertions, 0 deletions
diff --git a/third-party/s-base64/src/base64.lisp b/third-party/s-base64/src/base64.lisp
new file mode 100644
index 0000000..f6b799f
--- /dev/null
+++ b/third-party/s-base64/src/base64.lisp
@@ -0,0 +1,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