From ddb83b1fb2d305e0c06fc067d82d6bab5458b0fd Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Fri, 30 Oct 2009 20:52:07 +0100 Subject: Add third-party XML processing libraries. Ignore-this: 5ca28497555bf944858ca2f58bc8a62b darcs-hash:a0b0f9baa7c9b1259e755435db1fb17123630a6c --- third-party/s-base64/.clbuild-skip-update | 0 third-party/s-base64/Makefile | 82 +++++++++ third-party/s-base64/README.txt | 1 + third-party/s-base64/doc/API.html | 11 ++ third-party/s-base64/doc/index.html | 266 +++++++++++++++++++++++++++++ third-party/s-base64/s-base64.asd | 30 ++++ third-party/s-base64/src/base64.lisp | 152 +++++++++++++++++ third-party/s-base64/src/package.lisp | 22 +++ third-party/s-base64/test/all-tests.lisp | 15 ++ third-party/s-base64/test/test-base64.lisp | 140 +++++++++++++++ third-party/s-base64/test/test.b64 | 1 + 11 files changed, 720 insertions(+) create mode 100644 third-party/s-base64/.clbuild-skip-update create mode 100644 third-party/s-base64/Makefile create mode 100644 third-party/s-base64/README.txt create mode 100644 third-party/s-base64/doc/API.html create mode 100644 third-party/s-base64/doc/index.html create mode 100644 third-party/s-base64/s-base64.asd create mode 100644 third-party/s-base64/src/base64.lisp create mode 100644 third-party/s-base64/src/package.lisp create mode 100644 third-party/s-base64/test/all-tests.lisp create mode 100644 third-party/s-base64/test/test-base64.lisp create mode 100644 third-party/s-base64/test/test.b64 (limited to 'third-party/s-base64') 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 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 @@ +S-BASE64

API for package S-BASE64

+
An implementation of standard Base64 encoding and decoding
+

(decode-base64 in out)   function

+
Decode a base64 encoded character input stream into a binary output stream
+

(decode-base64-bytes stream)   function

+
Decode a base64 encoded character stream, returns a byte array
+

(encode-base64 in out &optional (break-lines t))   function

+
Encode a binary input stream into a base64 encoded character output stream
+

(encode-base64-bytes array stream &optional (break-lines t))   function

+
Encode a byte array into a base64b encoded character stream
+

Documentation generated by lispdoc running on LispWorks

 \ 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 @@ + + + +S-BASE64 + + + + + + + + +

Open Source Common Lisp Software

+

S-BASE64

+

A Common Lisp implementation of Base64 Encoding/Decoding

+

+S-BASE64 +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 Wikipedia article on Base64. +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 +other Open Source Common Lisp packages. +

+

Contents

+ +

Features

+

+S-BASE64 can: +

+ +

Status

+

+S-BASE64 is considered stable code. +

+

News

+

+October 2005 - Created as a seperate project. +

+

Platforms

+

+S-BASE64 is written in ANSI standard Common Lisp and should be portable across any CL implementation. +

+

Downloading

+

+You can download the latested released tarball of the S-BASE64 package from +http://homepage.mac.com/svc/s-base64/s-base64.tar.gz. +This archive is signed on release by Sven Van Caekenberghe, +whose public key is published at +http://homepage.mac.com/svc/sven-public-ascii.gpg, +the signature is in +http://homepage.mac.com/svc/s-base64/s-base64.tar.gz.asc. +

+

+Alternatively you can access the DARCS repository at +http://www.beta9.be/darcs/s-base64. +For a good description on how to use DARCS see +http://dirkgerrits.com/programming/erlisp/download/. +

+
+
$ 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!
+
+
Example of basic darcs usage, get everything once and keep up to date by pulling in changes
+

Installation

+

+The S-BASE64 package is loaded using ASDF. +There is an excellent tutorial on ASDF to get you started. +Alternatively you can use ASDF-INSTALL. +There is an great tutorial on ASDF-INSTALL to get you on the way. +

+
+
$ 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 # 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
+
+
Example of setting up and using ASDF to compile and load the package
+

Usage

+

+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: +

+
+
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)
+
+
Example Base64 Encoding and Decoding
+

API Reference

+

+There is automatically generated API Reference documentation available for the S-BASE64 package. +

+

Mailinglist

+

+The KPAX mailing list is used for this project. +

+

Changelog

+

+Release Notes: +

+ +

TODO

+

+There is a variant of Base64 encoding used for URL's and filenames that could be implemented. +

+

FAQ

+

+Nothing appropriate. +

+

Bugs

+

+Illegal input results in generic low-level CL conditions rather than a more meaningful high-level application specific condition. +

+

Authors

+

+S-BASE64 was written by Sven Van Caekenberghe. +

+

Maintainers

+

+S-BASE64 is being maintained by Sven Van Caekenberghe. +

+

License

+

+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. +

+

History

+

+S-BASE64 was originally part of KPAX and became a seperate project in October 2005. +

+

References

+

+The following RFC's can be considered as definitions of Base64 Encoding: +

+

+
+Copyright © 2002-2006 Sven Van Caekenberghe, Beta Nine BVBA. All Right Reserved. - +This page is W3C Valid XHTML 1.0 Strict - +Viewable With Any Browser +
+ + 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 " + :version "2" + :maintainer "Sven Van Caekenberghe " + :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 -- cgit v1.2.3