summaryrefslogtreecommitdiff
path: root/third-party/s-base64/src
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2009-10-30 20:52:07 +0100
committerMatthias Benkard <code@mail.matthias.benkard.de>2009-10-30 20:52:07 +0100
commitddb83b1fb2d305e0c06fc067d82d6bab5458b0fd (patch)
tree8f9003926f0b5295c7a04b2ca257c0a2155ce841 /third-party/s-base64/src
parent15937a1a4f1cf40bc55aa34eb71c67b88466ff57 (diff)
Add third-party XML processing libraries.
Ignore-this: 5ca28497555bf944858ca2f58bc8a62b darcs-hash:a0b0f9baa7c9b1259e755435db1fb17123630a6c
Diffstat (limited to 'third-party/s-base64/src')
-rw-r--r--third-party/s-base64/src/base64.lisp152
-rw-r--r--third-party/s-base64/src/package.lisp22
2 files changed, 174 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
diff --git a/third-party/s-base64/src/package.lisp b/third-party/s-base64/src/package.lisp
new file mode 100644
index 0000000..fd457db
--- /dev/null
+++ b/third-party/s-base64/src/package.lisp
@@ -0,0 +1,22 @@
+;;;; -*- 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.
+
+(defpackage s-base64
+ (:use common-lisp)
+ (:export
+ "DECODE-BASE64"
+ "ENCODE-BASE64"
+ "DECODE-BASE64-BYTES"
+ "ENCODE-BASE64-BYTES")
+ (:documentation "An implementation of standard Base64 encoding and decoding"))
+
+;;;; eof