Various Scheme scripts

This is a rather miscellaneous collection of Scheme scripts I've written. There's nothing deep here, and I don't make great claims about my Scheme style, but you might find something that's useful.

Any comments, bug reports or other suggestions, do let me know.

The scripts are:

Implements a self-balancing binary search tree (AVL tree), with operations for creating, saving, restoring, and traversing the tree in a variety of ways.
Scheme support for that subset of the DER decoding rules required for X.509 certificates, specifically that described in
Burton S. Kaliski Jr. A Layman's Guide to a Subset of ASN.1, BER, and DER. An RSA Laboratories Technical Note. Revised November 1, 1993 (available online in a variety of places, but none with an obviously stable URL)
Support for contract-based programming, or Design By Contract. This defines lambda/contract and define/contract as library syntax. PLT Scheme already has a fuller version of this, but this is written in pure R5RS syntax.
A simple routine for converting S-expressions to XML. It's inspired by SXML, but because it's only for writing XML, it's much simpler.
A set of routines to help handle XML-RPC method calls and responses, implementing the XML-RPC spec. This works using a S-Expression representation of the XML, so you'll need something which can parse XML to S-Expressions and back again, such as SSAX or, if you're using SISC, the sexp-xml module I've contributed to the SISC tree in contrib/pure-scheme/sexp-xml.scm (this is distinct from the sexp-xml module above, and uses the Java XML architecture to do its XML parsing).

