diff options
| author | Matthias Benkard <code@mail.matthias.benkard.de> | 2009-10-30 20:52:07 +0100 |
|---|---|---|
| committer | Matthias Benkard <code@mail.matthias.benkard.de> | 2009-10-30 20:52:07 +0100 |
| commit | ddb83b1fb2d305e0c06fc067d82d6bab5458b0fd (patch) | |
| tree | 8f9003926f0b5295c7a04b2ca257c0a2155ce841 /third-party/s-base64 | |
| parent | 15937a1a4f1cf40bc55aa34eb71c67b88466ff57 (diff) | |
Add third-party XML processing libraries.
Ignore-this: 5ca28497555bf944858ca2f58bc8a62b
darcs-hash:a0b0f9baa7c9b1259e755435db1fb17123630a6c
Diffstat (limited to 'third-party/s-base64')
| -rw-r--r-- | third-party/s-base64/.clbuild-skip-update | 0 | ||||
| -rw-r--r-- | third-party/s-base64/Makefile | 82 | ||||
| -rw-r--r-- | third-party/s-base64/README.txt | 1 | ||||
| -rw-r--r-- | third-party/s-base64/doc/API.html | 11 | ||||
| -rw-r--r-- | third-party/s-base64/doc/index.html | 266 | ||||
| -rw-r--r-- | third-party/s-base64/s-base64.asd | 30 | ||||
| -rw-r--r-- | third-party/s-base64/src/base64.lisp | 152 | ||||
| -rw-r--r-- | third-party/s-base64/src/package.lisp | 22 | ||||
| -rw-r--r-- | third-party/s-base64/test/all-tests.lisp | 15 | ||||
| -rw-r--r-- | third-party/s-base64/test/test-base64.lisp | 140 | ||||
| -rw-r--r-- | third-party/s-base64/test/test.b64 | 1 |
11 files changed, 720 insertions, 0 deletions
diff --git a/third-party/s-base64/.clbuild-skip-update b/third-party/s-base64/.clbuild-skip-update new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/third-party/s-base64/.clbuild-skip-update diff --git a/third-party/s-base64/Makefile b/third-party/s-base64/Makefile new file mode 100644 index 0000000..93fccc9 --- /dev/null +++ b/third-party/s-base64/Makefile @@ -0,0 +1,82 @@ +# +# This makefile contains command line tools to maintain this project +# Please consult the documentation in doc/index.html for more user oriented information +# Portability at this level is accidental, only LispWorks on Mac OS X is supported here +# For some operations, edit the necessary variables to suit your environment +# Some operations can obviously only be done by a specific person in a very specific context ;-) +# + +default: + @echo Welcome to S-BASE64, a Common Lisp implementation of Base64 Encoding/Decoding + @echo + @echo Possible makefile targets: + @echo + @echo clean-fasl --- remove all known lisp compiled fasl files recursively + @echo clean-emacs --- remove all '*~' recursively + @echo clean --- all of the above + @echo dist-clean --- remove all generated files and archives + @echo compile --- compile the project through ASDF + @echo check --- run all unit and functional tests for this project + @echo test --- run all unit and functional tests for this project + @echo dist --- create a source tarball for distribution + @echo release --- make a formal, public release + @echo sync-darcs --- synchronize local and remote darcs repositories + @echo metrics --- calculate some loc metrics + @echo + @echo Please consult the documentation in doc/index.html for more information + +clean-fasl: + find . -name "*.fas" | xargs rm + find . -name "*.lib" | xargs rm + find . -name "*.nfasl" | xargs rm + find . -name "*.dfsl" | xargs rm + find . -name "*.fasl" | xargs rm + +clean-emacs: + find . -name "*~" | xargs rm + +clean: clean-fasl clean-emacs + +dist-clean: clean + rm -rf *.tar.gz + rm -rf *.asc + +metrics: + find src -name "*.lisp" | xargs wc -l + find test -name "*.lisp" | xargs wc -l + +LISP=/Applications/LispWorks/lispworks-tty +PRJ=s-base64 + +compile: + echo "(asdf:oos 'asdf:compile-op :$(PRJ)) :ok" | $(LISP) + +DIR=`pwd`/ +SRCDIR=$(DIR)src/ +TESTDIR=$(DIR)test/ + +test: check + +check: + echo "(asdf:oos 'asdf:load-op :$(PRJ)) (load \"$(TESTDIR)all-tests.lisp\") :ok" | $(LISP) + +dist: + darcs dist + +IDISK=/Volumes/svc + +release: test dist clean + gpg -a -b $(PRJ).tar.gz + mkdir -p $(IDISK)/Sites/$(PRJ)/ + cp $(PRJ).tar.gz $(IDISK)/Sites/$(PRJ)/ + cp $(PRJ).tar.gz.asc $(IDISK)/Sites/$(PRJ)/ + cp doc/* $(IDISK)/Sites/$(PRJ)/ + +USER= +HOST= +RPATH=~/Sites/website/darcs/ + +sync-darcs: clean + cd ..; rsync -va -e ssh $(PRJ) $(USER)@$(HOST):$(RPATH) + +# EOF diff --git a/third-party/s-base64/README.txt b/third-party/s-base64/README.txt new file mode 100644 index 0000000..c4fb71a --- /dev/null +++ b/third-party/s-base64/README.txt @@ -0,0 +1 @@ +Please consult the documentation in the doc directory, starting with index.html diff --git a/third-party/s-base64/doc/API.html b/third-party/s-base64/doc/API.html new file mode 100644 index 0000000..15076e2 --- /dev/null +++ b/third-party/s-base64/doc/API.html @@ -0,0 +1,11 @@ +<html><head><title>S-BASE64</title></head><body><h3>API for package S-BASE64</h3> +<blockquote>An implementation of standard Base64 encoding and decoding</blockquote> +<p>(<b>decode-base64</b> in out) <i>function</i></p> +<blockquote>Decode a base64 encoded character input stream into a binary output stream</blockquote> +<p>(<b>decode-base64-bytes</b> stream) <i>function</i></p> +<blockquote>Decode a base64 encoded character stream, returns a byte array</blockquote> +<p>(<b>encode-base64</b> in out &optional (break-lines t)) <i>function</i></p> +<blockquote>Encode a binary input stream into a base64 encoded character output stream</blockquote> +<p>(<b>encode-base64-bytes</b> array stream &optional (break-lines t)) <i>function</i></p> +<blockquote>Encode a byte array into a base64b encoded character stream</blockquote> +<font size=-1><p>Documentation generated by <a href="http://homepage.mac.com/svc/lispdoc/">lispdoc</a> running on LispWorks</p></font></body></html>
\ No newline at end of file diff --git a/third-party/s-base64/doc/index.html b/third-party/s-base64/doc/index.html new file mode 100644 index 0000000..171ea6e --- /dev/null +++ b/third-party/s-base64/doc/index.html @@ -0,0 +1,266 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> +<html xmlns="http://www.w3.org/1999/xhtml"> +<head> +<title>S-BASE64</title> +<meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1" /> +<meta name="description" content="S-BASE64 is Common Lisp implementation of Base64 Encoding/Decoding" /> +<meta name="keywords" content="base64, rfc1421, rfc2045, rfc3548, common lisp, lisp" /> +<meta name="author" content="Sven Van Caekenberghe" /> +<meta name="Copyright" content="Copyright (c) 2002-2006 Sven Van Caekenberghe, Beta Nine BVBA" /> +<style type="text/css"> +body { + background: white; + width: 900px; + font-family: Verdana, Arial, Helvetica, sans-serif; + font-size: 13px; +} +p { + width: 600px; + padding: 0 20px 10px 50px; +} +ul { + width: 600px; + padding: 0 5px 5px 70px; +} +.author { + padding: 0 20px 5px 50px; + font-style: italic; +} +.figure { + margin-top: 0; + margin-bottom: 0; + background: black; + color: white; + text-align: center; + padding: 20px 0 10px 0; +} +.listing { + background: #eee; + font-size: 12px; + padding-left: 10px; +} +.caption { + margin-top: 5px; + text-align: center; + font-size: 10px; + font-style: bold; +} +.footer { + font-size: 10px; + font-style: italic; +} +</style> +</head> +<body> +<h3>Open Source Common Lisp Software</h3> +<h1>S-BASE64</h1> +<h2>A Common Lisp implementation of Base64 Encoding/Decoding</h2> +<p> +<a href="http://homepage.mac.com/svc/s-base64/index.html">S-BASE64</a> +is an open source Common Lisp implementation of Base64 Encoding and Decoding. +Base64 encoding is a technique to encode binary data in a portable, safe printable, 7-bit ASCII format. +For a general introduction, please consult the <a href="http://en.wikipedia.org/wiki/Base64">Wikipedia article on Base64</a>. +This simple package is used as a building block in a number of other open source projects, +as can be seen from this description of some +<a href="http://homepage.mac.com/svc/oscl.html">other Open Source Common Lisp packages</a>. +</p> +<h3>Contents</h3> +<ul> +<li><a href="#features">Features</a></li> +<li><a href="#status">Status</a></li> +<li><a href="#news">News</a></li> +<li><a href="#platforms">Platforms</a></li> +<li><a href="#downloading">Downloading</a></li> +<li><a href="#installation">Installation</a></li> +<li><a href="#usage">Usage</a></li> +<li><a href="#api">API Reference</a></li> +<li><a href="#mailinglist">Mailinglist</a></li> +<li><a href="#changelog">Changelog</a></li> +<li><a href="#tod">TODO</a></li> +<li><a href="#faq">FAQ</a></li> +<li><a href="#bugs">Bugs</a></li> +<li><a href="#authors">Authors</a></li> +<li><a href="#maintainers">Maintainers</a></li> +<li><a href="#license">License</a></li> +<li><a href="#history">History</a></li> +<li><a href="#references">References</a></li> +</ul> +<h3 id="features">Features</h3> +<p> +S-BASE64 can: +</p> +<ul> +<li>convert a Base64 encoded character input stream into a decoded binary output stream</li> +<li>convert a binary output stream into a Base64 encoded character output stream</li> +<li>convert a Base64 encoded character input stream into a byte array</li> +<li>convert a byte array into a Base64 encoded character output stream</li> +<li>optionally break lines at 76 characters</li> +</ul> +<h3 id="status">Status</h3> +<p> +S-BASE64 is considered stable code. +</p> +<h3 id="news">News</h3> +<p> +<em>October 2005</em> - Created as a seperate project. +</p> +<h3 id="platforms">Platforms</h3> +<p> +S-BASE64 is written in ANSI standard Common Lisp and should be portable across any CL implementation. +</p> +<h3 id="downloading">Downloading</h3> +<p> +You can download the latested released tarball of the S-BASE64 package from +<a href="http://homepage.mac.com/svc/s-base64/s-base64.tar.gz">http://homepage.mac.com/svc/s-base64/s-base64.tar.gz</a>. +This archive is signed on release by <a href="http://homepage.mac.com/svc">Sven Van Caekenberghe</a>, +whose public key is published at +<a href="http://homepage.mac.com/svc/sven-public-ascii.gpg">http://homepage.mac.com/svc/sven-public-ascii.gpg</a>, +the signature is in +<a href="http://homepage.mac.com/svc/s-base64/s-base64.tar.gz.asc">http://homepage.mac.com/svc/s-base64/s-base64.tar.gz.asc</a>. +</p> +<p> +Alternatively you can access the <a href="http://abridgegame.org/darcs/">DARCS</a> repository at +<a href="http://www.beta9.be/darcs/s-base64">http://www.beta9.be/darcs/s-base64</a>. +For a good description on how to use DARCS see +<a href="http://dirkgerrits.com/programming/erlisp/download/">http://dirkgerrits.com/programming/erlisp/download/</a>. +</p> +<div class="listing"> +<pre>$ darcs get http://www.beta9.be/darcs/s-base64 +Welcome to S-BASE64, a Common Lisp implementation of Base64 Encoding/Decoding +********************** +Copying patch 6 of 6... done! +Applying patches to the "working" directory... +............ +Finished getting. +$ cd s-base64/ +$ darcs pull +Pulling from "http://www.beta9.be/darcs/s-base64"... +Welcome to S-BASE64, a Common Lisp implementation of Base64 Encoding/Decoding +********************** +No remote changes to pull in!</pre> +</div> +<div class="caption">Example of basic darcs usage, get everything once and keep up to date by pulling in changes</div> +<h3 id="installation">Installation</h3> +<p> +The S-BASE64 package is loaded using <a href="http://www.cliki.net/asdf">ASDF</a>. +There is an excellent <a href="http://constantly.at/lisp/asdf/">tutorial on ASDF</a> to get you started. +Alternatively you can use <a href="http://www.cliki.net/asdf-install">ASDF-INSTALL</a>. +There is an great <a href="http://weitz.de/asdf-install/">tutorial on ASDF-INSTALL</a> to get you on the way. +</p> +<div class="listing"> +<pre>$ cd apps/asdf/systems/ +$ ln -s ~/darcs/s-base64/s-base64.asd . +$ cd ~ +$ /Applications/LispWorks/lispworks-tty +LispWorks(R): The Common Lisp Programming Environment +Copyright (C) 1987-2005 LispWorks Ltd. All rights reserved. +Version 4.4.5 +Saved by sven as lispworks-tty, at 26 Oct 2005 11:53 +User sven on voyager.local +; Loading text file /Applications/LispWorks/Library/lib/4-4-0-0/config/siteinit.lisp +; Loading text file /Applications/LispWorks/Library/lib/4-4-0-0/private-patches/load.lisp +; Loading text file /Users/sven/.lispworks +; Loading text file /Users/sven/apps/asdf/init-asdf.lisp +; Loading fasl file /Users/sven/apps/asdf/asdf.nfasl +;Pushed #P"/Users/sven/apps/asdf/systems/" onto ASDF central registry + +CL-USER 1 > (asdf:oos 'asdf:load-op :s-base64) +; Loading /Applications/LispWorks/Library/lib/4-4-0-0/load-on-demand/ccl/xp-fancyformat.nfasl on demand... +; loading system definition from +; /Users/sven/apps/asdf/systems/s-base64.asd into +; #<The ASDF787 package, 0/16 internal, 0/16 external> +; Loading text file /Users/sven/darcs/s-base64/s-base64.asd +; registering #<SYSTEM :S-BASE64 100B004B> as S-BASE64 +;;; Compiling file /Users/sven/darcs/s-base64/src/package.lisp ... +... +; Loading fasl file /Users/sven/darcs/s-base64/src/package.nfasl +;;; Compiling file /Users/sven/darcs/s-base64/src/base64.lisp ... +... +; Loading fasl file /Users/sven/darcs/s-base64/src/base64.nfasl</pre> +</div> +<div class="caption">Example of setting up and using ASDF to compile and load the package</div> +<h3 id="usage">Usage</h3> +<p> +To encode you start with either a binary input stream or a byte array and write to a character output stream. +To decode you start from a character input stream and write to a binary output stream or return a byte array. +You can use the standard CL marcros WITH-OUTPUT-TO-STRING of WITH-INPUT-FROM-STRING to convert to and from a string. +The following listener transcript show how to compute the second example from RFC 3548, section 7: +</p> +<div class="listing"> +<pre>CL-USER 1 > (in-package :s-base64) +#<The S-BASE64 package, 50/128 internal, 4/16 external> + +S-BASE64 2 > (setf bytes #(#x14 #xfb #x9c #x03 #xd9)) +#(20 251 156 3 217) + +S-BASE64 3 > (with-output-to-string (out) + (encode-base64-bytes bytes out)) +"FPucA9k=" + +S-BASE64 4 > (with-input-from-string (in *) + (decode-base64-bytes in)) +#(20 251 156 3 217)</pre> +</div> +<div class="caption">Example Base64 Encoding and Decoding</div> +<h3 id="api">API Reference</h3> +<p> +There is automatically generated <a href="API.html">API Reference</a> documentation available for the S-BASE64 package. +</p> +<h3 id="mailinglist">Mailinglist</h3> +<p> +The <a href="http://common-lisp.net/cgi-bin/mailman/listinfo/kpax-devel">KPAX mailing list</a> is used for this project. +</p> +<h3 id="changelog">Changelog</h3> +<p> +Release Notes: +</p> +<ul> +<li>release 1: moved S-BASE64 into a seperate project under a new structure</li> +</ul> +<h3 id="todo">TODO</h3> +<p> +There is a variant of Base64 encoding used for URL's and filenames that could be implemented. +</p> +<h3 id="faq">FAQ</h3> +<p> +Nothing appropriate. +</p> +<h3 id="bugs">Bugs</h3> +<p> +Illegal input results in generic low-level CL conditions rather than a more meaningful high-level application specific condition. +</p> +<h3 id="authors">Authors</h3> +<p> +S-BASE64 was written by <a href="http://homepage.mac.com/svc">Sven Van Caekenberghe</a>. +</p> +<h3 id="maintainers">Maintainers</h3> +<p> +S-BASE64 is being maintained by <a href="http://homepage.mac.com/svc">Sven Van Caekenberghe</a>. +</p> +<h3 id="license">License</h3> +<p> +You are granted the rights to distribute and use this software +as governed by the terms of the Lisp Lesser General Public License +(<a href="http://opensource.franz.com/preamble.html">http://opensource.franz.com/preamble.html</a>), +also known as the LLGPL. +</p> +<h3 id="history">History</h3> +<p> +S-BASE64 was originally part of KPAX and became a seperate project in October 2005. +</p> +<h3 id="references">References</h3> +<p> +The following RFC's can be considered as definitions of Base64 Encoding: +<ul> +<li><a href="http://www.ietf.org/rfc/rfc1421.txt">RFC 1421</a></li> +<li><a href="http://www.ietf.org/rfc/rfc2045.txt">RFC 2045</a></li> +<li><a href="http://www.ietf.org/rfc/rfc3548.txt">RFC 3548</a></li> +</ul> +</p> +<div class="footer"> +Copyright © 2002-2006 Sven Van Caekenberghe, Beta Nine BVBA. All Right Reserved. - +<a href="http://validator.w3.org/check/referer">This page is W3C Valid XHTML 1.0 Strict</a> - +<a href="http://www.anybrowser.org/campaign/">Viewable With Any Browser</a> +</div> +</body> +</html> diff --git a/third-party/s-base64/s-base64.asd b/third-party/s-base64/s-base64.asd new file mode 100644 index 0000000..1793973 --- /dev/null +++ b/third-party/s-base64/s-base64.asd @@ -0,0 +1,30 @@ +;;;; -*- Mode: LISP -*- +;;;; +;;;; $Id: s-xml-rpc.asd,v 1.2 2004/06/17 19:43:11 rschlatte Exp $ +;;;; +;;;; The S-BASE64 ASDF system definition +;;;; +;;;; 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 :asdf) + +(defsystem :s-base64 + :name "S-BASE64" + :author "Sven Van Caekenberghe <svc@mac.com>" + :version "2" + :maintainer "Sven Van Caekenberghe <svc@mac.com>" + :licence "Lesser Lisp General Public License (LLGPL)" + :description "Common Lisp Base64 Package" + :long-description "S-BASE64 is a Common Lisp implementation of Base64 Encoding/Decoding" + + :components + ((:module + :src + :components ((:file "package") + (:file "base64" :depends-on ("package")))))) + +;;;; eof 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 diff --git a/third-party/s-base64/test/all-tests.lisp b/third-party/s-base64/test/all-tests.lisp new file mode 100644 index 0000000..ad2fdec --- /dev/null +++ b/third-party/s-base64/test/all-tests.lisp @@ -0,0 +1,15 @@ +;;;; -*- mode: lisp -*- +;;;; +;;;; $Id: all-tests.lisp,v 1.2 2004/06/17 19:43:11 rschlatte Exp $ +;;;; +;;;; Load and execute all unit and functional tests +;;;; +;;;; 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. + +(load (merge-pathnames "test-base64" *load-pathname*) :verbose t) + +;;;; eof diff --git a/third-party/s-base64/test/test-base64.lisp b/third-party/s-base64/test/test-base64.lisp new file mode 100644 index 0000000..ae5b50f --- /dev/null +++ b/third-party/s-base64/test/test-base64.lisp @@ -0,0 +1,140 @@ +;;;; -*- mode: lisp -*- +;;;; +;;;; $Id: test-base64.lisp,v 1.1.1.1 2004/06/09 09:02:41 scaekenberghe Exp $ +;;;; +;;;; Unit and functional tests for base64.lisp +;;;; +;;;; 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) + +(assert + (equal (multiple-value-list (core-encode-base64 0 0 0)) + (list #\A #\A #\A #\A))) + +(assert + (equal (multiple-value-list (core-encode-base64 255 255 255)) + (list #\/ #\/ #\/ #\/))) + +(assert + (equal (multiple-value-list (core-encode-base64 1 2 3)) + (list #\A #\Q #\I #\D))) + +(assert + (equal (multiple-value-list (core-encode-base64 10 20 30)) + (list #\C #\h #\Q #\e))) + +(assert + (equal (multiple-value-list (core-decode-base64 #\A #\A #\A #\A)) + (list 0 0 0))) + +(assert + (equal (multiple-value-list (core-decode-base64 #\/ #\/ #\/ #\/)) + (list 255 255 255))) + +(assert + (equal (multiple-value-list (core-decode-base64 #\A #\Q #\I #\D)) + (list 1 2 3))) + +(assert + (equal (multiple-value-list (core-decode-base64 #\C #\h #\Q #\e)) + (list 10 20 30))) + +(assert + (let* ((string "Hello World!") + (bytes (map 'vector #'char-code string)) + encoded + decoded) + (setf encoded (with-output-to-string (out) + (encode-base64-bytes bytes out))) + (setf decoded (with-input-from-string (in encoded) + (decode-base64-bytes in))) + (equal string + (map 'string #'code-char decoded)))) + +;;; test some known values (from RFC 3548, section 7) + +(assert + (string= (with-output-to-string (out) + (encode-base64-bytes #(#x14 #xfb #x9c #x03 #xd9 #x7e) out)) + "FPucA9l+")) + +(assert + (string= (with-output-to-string (out) + (encode-base64-bytes #(#x14 #xfb #x9c #x03 #xd9) out)) + "FPucA9k=")) + +(assert + (string= (with-output-to-string (out) + (encode-base64-bytes #(#x14 #xfb #x9c #x03) out)) + "FPucAw==")) + +;;; this is more of a functional test + +(defun same-character-file (file1 file2) + (with-open-file (a file1 :direction :input) + (with-open-file (b file2 :direction :input) + (loop + (let ((char-a (read-char a nil nil nil)) + (char-b (read-char b nil nil nil))) + (cond ((not (or (and (null char-a) (null char-b)) + (and char-a char-b))) + (return-from same-character-file nil)) + ((null char-a) + (return-from same-character-file t)) + ((char/= char-a char-b) + (return-from same-character-file nil)))))))) + +(defun same-binary-file (file1 file2) + (with-open-file (a file1 :direction :input :element-type 'unsigned-byte) + (with-open-file (b file2 :direction :input :element-type 'unsigned-byte) + (loop + (let ((byte-a (read-byte a nil nil)) + (byte-b (read-byte b nil nil))) + (cond ((not (or (and (null byte-a) (null byte-b)) + (and byte-a byte-b))) + (return-from same-binary-file nil)) + ((null byte-a) + (return-from same-binary-file t)) + ((/= byte-a byte-b) + (return-from same-binary-file nil)))))))) + +(let ((original (merge-pathnames "test.b64" *load-pathname*)) + (first-gif (merge-pathnames "test.gif" *load-pathname*)) + (b64 (merge-pathnames "test2.b64" *load-pathname*)) + (second-gif (merge-pathnames "test2.gif" *load-pathname*))) + (with-open-file (in original + :direction :input) + (with-open-file (out first-gif + :direction :output + :element-type 'unsigned-byte + :if-does-not-exist :create + :if-exists :supersede) + (decode-base64 in out))) + (with-open-file (in first-gif + :direction :input + :element-type 'unsigned-byte) + (with-open-file (out b64 + :direction :output + :if-does-not-exist :create + :if-exists :supersede) + (encode-base64 in out nil))) + (assert (same-character-file original b64)) + (with-open-file (in b64 + :direction :input) + (with-open-file (out second-gif + :direction :output + :element-type 'unsigned-byte + :if-does-not-exist :create + :if-exists :supersede) + (decode-base64 in out))) + (assert (same-binary-file first-gif second-gif)) + (delete-file first-gif) + (delete-file b64) + (delete-file second-gif)) + +;;;; eof
\ No newline at end of file diff --git a/third-party/s-base64/test/test.b64 b/third-party/s-base64/test/test.b64 new file mode 100644 index 0000000..55445dd --- /dev/null +++ b/third-party/s-base64/test/test.b64 @@ -0,0 +1 @@ +R0lGODlhNABYAMQAAP////vi5etreuM0SN8ZL+dOYPCIk+56hPi/xPGapPjP1N4EGvHr9PSstMzI6riw4IY+kHsie3lvyVtMu0Y4tN3b8Y+CzX1ast2ftskNNNBdfqGb2so0WeHL4E8spLA0aiH5BAAAAAAALAAAAAA0AFgAQAX/ICCOZGmeaKqeBUEc5WAATbECQnCfyiAWsFIBgfMJFoTOYcAQERYN0SK4KxEUp4FPC/ABXN/oKOCtmh0OxGPj+UAgHmKhIZiZHJLJhMKXNKsMFQAMFnp6EogWFxEWOAsCgw4VfyN5IhKNABMPZhAUe3yhoYiYFmsWiISYlCoMeaJ8ehR5hoektLCjEhCcJGgQqSkKC1BmxscBxEQkBAlOxSMDCzY/ZQAICyPEOwnbCgXgcyQCBeQFWCIHVDXhJN/hkMc0DR0iA80oPXbyI+Vd6CO+RdOxjAWVYz367bPXzciVHjKwGCAwg4AOfiUOEBgg4ICAe08WYCFgQ0aKBtaM/xWSEMuQKA+1WHrIhYpCJgB4KDzYA4BPFQejLAgdSvSB0QoOHgCT4GAEKqSfUuT8ZIHVCAYbWOaaQErSiqoYw4oVkWxBwRETt41RW2KBNWluq5QteCAbiQJxSRATQIDVRisLnJmQ5sLi2MNhP24cUIDxRcRjCAsG0HgHnbEaFRAwAURExxsJHh8jB2CJiQZBOALokHIEgXiqjQks3frcFyRdcKfzonGBaGMDxFzTIgDBMBd4GVN7sQSdAWpiuZQIsJHkCwNQqKOgCBmF2wZu5xj4XUL4MUJcMTlowmANhAgXhGoIIMA5NUKwQIWCcANNIkEMMPDBAWgUmAEGIgwDQ/97u2ByCQVNTdCIBRTssEEfVpUWjwgMpIHKTQCg0oQnguhhBgObPCBBLys4gIoEJVTA0gSCGIPUegBolV8tomwSVgUTiEBhehZsgMB6AZ4Q4JJLcjhIh1ntAeMITamw0ycSbDDJHx0aRdSLuPSIyQM1rnAEMcRc0R0/c7EADUppLgRAAoRtuE0ABvBF3lpmlTCMI9A5shkz1vB1G0AqtNkPEoWx9cwMGllRWEitmTCMSAlCw4ymAFxaz6KWOuqmnGuWaqqpHQTw6almbmSAAqoG8M0AB3XXA0mC/bWCbYjxNQ0JdHY6WQoJZDgaYymhJEICgaKQg1hXgDMYOuKooMD/hvJQx4BmlsYT7GyWGoZRcJRhm44z3HaaFzOD4mXeDglRVitlWMjgghYgJaCZuE8gWkW86ZJgxCOA0iBtp1royk8Zmi1UGAAT4WmSZwREYUClZhzQ7MX3MDqFri4kIK7BY12cxRW+4dNCuSaQNpYW74KHhALgbXawpQP4ixGzWoiD3UZ9HkAqCUKfysA9zx1AJznvrlkBmCuu10AGCFSgDg5Y0CFaIbLAAuIJF86CyAZGbWDKAxwcoEACFbzhgZEWwHEBV0H5oSNLX5eAipSkcDWBB3MjsocHeUhwwQdEoFgmABX4ZCJLrSylCwQfoFHB5RpwIAJ4BehIwQY49tTI/wMVArDTDu1JKRSL2GBBXdMkFNIE5JpMeQOKNYl9i+CFk9KLJIQ0gUpTURmTR+67J5/IA2iQQEhOthvjgH5crT7UUrZsMMIDNa04Vt9i75Ee+KNUiRF6sTDFIfU8toTIWUqm0PgmE5i/QpLyXGh/Ja/4AQHUsciFAGExEzGBhUOIMEF7JDfAUMykgFv5RB/CZ4sHGAsFeABFTJSXvCKFjlUgnA5cMBbCUPXpBBtCQB3yNCwa1OFqIkAADK5lgAOsygQdUMYJiPGWX5mgLo/BRmACooIcnpAZvjLPE2rVjVUxoGKiSoER4beysrQFU2TBohNgUBcSkmCK7piCAS62LlR12QUAC1hIC8aIHU6hAIzaGNYThtWNzbwGWGc04w0uVRAwhDGPufFhplqYnBUIMQB4WiKiREYMG2pjUJ0607A60MaJneBnJayCbjK5HR5y8pNiCQEAOw==
\ No newline at end of file |