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:
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)
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.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.
Prototypes:
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, <norman@astro.gla.ac.uk>
Released under the terms of the GNU General Public Licence
$Revision$
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.
Usage:
(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.
Example:
(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
<http://www.itu.int/ITU-T/studygroups/com17/languages/X.680-0207.pdf>
The BER/CER/DER standard is X.690, at
<http://www.itu.int/ITU-T/studygroups/com17/languages/X.690-0207.pdf>
See Burton S Kaliski's `A Layman's Guide to a Subset of ASN.1,
BER, and DER'. See <ftp://ftp.rsa.com/pub/pkcs/ps/layman.ps>, or
<http://www.columbia.edu/~ariel/ssleay/layman.html> 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
below).
CONFIGURATION
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, <norman@astro.gla.ac.uk>
Released under the terms of the GNU General Public Licence
$Revision$
$Log$
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 decode-der-mzscheme.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, <norman@astro.gla.ac.uk>.
Released under the terms of the GNU General Public Licence
$Revision$
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 http://okmij.org/ftp/Scheme/xml.html),
but because it's only for writing XML, rather than reading, transforming,
and much else beside, it's much smaller.
Usage:
(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
<http://www.hixie.ch/advocacy/xhtml> there are some gotchas associated with
distributing XHTML as text/html.
Examples:
(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
<http://www.w3.org/TR/REC-xml/#sec-prolog-dtd>. 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<there"
Copyright 2006-2010 Norman Gray, <norman@astro.gla.ac.uk>
Released under the terms of the GNU General Public Licence.
Functions to handle XML-RPC
See spec at <http://www.xmlrpc.com/spec>
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 <norman@astro.gla.ac.uk>
Released under the terms of the GNU General Public Licence
$Revision$