In each case, the implementation should be in portable R5RS Scheme, possibly including a couple of SRFIs. The only exception is where the implementations use the not-quite portable format function, and in these cases you'll have to customise the top of the script as indicated.



     Handles creating and using a self-balancing binary tree (specifically
     an AVL tree).
     The only externally visible function is NEW-TREE.
     Create a new tree, with comparator function CMP.  This returns a procedure
     which gives access to the tree via the following commands.
     The CMP procedure is a two-argument procedure, which is applied to the
     objects added to the tree, and which returns negative, zero
     or positive depending on whether the first argument is less than,
     equal to, or greater than the second.
       (define tree (new-tree cmp)) : Create a new TREE procedure.
       (tree 'add data)
            Add the given data to the tree.  The data must be an acceptable
            argument to the CMP function.
       (tree 'get key)
            Retrieve an item of data matching the key (that is,
            an item D such that (CMP KEY D) evaluates to zero.  If there is
            no such item, it returns #f.  The KEY is always applied
            as the first argument of CMP.
       (tree 'drill visitor-down ?visitor-up)
            Drill down into the tree, visiting each node on the way down
            and up.
                VISITOR-DOWN data -> integer
                VISITOR-UP   data integer boolean -> integer
            Apply VISITOR-DOWN to the data of the current node.  If it
            returns 0, return the result of applying VISITOR-UP to
            (current-node #f #f).
            If it returns negative/positive, return the result of
            applying VISITOR-UP to the data of the current node, 
            the result of applying this algorithm to the left/right child,
            and a boolean which is true if the child in question was from
            the right tree.
            If we run out of tree (that is, if NODE is #f), then call
            (VISITOR-UP #f #f #f).
            If VISITOR-UP is not present, then a default is used, which
            simply returns the data of the node on which VISITOR-DOWN
            returned 0, or #f if there was no such node.
       (tree 'restore filename)
            Restore the state of the tree from the given file.
       (tree 'save filename)
            Save the state of the tree to the given file.
       (tree 'stats)
            Return a list of pairs giving statistics of the tree.
       (tree 'sum visitor)
            Prototype: VISITOR data any any -> any
            'Traverse' the tree by, for each node, applying VISITOR
            to the node's data, the result of applying this procedure
            to the node's left child, and to its right child, returning
            the result.
       (tree 'traverse visitor)
            Visit each node in the tree in order, applying the one-arg
            procedure VISITOR to the data of each node.
     Copyright Norman Gray 2006, <>
     Released under the terms of the GNU General Public Licence



     This is a partial implementation of the ASN.1 DER encoding rules.
     Given an octet list, the procedure (DER:DECODE L) will decode the
     list L, returning an appropriate Scheme type.
         (DER:DECODE der-encoded-value) => decoded-value
         (DER:DECODE der-encoded-value <option> ...) => decoded-value
     where DER-ENCODED-VALUE is a list of bytes, and DECODED-VALUE is
     the corresponding value, as a suitable Scheme type, or #f on error.
     The only exception to this 'suitable' rule is that ASN.1 booleans are
     returned as either 'true or 'false, in order that the DER:DECODE procedure
     is not specified to return #f on a value decode.
     The optional <option> arguments are one of:
        (include-tags <boolean>)
           Include tags in output
        (translate-oids <boolean>)
           If true, then OIDs appearing in the output are displayed as strings rather
           than symbols corresponding to the numeric OIDs
        (save-error <procedure>)
           The <PROCEDURE> is a procedure of one argument, which receives a string
           which indicates an error message, in the event that decoding fails.
         (der:decode '(#x13 #x0b #x54 #x65 #x73 #x74 #x20
                            #x55 #x73 #x65 #x72 #x20 #x31))
            => "Test User 1"
         (der:decode '(#x13 #x0b #x54 #x65 #x73 #x74 #x20
                            #x55 #x73 #x65 #x72 #x20 #x31)
                     '(include-tags #t))
            => '(printable-string . "Test User 1")
     If the DER-encoded value is malformed in some way, then DER:DECODE returns
     #f.  In this case, the 'save-error procedure is called with an
     explanatory error message.
     The ASN.1 standard is X.680, available at
     The BER/CER/DER standard is X.690, at
     See Burton S Kaliski's `A Layman's Guide to a Subset of ASN.1,
     BER, and DER'.  See <>, or 
     <> for an HTML version.
     The set of types implemented is the set used by X.509 certificates,
     as described in Kalinski's paper.  Most of the test cases below
     are taken from there, too.
     Uses SRFI-8 (receive multiple values) and SRFI-60 (integers as bits).
     It also uses the not-quite-portable FORMAT function, which it abstracts
     in syntactic sugar as the syntax SFORMAT (see the configuration section
     This file is distributed with support for the required SRFIs and the
     SFORMAT sugar indicated for a couple of Scheme implementations,
     but commented out (search for the string @CONFIG@).
     Uncomment as appropriate, with for example
        % cat >decode-der-mzscheme
        #!/bin/sh -
        exec mzscheme -f "$0" ${1+"$@"}
        (define (main args)
          (let loop ((bytes #"")
                     (new-bytes (read-bytes 1024)))
            (if (eof-object? new-bytes)
                (display (der:decode (bytes->list bytes)))
                (loop (bytes-append bytes new-bytes)
                      (read-bytes 1024)))))
        % sed 's/^;@CONFIG mzscheme@//' decode-der.scm >>decode-der-mzscheme
        % chmod +x decode-der-mzscheme
        % ./decode-der-mzscheme <asn1-data
     The file contains a reasonably extensive suite of regression tests,
     at the end.  It's distributed with these tests enabled, so that
     they are run whenever the file is loaded.  To remove these, use
        % sed '/^;@CONFIG tests below/q'
     Copyright 2006, 2008 Norman Gray, <>
     Released under the terms of the GNU General Public Licence
     Revision 1.14  2009/01/08 16:05:47  norman
     Adjust URLs
     Revision 1.13  2008/12/11 21:02:34  norman
     Preen comments
     Revision 1.12  2008/12/11 12:55:24  norman
     @CONFIG@ stuff adjusted so that the mzscheme case produces a module file
     SISC support fixed
     Revision 1.11  2008/12/10 17:04:01  norman
     decode-der.scm can now parse a broader range of X.509 certificates, and this is exercised
       in, which formats them in a variety of ways.
     Revision 1.10  2008/12/02 22:57:11  norman
     Preen comments
     Revision 1.9  2008/12/02 22:50:00  norman
     Remove der:last-error, der:decode-include-tag! and der:lookup-oids!,
       replacing them with a more functional otions argument to der:decode
     Revision 1.8  2008/12/02 21:07:32  norman
     Substantial reworking, to handle features found in other certificates
     Revision 1.7  2008/11/25 22:28:55  norman
     Now copes with the indefinite-length encoding
     This required substantial reimplementation, as it turned out,
       but the result is a lot neater
     Revision 1.6  2008/07/02 22:05:11  norman
     Adjustments to make webpage format correctly
     Revision 1.5  2008/07/02 21:51:27  norman
     Add a main function for mzscheme
     Change the behaviour when reading context sequences
     Revision 1.4  2006/09/05 07:41:01  norman
     Tweaks to make configuration more mechanical
     Revision 1.3  2006/08/31 14:00:42  norman
     DER:DECODE now returns #f on malformed DER values, rather than error
     Added DER:LAST-ERROR to return error message in that case
     Revision 1.2  2006/08/12 22:09:58  norman
     Tidied up for release:
     Public functions given a der: prefix
     All tests moved to the end
     Added notes about configuration for particular systems, flagged
       with string @CONFIG@



     Specify lambdas with contracts:
     (lambda/contract (<argspec>*)    body ...)
     (lambda/contract (<argspec>* -> ensure?)    body ...)
     (define/contract (funcname <argspec>*) body ...)
     (define/contract (funcname <argspec>* -> ensure?) body ...)
     <argspec>* is a list of zero or more <argspec>
     <argspec> is either ARGUMENT or (ARGUMENT REQUIRE?) or (ARGUMENT (<expr>))
         where <expr> is an expression involving ARGUMENT, which evaluates
         to true or false
     REQUIRE? and ENSURE? are predicates.
     For example:
        (define/contract (my-sqrt x
                                  (y positive?)
                                  (z (> z 0))
                                  -> positive?) (sqrt (+ x y z)))
     The ENSURE? predicate must, at present, be a procedure, and can't yet
     be an expr.
     Code which uses these transformers may define the handler function
     (VIOLATED-CONTRACT FMT . ARGS), which is called when a contract is
     violated, and which takes a format and arguments and handles them
     as appropriate.  The default VIOLATED-CONTRACT function throws an ERROR.
     Copyright 2006  Norman Gray, <>.
     Released under the terms of the GNU General Public Licence



     Given a list of SExps, SEXP-LIST, return this translated into a string
     Relies on SRFI-6, Basic String Ports.
     This is a simple, easily embeddable routine for converting S-expressions
     to XML.  It's inspired by SXML (see,
     but because it's only for writing XML, rather than reading, transforming,
     and much else beside, it's much smaller.
         (sexp->xml <sexp>) => string
         (sexp->xml <sexp> <block-element-list>? <para-element-list>? output-html?)
            => string
         (sexp->xml port <sexp> <block-element-list>? <para-element-list>? output-html?)
            => undef, but XML is written to the given port
         (sexp->html port? <sexp>)
            -- same as (sexp->xml port? <sexp> #f #f #t)
     Takes three optional arguments: the first specifies a list of
     elements which are to be formatted (ie, have linebreaks inserted)
     as `block' elements (like <div> in HTML), and the second a list
     which should be formatted as `para' elements (like HTML <p>).
     Either may be given as 'ALL to format all like this.  The default
     for each is #f, implying no linebreaking.
     The third optional argument is a switch -- if true, the output is
     slightly adjusted, so that the result is valid HTML (empty elements
     are output as '<br>' rather than '<br/>', and PIs are turned into comments.
     In this mode, the block- and para-element-list arguments are
     defaulted to versions appropriate for HTML.  As discussed at
     <> there are some gotchas associated with
     distributing XHTML as text/html.
         (sexp->xml '(top (el1 "hello") (el2 (@ (att val)))))
            => "<top><el1>hello</el1><el2 att='val'/></top>"
         (sexp->xml '(top (el1 "hello") (el2 (@ (att val)))) '(el1))
            => "<top><el1>\nhello</el1>\n\n<el2 att='val'/></top>"
         (sexp->xml  '(html (head (title "SEXPs") (meta))
                            (body (p (@ (class simple)) hello))))
            => "<html><head><title>SEXPs</title><meta/> ..."
         (sexp->html '(html (head (title "SEXPs") (meta))
                            (body (p (@ (class simple)) hello))))
            => "<html>\n<head>\n<title>SEXPs</title>\n<meta>\n ..."
     Partly for compatibility with SXML, you can wrap the <sexp> inside a *TOP* sexp:
         (sexp->xml '(*TOP* (p "hello")))
     We can also handle PIs, CTYPE marked sections, and comments:
         (sexp->xml '(*PI* "content")) => "<?content?>"
         (sexp->xml '(*CDATA* "hello<&" "more")) => "<![CDATA[hello<&more]]>"
         (sexp->xml '(*COMMENT* "comment" "stuff")) => "<!--commentstuff-->"
     You can generate the initial XML programming instruction with
     *XMLPI*, and a doctype declaration with *DOCTYPE*.  *XMLPI* takes
     an optional argument which is either a symbol abbreviation for a
     character encoding (one of utf8, utf16, ucs2, ucs4, 8859-n (n=1-16,
     excluding 12) 2022-jp, shift-jis, or euc-jp) or a literal string.
     The *DOCTYPE* form may take either one or three arguments: it may
     have either a single symbol argument (one of html4, xhtml,
     xhtml-10-strit, xhtml-10-transitional, xhtml-10-frameset or rdfa) or three string
     arguments indicating the 'Name', 'PubidLiteral' and 'SystemLiteral'
     of the 'doctypedecl' production of
     <>.  If either of these
     forms is included, it is necessary to wrap them and the content
     form inside a '(*TOP* ...)' form.
     Any content other than an element type which is #f, we simply ignore
         (sexp->xml '(p "Hello" #f "!")) => "Hello!"
     In addition, we define the utility function ESCAPE-STRING-FOR-XML:
         (escape-string-for-xml "hello<there") => "hello&lt;there"
     Copyright 2006-2010 Norman Gray, <>
     Released under the terms of the GNU General Public Licence.



     Functions to handle XML-RPC
     See spec at <>
     Procedures defined:
       xmlrpc:new-call SEXP
           Returns a call object by parsing the XML-RPC method call
           represented by the given SSAX-style S-expression, such as
           either '(methodCall (methodName "x") (params (param (value "y")))),
           or '(*TOP* (methodCall ...)).
       xmlrpc:call? CALL
           Returns #t if the object is one of the objects returned by
           XMLRPC:NEW-CALL, and #f otherwise.
       xmlrpc:method-name CALL
           Returns the method name in the given CALL, as a Scheme symbol.
       xmlrpc:method-param CALL INDEX
           Returns the INDEX'th parameter in the given CALL (1-based).
           Throws an error if the INDEX is not in the range
           [1..nparams].  The parameter values are returned as the
           corresponding Scheme types, with <struct> elements being
           returned as an alist (("member-name" <member-value>) ...),
           and <array> elements as a vector #(<value> ...).
       xmlrpc:method-param-list CALL
           Returns the complete set of parameters as a list.
       xmlrpc:number-of-params CALL
           Return the number of parameters in the given CALL.
       xmlrpc:create-response VALUE
           Create an XML-RPC response wrapping the VALUE.  The response
           is of a type appropriate to the VALUE.  If the VALUE is a
           string, then it's interpreted as a format string, and the
           trailing arguments are formatted into it.  Returns a
           sexp ready to be converted to XML.
       xmlrpc:create-fault FAULT-CODE ERROR-MESSAGE-FORMAT ARGUMENTS ...
           Create an XML-RPC fault response by applying the given format to
           the arguments.  Returns a sexp ready to be converted to XML,
           for example '(methodResponse (params (param (value (string "x")))))
     Requires SRFI-6, Basic String Ports, and SRFI-13, String Libraries.
     Copyright 2006, Norman Gray <>
     Released under the terms of the GNU General Public Licence

Mon Jan 18 16:59:50 2010 +0000