Update quicklisp bundle and include s-base64 package

lisp/bundle-info.sexp

@@ -1,10 +1,10 @@
-(:CREATION-TIME "2022-01-05T19:44:41Z" :REQUESTED-SYSTEMS
- ("alexandria" "uiop" "esrap") :LISP-INFO
- (:MACHINE-INSTANCE "55e4f10b2bcc" :MACHINE-TYPE "aarch64" :MACHINE-VERSION NIL
-  :LISP-IMPLEMENTATION-TYPE "ECL" :LISP-IMPLEMENTATION-VERSION "21.2.1")
+(:CREATION-TIME "2022-08-24T11:17:49Z" :REQUESTED-SYSTEMS
+ ("alexandria" "uiop" "s-base64" "esrap") :LISP-INFO
+ (:MACHINE-INSTANCE "LPT-9DQ8RQ2-LN" :MACHINE-TYPE "x86_64" :MACHINE-VERSION
+  NIL :LISP-IMPLEMENTATION-TYPE "ECL" :LISP-IMPLEMENTATION-VERSION "20.4.24")
  :QUICKLISP-INFO
- (:HOME "/home/mersdk/quicklisp/" :LOCAL-PROJECT-DIRECTORIES
-  ("/home/mersdk/quicklisp/local-projects/") :DISTS
+ (:HOME "/home/rcasenave/quicklisp/" :LOCAL-PROJECT-DIRECTORIES
+  ("/home/rcasenave/quicklisp/local-projects/") :DISTS
   ((:NAME "quicklisp" :DIST-URL
-    "http://beta.quicklisp.org/dist/quicklisp/2021-10-21/distinfo.txt" :VERSION
-    "2021-10-21"))))
+    "http://beta.quicklisp.org/dist/quicklisp/2022-07-08/distinfo.txt" :VERSION
+    "2022-07-08"))))

lisp/local-projects/sextant/dependencies.sexp

@@ -1,3 +1,4 @@
 ("alexandria"
 "uiop"
+"s-base64"
 "esrap")

lisp/software/alexandria-20210807-git/alexandria-tests.asd

@@ -1,12 +0,0 @@
-(defsystem "alexandria-tests"
-  :licence "Public Domain / 0-clause MIT"
-  :description "Tests for Alexandria, which is a collection of portable public domain utilities."
-  :author "Nikodemus Siivola <nikodemus@sb-studio.net>, and others."
-  :depends-on (:alexandria #+sbcl :sb-rt #-sbcl :rt)
-  :components ((:file "alexandria-1/tests")
-               (:file "alexandria-2/tests"))
-  :perform (test-op (o c)
-             (flet ((run-tests (&rest args)
-                      (apply (intern (string '#:run-tests) '#:alexandria-tests) args)))
-               (run-tests :compiled nil)
-               (run-tests :compiled t))))

lisp/software/alexandria-20210807-git/doc/Makefile

@@ -1,31 +0,0 @@
-.PHONY: clean html pdf include clean-include clean-crap info doc
-
-doc: pdf html info clean-crap
-
-clean-include:
-	rm -rf include
-
-clean-crap:
-	rm -f *.aux *.cp *.fn *.fns *.ky *.log *.pg *.toc *.tp *.tps *.vr
-
-clean: clean-include
-	rm -f  *.pdf *.html *.info
-
-include:
-	sbcl --no-userinit --eval '(require :asdf)' \
-	--eval '(let ((asdf:*central-registry* (list "../"))) (require :alexandria))' \
-	--eval '(with-compilation-unit () (load "docstrings.lisp"))' \
-	--eval '(sb-texinfo:generate-includes "include/" (list :alexandria-1 :alexandria-2) :base-package :alexandria)' \
-	--eval '(quit)'
-
-pdf: include
-	texi2pdf alexandria.texinfo
-
-html: include
-	makeinfo --html --no-split alexandria.texinfo
-
-info: include
-	makeinfo alexandria.texinfo
-
-publish:
-	rsync -va alexandria.pdf alexandria.html common-lisp.net:/project/alexandria/public_html/draft/

lisp/software/alexandria-20220707-git/.gitlab-ci.yml

@@ -0,0 +1,27 @@
+include:
+  project: 'clci/gitlab-ci'
+  ref: release/v2-dev
+  file:
+    - definitions.gitlab-ci.yml
+    - test-pipeline.gitlab-ci.yml
+
+variables:
+  CLCI_INSTALL_QUICKLISP_CLIENT: "yes"
+  # Off by default because it's proprietary and has a separate license.
+  CLCI_TEST_ALLEGRO: "yes"
+  # Off by default because the Docker image is a bit out of date, due to
+  # upstream churn.
+  CLCI_TEST_CLASP: "yes"
+  # Alexandria is a non-commercial project, so we can use the express version
+  # of Allegro for testing.
+  I_AGREE_TO_ALLEGRO_EXPRESS_LICENSE: "yes"
+
+# This section is not strictly required, but prevents Gitlab CI from launching
+# multiple redundent pipelines when a Merge Request is opened.
+workflow:
+  rules:
+    - if: '$CI_PIPELINE_SOURCE == "merge_request_event"'
+    - if: '$CI_COMMIT_BRANCH && $CI_OPEN_MERGE_REQUESTS'
+      when: never
+    - if: '$CI_COMMIT_BRANCH'
+    - if: '$CI_COMMIT_TAG'

lisp/software/alexandria-20220707-git/alexandria-1/io.lisp

@@ -6,16 +6,16 @@
 (defmacro with-open-file* ((stream filespec &key direction element-type
                                    if-exists if-does-not-exist external-format)
                            &body body)
-  "Just like WITH-OPEN-FILE, but NIL values in the keyword arguments mean to use
-the default value specified for OPEN."
+  "Just like WITH-OPEN-FILE, but NIL values in the keyword arguments
+mean to use the default value specified for OPEN."
   (once-only (direction element-type if-exists if-does-not-exist external-format)
     `(with-open-stream
          (,stream (apply #'open ,filespec
                          (append
                           (when ,direction
                             (list :direction ,direction))
-                          (when ,element-type
-                            (list :element-type ,element-type))
+                          (list :element-type (or ,element-type
+                                                  (default-element-type)))
                           (when ,if-exists
                             (list :if-exists ,if-exists))
                           (when ,if-does-not-exist
@@ -24,6 +24,16 @@ the default value specified for OPEN."
                             (list :external-format ,external-format)))))
        ,@body)))
 
+(defun default-element-type ()
+  ;; On Lispworks, ELEMENT-TYPE :DEFAULT selects the appropriate
+  ;; subtype of CHARACTER for the given external format which can
+  ;; represent all possible characters.
+  #+lispworks :default
+  ;; The spec says that OPEN's default ELEMENT-TYPE (when it is not
+  ;; specified) is CHARACTER, but on AllegroCL it's (UNSIGNED-BYTE 8).
+  ;; No harm done by specifying it on other implementations.
+  #-lispworks 'character)
+
 (defmacro with-input-from-file ((stream-name file-name &rest args
                                              &key (direction nil direction-p)
                                              &allow-other-keys)
@@ -53,9 +63,10 @@ which is only sent to WITH-OPEN-FILE when it's not NIL."
 (defun read-stream-content-into-string (stream &key (buffer-size 4096))
   "Return the \"content\" of STREAM as a fresh string."
   (check-type buffer-size positive-integer)
-  (let ((*print-pretty* nil))
-    (with-output-to-string (datum)
-      (let ((buffer (make-array buffer-size :element-type 'character)))
+  (let ((*print-pretty* nil)
+        (element-type (stream-element-type stream)))
+    (with-output-to-string (datum nil :element-type element-type)
+      (let ((buffer (make-array buffer-size :element-type element-type)))
         (loop
           :for bytes-read = (read-sequence buffer stream)
           :do (write-sequence buffer datum :start 0 :end bytes-read)
@@ -66,8 +77,7 @@ which is only sent to WITH-OPEN-FILE when it's not NIL."
 
 The EXTERNAL-FORMAT parameter will be passed directly to WITH-OPEN-FILE
 unless it's NIL, which means the system default."
-  (with-input-from-file
-      (file-stream pathname :external-format external-format)
+  (with-input-from-file (file-stream pathname :external-format external-format)
     (read-stream-content-into-string file-stream :buffer-size buffer-size)))
 
 (defun write-string-into-file (string pathname &key (if-exists :error)

lisp/software/alexandria-20220707-git/alexandria-1/lists.lisp

@@ -265,7 +265,7 @@ expected-type designator of a TYPE-ERROR."
       (list list)))
 
 (defun remove-from-plist (plist &rest keys)
-  "Returns a propery-list with same keys and values as PLIST, except that keys
+  "Returns a property-list with same keys and values as PLIST, except that keys
 in the list designated by KEYS and values corresponding to them are removed.
 The returned property-list may share structure with the PLIST, but PLIST is
 not destructively modified. Keys are compared using EQ."

lisp/software/alexandria-20220707-git/alexandria-1/tests.lisp

@@ -1,11 +1,11 @@
 (in-package :cl-user)
 
-(defpackage :alexandria-tests
+(defpackage :alexandria/tests
   (:use :cl :alexandria #+sbcl :sb-rt #-sbcl :rtest)
   (:import-from #+sbcl :sb-rt #-sbcl :rtest
                 #:*compile-tests* #:*expected-failures*))
 
-(in-package :alexandria-tests)
+(in-package :alexandria/tests)
 
 (defun run-tests (&key ((:compiled *compile-tests*)))
   (do-tests))
@@ -1558,6 +1558,21 @@
   "foo bar"
   "foo bar")
 
+(deftest read-stream-content-into-string.1-umlauts
+    (values (with-input-from-string (stream "föö βαρ")
+              (read-stream-content-into-string stream))
+            (with-input-from-string (stream "föö βαρ")
+              (read-stream-content-into-string stream :buffer-size 1))
+            (with-input-from-string (stream "föö βαρ")
+              (read-stream-content-into-string stream :buffer-size 6))
+            (with-input-from-string (stream "föö βαρ")
+              (read-stream-content-into-string stream :buffer-size 7)))
+  "föö βαρ"
+  "föö βαρ"
+  "föö βαρ"
+  "föö βαρ")
+
+
 (deftest read-stream-content-into-string.2
     (handler-case
         (let ((stream (make-broadcast-stream)))
@@ -2031,9 +2046,12 @@
   t
   t)
 
+;; In CLISP, (eql #C(2 0) 2) => T
+;; but       (eql #C(2 0) 2.0) => NIL
+;; so we need a complex start point
 (deftest iota.fp-start-and-complex-integer-step
     (equal '(#C(0.0 0.0) #C(0.0 2.0) #C(0.0 4.0))
-           (iota 3 :start 0.0 :step #C(0 2)))
+           (iota 3 :start #C(0.0 0.0) :step #C(0 2)))
   t)
 
 (deftest parse-ordinary-lambda-list.1

lisp/software/alexandria-20220707-git/alexandria-2/control-flow.lisp

@@ -19,7 +19,7 @@ The THREAD-FIRST-P decides where to thread the FORMS, accumulating in ACC."
   "Lines up FORMS elements as the first argument of their successor.
 Example:
 
- (thread-first
+ (line-up-first
    5
    (+ 20)
    /
@@ -37,7 +37,7 @@ threading."
   "Lines up FORMS elements as the last argument of their successor.
 Example:
 
- (thread-last
+ (line-up-last
    5
    (+ 20)
    /

lisp/software/alexandria-20220707-git/alexandria-2/tests.lisp

@@ -1,11 +1,11 @@
 (in-package :cl-user)
 
-(defpackage :alexandria2-tests
+(defpackage :alexandria-2/tests
   (:use :cl :alexandria-2 #+sbcl :sb-rt #-sbcl :rtest)
   (:import-from #+sbcl :sb-rt #-sbcl :rtest
                 #:*compile-tests* #:*expected-failures*))
 
-(in-package :alexandria2-tests)
+(in-package :alexandria-2/tests)
 
 ;; Arrays Tests
 (deftest dim-in-bounds-p.0

lisp/software/alexandria-20220707-git/alexandria.asd

@@ -67,4 +67,21 @@ the following constraints:
                          (:file "control-flow" :depends-on ("package"))
                          (:file "sequences" :depends-on ("package"))
                          (:file "lists" :depends-on ("package")))))
-  :in-order-to ((test-op (test-op "alexandria-tests"))))
+  :in-order-to ((test-op (test-op "alexandria/tests"))))
+
+(defsystem "alexandria/tests"
+  :licence "Public Domain / 0-clause MIT"
+  :description "Tests for Alexandria, which is a collection of portable public domain utilities."
+  :author "Nikodemus Siivola <nikodemus@sb-studio.net>, and others."
+  :depends-on (:alexandria #+sbcl :sb-rt #-sbcl :rt)
+  :components ((:file "alexandria-1/tests")
+               (:file "alexandria-2/tests"))
+  :perform (test-op (o c)
+                    (let ((unexpected-failure-p nil))
+                      (flet ((run-tests (&rest args)
+                               (unless (apply (intern (string '#:run-tests) '#:alexandria/tests) args)
+                                 (setf unexpected-failure-p t))))
+                        (run-tests :compiled nil)
+                        (run-tests :compiled t))
+                      (when unexpected-failure-p
+                        (error "Unexpected test failure")))))

lisp/software/alexandria-20220707-git/doc/docstrings.lisp

@@ -780,7 +780,7 @@ followed another tabulation label or a tabulation body."
           (format *texinfo-output* "@end itemize~%~%"))))))
 
 (defun texinfo-body (doc)
-  (write-texinfo-string (get-string doc)))
+  (write-texinfo-string (get-string doc) (lambda-list doc)))
 
 (defun texinfo-end (doc)
   (write-line (case (get-kind doc)

lisp/software/alexandria-20220707-git/scripts/ci-test.lisp

@@ -0,0 +1,5 @@
+;; Install all the deps
+(ql:quickload "alexandria/tests")
+
+;; Run the tests!
+(asdf:test-system "alexandria")

lisp/software/esrap-20220331-git/src/conditions.lisp

@@ -1,5 +1,5 @@
 ;;;; Copyright (c) 2007-2013 Nikodemus Siivola <nikodemus@random-state.net>
-;;;; Copyright (c) 2012-2016 Jan Moringen <jmoringe@techfak.uni-bielefeld.de>
+;;;; Copyright (c) 2012-2022 Jan Moringen <jmoringe@techfak.uni-bielefeld.de>
 ;;;;
 ;;;; Permission is hereby granted, free of charge, to any person
 ;;;; obtaining a copy of this software and associated documentation files
@@ -103,7 +103,8 @@ the error occurred."))
              :initform nil))
   (:default-initargs :result (required-argument :result))
   (:documentation
-   "This error is signaled when a parse attempt fails in a way that ."))
+   "This error is signaled when a parse attempt fails because the input
+text does not conform to the grammar."))
 
 (defmethod esrap-error-position ((condition esrap-parse-error))
   (result-position (esrap-parse-error-context condition)))

lisp/software/esrap-20220331-git/src/context.lisp

@@ -116,10 +116,11 @@
              (progn ,@body)
            (setf (context-nonterminal-stack ,context) ,previous))))))
 
-;;; SYMBOL and POSITION must all lexical variables!
+;;; SYMBOL and POSITION must all be lexical variables!
 (defmacro with-cached-result ((symbol position &optional (text nil)) &body forms)
   (with-gensyms (context cache heads result)
     `(flet ((do-it (position) ,@forms))
+       (declare (dynamic-extent #'do-it))
        (let* ((,context *context*)
               (,cache   (context-cache ,context))
               (,heads   (context-heads ,context))

lisp/software/s-base64-20130128-git/README.md

@@ -0,0 +1,183 @@
+# 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](http://en.wikipedia.org/wiki/Base64). 
+
+This simple package is used as a building block in a number of other open source projects e.g. the [KPAX](https://github.com/svenvc/KPAX) web development framework.
+
+### Contents
+
+-   [Features](#features)
+-   [Status](#status)
+-   [News](#news)
+-   [Platforms](#platforms)
+-   [Downloading](#downloading)
+-   [Installation](#installation)
+-   [Usage](#usage)
+-   [API Reference](#api)
+-   [Mailinglist](#mailinglist)
+-   [Changelog](#changelog)
+-   [TODO](#tod)
+-   [FAQ](#faq)
+-   [Bugs](#bugs)
+-   [Authors](#authors)
+-   [Maintainers](#maintainers)
+-   [License](#license)
+-   [History](#history)
+-   [References](#references)
+
+### Features
+
+`S-BASE64` can:
+
+-   convert a Base64 encoded character input stream into a decoded
+    binary output stream
+-   convert a binary output stream into a Base64 encoded character
+    output stream
+-   convert a Base64 encoded character input stream into a byte array
+-   convert a byte array into a Base64 encoded character output stream
+-   optionally break lines at 76 characters
+
+### Status
+
+`S-BASE64` is considered stable code.
+
+### News
+
+*October 2005* - Created as a separate project.
+
+### Platforms
+
+`S-BASE64` is written in ANSI standard Common Lisp and should be portable
+across any CL implementation.
+
+### Installation
+
+The `S-BASE64 package` is loaded using [ASDF](http://www.cliki.net/asdf).
+There is an excellent [tutorial on
+ASDF](http://constantly.at/lisp/asdf/) to get you started.
+
+    $ 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 Referencedocumentation
+available for the `S-BASE64` package in `doc/API.html`.
+
+### Mailinglist
+
+The [KPAX mailing
+list](http://common-lisp.net/cgi-bin/mailman/listinfo/kpax-devel) is
+used for this project.
+
+### Changelog
+
+Release Notes:
+
+-   release 1: moved `S-BASE64` into a seperate project under a new
+    structure
+
+### 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](http://opensource.franz.com/preamble.html)),
+also known as the LLGPL.
+
+### History
+
+`S-BASE64` was originally part of [KPAX](https://github.com/svenvc/KPAX) and became a separate project in
+October 2005.
+
+### References
+
+The following RFC's can be considered as definitions of Base64 Encoding:
+
+-   [RFC 1421](http://www.ietf.org/rfc/rfc1421.txt)
+-   [RFC 2045](http://www.ietf.org/rfc/rfc2045.txt)
+-   [RFC 3548](http://www.ietf.org/rfc/rfc3548.txt)
+
+Copyright © 2002-2006 Sven Van Caekenberghe, Beta Nine BVBA. All Right
+Reserved.

lisp/software/s-base64-20130128-git/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)&nbsp;&nbsp;&nbsp;<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)&nbsp;&nbsp;&nbsp;<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))&nbsp;&nbsp;&nbsp;<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))&nbsp;&nbsp;&nbsp;<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>

lisp/software/s-base64-20130128-git/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

lisp/software/s-base64-20130128-git/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

lisp/software/s-base64-20130128-git/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

lisp/software/s-base64-20130128-git/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

lisp/software/s-base64-20130128-git/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

lisp/software/s-base64-20130128-git/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==

lisp/system-index.txt

@@ -1,6 +1,6 @@
-software/alexandria-20210807-git/alexandria-tests.asd
-software/alexandria-20210807-git/alexandria.asd
-software/esrap-20211020-git/esrap.asd
+software/alexandria-20220707-git/alexandria.asd
+software/esrap-20220331-git/esrap.asd
+software/s-base64-20130128-git/s-base64.asd
 software/trivial-with-current-source-form-20211020-git/trivial-with-current-source-form.asd
 software/uiop-3.3.5/asdf-driver.asd
 software/uiop-3.3.5/uiop.asd