Remove md5 and mhash plugins. Increment doc and src versions.
NATIVE_OUT=${OUTPUT_DIR}/native
MACOSX_OUT=${OUTPUT_DIR}/macosx
- PLUGINS="blowfish edwin gdbm imail mcrypt md5 mhash x11 x11-screen"
-PLUGINS="blowfish gdbm mcrypt x11 x11-screen"
++PLUGINS="blowfish edwin gdbm imail mcrypt x11 x11-screen"
+PLUGINS="$PLUGINS berkeley-db pgsql"
+PLUGINS="$PLUGINS cairo gl glib gtk gtk-screen pango planetarium devops"
notify ()
{
dnl Process this file with autoconf to produce a configure script.
AC_INIT([MIT/GNU Scheme documentation],
- [9.2.8],
- [9.2.1],
- [bug-mit-scheme@gnu.org],
- [mit-scheme-doc])
++ [9.2.11],
+ [matt@birchwood-abbey.net],
+ [mit-scheme-pucked-doc])
AC_CONFIG_SRCDIR([ref-manual/scheme.texinfo])
AC_COPYRIGHT(
\input texinfo @c -*-texinfo-*-
@comment %**start of header
-@setfilename mit-scheme-user
-@set EDITION 1.94
-@set VERSION 9.2.1
-@set UPDATED 2015-11-25
-@settitle MIT/GNU Scheme @value{VERSION}
+@setfilename user
+@comment From automake's version.texi someday:
+@set EDITION 1.0
- @set UPDATED 8 April 2017
- @set SCMVERS 9.2.8
++@set UPDATED 23 December 2017
++@set SCMVERS 9.2.11
+@settitle MIT/GNU Scheme Pucked User Manual
@comment %**end of header
@setchapternewpage odd
@finalout
state that prevents Edwin from running.
@end deffn
-@node Release Notes
-@appendix Release Notes
+@c A full @node spec is needed here to avoid a bogus warning?
+@node Release Notes, Installation, Edwin, Top
+@chapter Release Notes
+
+This experimental version of MIT/GNU Scheme got a new project name,
+MIT/GNU Scheme Pucked, and a new command name,
+@code{mit-scheme-pucked}, so that it can be installed alongside the
+stable release. While it comes with an assortment of plugins and a
+strange name, the core of the system is largely unchanged.
+
+@section Proposed Changes
+
+The core of MIT/GNU Scheme Pucked is the @emph{bleeding edge core}.
+The head of the MIT/GNU Scheme project's development branch on
+Savannah is merged in frequently. Thus it includes changes proposed
+for the next stable release of MIT/GNU Scheme.
+
+@itemize @bullet
+@item
+Most of the bindings that we would fluid bind with @code{fluid-let},
+e.g. @code{*parser-radix*}, are deprecated. Parameters, found in
+corresponding bindings (e.g. @code{param:parser-radix}), should be
+used instead. @footnote{Parameters will be more easily implemented in
+SMPing (Symmetrically Multi-Processing) worlds.} For example, rather
+than fluid binding @code{*parser-radix*} with @code{fluid-let}
+
+@example
+(fluid-let ((*parser-radix* 16))
+ ...)
+@end example
+
+@noindent
+you should parameterize @code{param:parser-radix}
+
+@example
+(parameterize ((param:parser-radix 16))
+ ...)
+@end example
+
+@item
+CREF now supports deprecated bindings. It will list references to
+them in your packaging construction reports (@file{.crf} files).
+
+@item
+New unicode support means your old code can generate ``legacy
+strings'' suitable only for ``legacy ports''. Most string operations
+can handle legacy @emph{or} Unicode strings, but new procedures may
+only handle Unicode strings, and several old procedures are marked as
+``deprecated.''
+@end itemize
+
+The proposed changes to the core system are intended to produce a new
+release compatible with the current release. The new release will
+support both parameters and fluid bound bindings, both legacy and
+Unicode strings. It should thus be possible to run mixtures of old
+and new code, allowing you to replace references to deprecated
+bindings in stages.
+
+@section Experimental Changes
+
+The experimental code in this ``pucked'' version is almost entirely
+contained in the plugins. The core was changed only to replace the
+microcode modules and hook the Gtk screen into Edwin. Neither change
+should be apparent to the casual user.
+
+If your code does not hack Edwin and you previously said
+
+@example
+mit-scheme --load my-code
+@end example
+
+@noindent
+you should be able to say
+
+@example
+mit-scheme-pucked --load my-code
+@end example
+
+@noindent
+and be no worse off.
+
+@noindent
+Users @emph{may} need to make the following changes to their code.
+
+@itemize @bullet
+@item
+The Edwin subsystem is a plugin; it is no longer included in the
+default band @file{all.com}. However that band still handles the
+@code{--edit} command line option and provides an @code{edit}
+procedure. Either method of launching Edwin autoloads it with an
+appropriate screen type. If you are launching Edwin some other way,
+you will probably need to load a screen plugin first, e.g.@:
+@code{x11-screen}.
+
+@item
+The @code{(runtime gdbm)} and @code{(runtime x-graphics)} packages
+were removed. All of their bindings can now be found in the
+@code{(gdbm)} and @code{(x11 graphics)} packages. Thus @code{(runtime
+gdbm)} should be replaced with @code{(gdbm)} in package descriptions,
+and a @code{(global-definitions gdbm/)} line added. Similar
+changes are needed if you are using @code{(runtime x-graphics)}.
+
+One original binding cannot be found in the new packages:
+@code{gdbm-available?}. Generally, @code{-available?} procedures are
+not supported. Plugins are unknown (cannot provide such procedures)
+until @emph{after} they successfully load (at which point such
+procedures are moot). Thus something like
+@code{(gdbm-available?)} should be replaced with
+@code{(plugin-available? "gdbm")}.
+
+@item
+The @code{(runtime crypto)} and @code{(runtime blowfish)} packages are
+provided but deprecated. Their bindings are unassigned until
+corresponding plugins are loaded. When a band is restored these
+bindings are unassigned again. Thus a restored thread using them will
+quickly signal an error and can be aborted or restarted as
- appropriate. Four bindings, @code{blowfish-available?},
- @code{mcrypt-available?}, @code{md5-available?} and
- @code{mhash-available?}, are assigned procedures that autoload the
++appropriate. Two bindings, @code{blowfish-available?} and
++@code{mcrypt-available?} are assigned procedures that autoload the
+appropriate options. A restarted thread is assumed to begin again
+with a call to one of these.
+
+@item
+Edwin has had a number of screen procedures turned into SOS generic
+procedures, to support the experimental Gtk screen type. Such changes
+are transparent except that loading Edwin now loads SOS.
+@end itemize
+
+@noindent
+Users may also want to use the following enhancements in their code.
+
+@itemize @bullet
+@item
+The Debian packaging includes a @file{.desktop} file in
+@url{freedesktop.org} format. In the right place it makes this Scheme
+available through an icon (a lambda holding a fountain pen) in a
+@file{.desktop} aware application launcher.
+
+@item
+The installation process includes HTML documentation by default. In
+the right place these files are available in your web browser, whether
+online or offline, using a file URL like the following Ubuntu locator.
+
+@example
+@url{file:///usr/share/doc/mit-scheme-pucked/html/index.html}
+@end example
+
+HTML documentation for installed plugins is found in the same location.
+
+@item
+The @code{mit-scheme-pucked-planetarium} plugin can draw a simple
+tellurion, but that's about all.
+
+@item
+The @code{mit-scheme-pucked-gtk-screen} plugin allows Edwin to display
+text using Pango.
+@end itemize
+
+@cindex cond-expand feature
+@cindex feature, cond-expand
+The @code{cond-expand} feature @code{pucked} will be present, to keep
+your adaptations to this experiment separate from old code intended
+only for your stable worlds.
+
+@c A full @node spec is needed here to avoid a bogus warning.
+@node Installation, GNU Free Documentation License, Release Notes, Top
+@chapter Installation
+
+MIT/GNU Scheme Pucked and its plugins are now available as packages
+for recent versions of Ubuntu on Intel@registeredsymbol{}64 and IA-32
+architecture machines. If
+@uref{http://birchwood-abbey.net/~puck/Scheme/} has links to packages
+for your Ubuntu, you can use your Ubuntu package manager to add,
+remove and update Scheme and its plugins. @xref{Ubuntu Installation}.
+
+Scheme is also available as ``binary'' archives that can be unpacked,
+compiled and installed on non-Ubuntu, even non-GNU/Linux operating
+systems, if they are sufficiently Unix-like. Installation requires
+something resembling the customary GNU tool chain. The Scheme
+interpreter will be built and installed much like any other (GNU) C
+program on your system. Detailed instructions for installing Scheme
+this way can be found below. @xref{Unix Installation}.
+
+@menu
+* Ubuntu Installation::
+* Unix Installation::
+@end menu
+
+@node Ubuntu Installation
+@section Ubuntu Installation
+
+Using an Ubuntu package manager, you can add Birchwood Abbey to your
+list of package sources and install or update Scheme and its plugins
+just like other packages.
+
+You should begin by installing the GPG key used to sign the packages.
+It is available from this web page:
+
+@example
+@url{https://savannah.gnu.org/users/mhb}
+@end example
+
+Click the ``Download GPG Key'' link on that page and save the
+@file{mhb-key.gpg} file. You might install it with this command:
+
+@example
+sudo apt-key add ~/Downloads/mhb-key.gpg
+@end example
+
+Next add the repository to your list of package sources.
+On Ubuntu 17.10 (Artful Aardvark) you would use this command:
+
+@example
+sudo add-apt-repository \
+ "deb http://birchwood-abbey.net/~puck/ubuntu/17.10/"
+@end example
+
+or by editing files in @file{/etc/apt/}.
+
+Finally, use your package manager to update its list of available
+packages and choose the Scheme plugins you would like to install.
+Scheme itself will be automatically selected because all of the
+plugins depend on it. You might choose the
+@code{mit-scheme-pucked-x11-screen} plugin because it depends on
+Scheme and Edwin and makes Scheme a graphical X11 application like the
+original MIT/GNU Scheme. You could do this with Apt by entering the
+following commands.
+
+@example
+sudo apt-get update
+sudo apt-get install mit-scheme-pucked-x11-screen
+@end example
+
+Note that the Ubuntu version number is part of the source URL. This
+allows new versions of Scheme and its plugins to be provided for old
+versions of Ubuntu. (Normally you would upgrade to new versions of
+Ubuntu to get new versions of Scheme.) However this means there may
+be @emph{three} packages named @code{mit-scheme-pucked} with the
+@emph{same} version, each compiled for Ubuntu 16.04, 17.10 or 18.04.
+
+When you upgrade to a new version of Ubuntu you should first remove
+the @code{mit-scheme-pucked} package (and all of its plugins), then
+re-install them after changing the source URL (e.g. to
+@url{http://birchwood-abbey.net/~puck/ubuntu/18.04/}).
+
+You can also download the package files and install them by hand.
+Links to the available package files are listed on the project home
+page.
+
+@example
+@uref{http://birchwood-abbey.net/~puck/Scheme/}
+@end example
+
+You will need to know your Ubuntu version (e.g. 16.10) and Debian
+machine architecture (e.g. amd64), then click on the corresponding
+link. You will need to do this for your chosen plugin, all of the
+plugins it requires, and Scheme itself (the @code{mit-scheme-pucked}
+package).
+
+For example if you want Edwin to display in an X11 window you will
+want to install the @code{x11-screen} plugin which requires the
+@code{edwin} plugin which requires several more. Each entry on the
+project home page lists the package files available for a plugin
+@emph{and} all of its required plugins.
+
+If you would like to verify that the downloaded files are authentic
+you will need the corresponding @file{.changes} files. Each contains
+checksums for the package files and is signed. If you saved the GPG
+key in @file{~/Downloads/mhb-key.gpg}, you can add it to your keyring
+like this:
+
+@example
+gpg --import ~/Downloads/mhb-key.gpg
+@end example
+
+Then verify the signature on the @file{.changes} file like this:
+
+@example
+gpg --verify ~/Downloads/mit-scheme-pucked_9.2.7-1_amd64.changes
+@end example
+
+Finally compare the checksum in the @file{.changes} file with one
+computed from your downloaded file.
+
+@example
+grep mit-scheme-pucked_9.2.7-1_amd64.deb \
+ mit-scheme-pucked_9.2.7-1_amd64.changes
+sha256sum mit-scheme-pucked_9.2.7-1_amd64.deb
+@end example
+
+After you have downloaded and verified all of the required files, you
+can install them, required packages first, e.g.@: starting with
+@code{mit-scheme-pucked} and finishing with
+@code{mit-scheme-pucked-x11-screen}.
+@verbatim
+P=~/Downloads/mit-scheme-pucked
+sudo dpkg --install ${P}_9.2.7-1_amd64.deb
- sudo dpkg --install ${P}-md5_0.2.1-1_amd64.deb
+sudo dpkg --install ${P}-gdbm_0.2.1-1_amd64.deb
+sudo dpkg --install ${P}-blowfish_0.2.1-1_amd64.deb
+sudo dpkg --install ${P}-edwin_3.116.1-1_amd64.deb
+sudo dpkg --install ${P}-x11_0.2.1-1_amd64.deb
+sudo dpkg --install ${P}-x11-screen_0.2.1-1_amd64.deb
+@end verbatim
+
+As mentioned above, when you upgrade to a new version of Ubuntu you
+should first remove the @code{mit-scheme-pucked} package (and all of
+its plugins), then re-install them after changing the source URL.
+
+@node Unix Installation
+@section Unix Installation
+
+MIT/GNU Scheme Pucked can be built and installed on a wide variety of
+Unix-like operating systems using a ``binary distribution'' and
+developer tools like those in the GNU tool chain: a bourne-like shell,
+a @code{make} command, a C compiler and linker. The Scheme
+interpreter is built from C code and installed much like any other GNU
+C program.
+
+These are @emph{binary} distributions because they contain pre-compiled
+Scheme code in binary files. This code cannot be compiled during the
+install because there is no Scheme compiler to do the work until
+@emph{after} Scheme is installed.
+
+First download the appropriate binary distribution. To do this you
+will need to know the name of your Scheme architecture. If your
+computer has an older Intel IA-32 (32 bit) CPU, your architecture is
+named @code{i386}. If it has a newer Intel64 CPU (64 bit, e.g. a Core
+or an i3 or i5 or i7), it is named @code{x86-64}. The binary archives
+contain machine instructions for one of these, or for 32 and 64 bit
+virtual machines named @code{svm1-32} and @code{svm1-64}. The virtual
+machines are part of the Scheme interpreter and are about 6 times
+slower than the native machine.
+
+Click on the name of your Scheme machine architecture in the list of
+binaries for the core system. Save the file, which should be named
+something like @file{mit-scheme-pucked-9.2.7-i386.tar.gz}.
+
+Compile the Scheme interpreter using the following steps:
+
+@enumerate
+@item
+Unpack the archive to create your build directory, e.g.@:
+@file{mit-scheme-pucked-9.2.7}. For example,
+
+@example
+tar xzf mit-scheme-pucked-9.2.7-i386.tar.gz
+@end example
+
+will create a new directory @file{mit-scheme-pucked-9.2.7}.
+
+@item
+Move into the @file{src} subdirectory of the new directory:
+
+@example
+cd mit-scheme-pucked-9.2.7/src
+@end example
+
+@item
+@anchor{Build Configuration}
+Configure the software:
+
+@example
+./configure
+@end example
+
+By default, the software will be installed in @file{/usr/local}, in
+the subdirectories @file{bin} and @file{lib}. If you want it
+installed somewhere else, for example @file{/opt}, pass the
+@option{--prefix} option to the configure script, as in the
+command line below.
+
+@example
+./configure --prefix=/opt
+@end example
+
+The configure script accepts all of the normal arguments for such
+scripts, and additionally accepts some that are specific to MIT/GNU
+Scheme. To see the possible arguments and their meanings, run the
+command @code{./configure --help}.
+
+@item
+Build the software:
+
+@example
+make compile-microcode
+@end example
+
+@item
+Install the software:
+
+@example
+make install
+@end example
+
+Depending on configuration options and file-system permissions, you
+may need super-user privileges to do the installation step.
+@end enumerate
+
+@section Plugin Selection and Installation
+
+The project home page lists the available plugins with short
+descriptions to help you choose from among them. Click on the
+source archive link for each plugin you would like to use. Also
+download the source for any plugins your desired plugins require. You
+will need to build and install each required plugin before the plugins
+that require it.
+
+If you are looking for the same functionality you found in MIT/GNU
+Scheme you will want all of the plugins listed in the ``Former
+Microcode Modules'' section of the home page. Your desired plugins
- are: blowfish, edwin, gdbm, imail, mcrypt, md5, mhash, x11, and
- x11-screen.
++are: blowfish, edwin, gdbm, imail, mcrypt, x11, and x11-screen.
+
+The plugins are not distributed in binary form (except as Ubuntu
+packages). With the core Scheme system installed, their Scheme code
+can be compiled along with their C code.
+
+The plugins are all built by scripts and makefiles created by GNU
+automake (and autoconf). Thus make targets like @code{dist} and
+@code{install-html} and @code{uninstall} are defined.
+
+Installation is per the GNU custom, not unlike the core
+installation. For the Gtk+ plugin:
+
+@example
+tar xzf mit-scheme-pucked-gtk-0.5-i386.tar.gz
+cd mit-scheme-pucked-gtk-0.5
+./configure
+make
+make check
+make install
+@end example
+
+The @code{install} target attempts to create a subdirectory in the
+first directory on the host Scheme's library path. If that directory
+is not writable by you, super-user privileges may be required.
+
+You can put a writable directory at the front of your host Scheme's
+library path by setting the @code{MITSCHEME_LIBRARY_PATH} environment
+variable
+
+@example
+export MITSCHEME_LIBRARY_PATH=~/pucked:/opt/lib/mit-scheme-pucked
+@end example
+
+@noindent
+or including the @code{--library} option on the command line.
+
+@example
+mit-scheme-pucked --library ~/pucked:/opt/lib/mit-scheme-pucked
+@end example
-The release notes are online at
-@uref{http://www.gnu.org/software/mit-scheme/release.html}.
+The build will fail if the required plugins (Cairo, Pango and GLib)
+are not installed first (and in the reverse order). It will also fail
+if the plugin is a wrapper for a C library that is not installed. The
+build needs the library header files. Often this means ``developer's
+packages'' must be installed. See the @file{README} file in each
+plugin's source archive for help in finding these files or packages.
-@node GNU Free Documentation License
+@c A full @node spec is needed here to avoid a bogus warning.
+@node GNU Free Documentation License, Environment-variable Index, Installation, Top
@appendix GNU Free Documentation License
@cindex FDL, GNU Free Documentation License
package (runtime blowfish).
* "mcrypt" wraps libmcrypt and provides replacements for the mcrypt-*
-- procedures implemented in (runtime crypto).
-
- * "md5" wraps libssl or libcrypto md5 functions, and provides
- replacements for the md5-* procedures in (runtime crypto).
-
- * "mhash" wraps libmhash and provides replacements for the mhash-*
+ procedures in (runtime crypto).
-* "mhash" wraps libmhash.
+The editor subsystem consists of two directories:
+
+* "edwin" contains our Emacs-like editor written in Scheme and using
- several plugins, e.g. gdbm, md5 and x11.
++ several plugins, e.g. gdbm, blowfish and x11.
+
+* "imail" contains an email-reading program for Edwin.
\f
These are miscellaneous extras:
blowfish \
compiler \
cref \
- edwin \
ffi \
gdbm \
- imail \
mcrypt \
- md5 \
-- mhash \
microcode \
runtime \
sf \
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
02110-1301, USA.
-mit-scheme-blowfish 0.2 - Matt Birkholz, 2017-05-18
-===================================================
+mit-scheme-pucked-blowfish 0.2.2 - Matt Birkholz, 2017-11-06
+============================================================
+
+Upstream now sports a texinfo manual, scraped from the OpenSSL manual
+pages.
+
+mit-scheme-pucked-blowfish 0.2.1 - Matt Birkholz, 2017-05-18
+============================================================
-Use byte vectors for binary data instead of strings. This changes
-every export except blowfish-file? and perhaps compute-blowfish-init-
-vector IF you don't care whether the init vector is a string. Every
-procedure that previously accepted/returned strings now
-requires/produces byte vectors. If it accepted/returned generic ports
-it now requires/produces binary ports. If you are using the md5
-plugin to produce a digest for blowfish-set-key, you're winning, with
-blowfish-set-key at least; md5 digests are now byte vectors too.
+Upstream now uses byte vectors for binary data instead of strings.
+This changes every global binding except blowfish-file? and perhaps
+compute-blowfish-init-vector IF you don't care whether the init vector
+is a string or something else. Every procedure that previously
+accepted/returned strings now requires/produces bytevectors. If it
+accepted/returned generic ports it now requires/ produces binary
- ports. If you are using the md5 plugin to produce a digest for
++ports. If you are using the md5 procedures to produce a digest for
+blowfish-set-key, you're winning, with blowfish-set-key at least; md5
+digests are now bytevectors too.
-mit-scheme-blowfish 0.1 - Matt Birkholz, 2016-02-19
-===================================================
+mit-scheme-pucked-blowfish 0.1.1 - Matt Birkholz, 2017-03-01
+============================================================
-Use libtool and automake.
+Stole v0.1 from MIT/GNU Scheme.
(define-package (blowfish)
(files "blowfish")
(parent ())
-- (export ()
- import-blowfish)
+ (export (blowfish global)
blowfish-cbc
blowfish-cfb64
blowfish-ecb
blowfish-set-key
compute-blowfish-init-vector
read-blowfish-file-header
- write-blowfish-file-header))
+ write-blowfish-file-header))
+
+ (define-package (blowfish global)
- ;; Just to get cref to analyze whether all exports are defined.
++ ;; Just to get cref to analyze whether all "exports" are defined.
+ )
@deffn Procedure blowfish-set-key bytes
Generate a Blowfish key from @var{bytes}, which must be 72 bytes or
--less in length. For text keys (strings), apply @code{md5} to the
--string, and use the digest for @var{bytes}.
++less in length. For text keys (strings), apply @code{md5-string}
++and use the digest for @var{bytes}.
@end deffn
@deffn Procedure blowfish-ecb input output key encyrpt?
--- /dev/null
- MIT/GNU Scheme Pucked version 9.2.7 are detailed in @ref{Release
+@node Changes
+@chapter How so ``pucked?''
+
+The user visible differences between MIT/GNU Scheme version 9.2.2 and
- including files @file{prbfish.c}, @file{prgdbm.c}, @file{prmcrypt.c},
- @file{prmd5.c}, @file{prmhash.c} and @file{prpgsql.c}, as well as
++MIT/GNU Scheme Pucked version 9.2.11 are detailed in @ref{Release
+Notes, , , user, MIT/GNU Scheme Pucked User Manual}. This chapter is
+a review of @emph{all} source code changes, with reference to the
+output of specific @code{git diff} commands.
+
+The commands in this chapter assume you have cloned the project git
+repository, fetched the experimental branch, and checked it out,
+as described in @ref{Project Repository}.
+
+The following commands can be (have been!)@: used in a clone like the
+one described above. They show all differences between the master
+branch on Savannah (@code{origin/master}) and the experimental branch
+in the repository at Birchwood Abbey, @code{puck/pucked}. The
+discussion following each command is a quick summary of the diffs.
+
+@table @code
+@item cmd="git diff origin/master puck/pucked --"
+The command lines in this table assume you have defined @code{cmd} as
+above.
+
+@item $cmd dist/
+@code{PROJECT_NAME} was changed. @file{debian/} was added. All
+plugin code was removed from the core source distribution.
+
+@item $cmd doc/
+The project name, email and version were changed. The manpage and
+user's manual were renamed and updated. The Imail manual was moved to
+the Imail plugin's source directory. All manuals were changed to fit
+inside a new, top-level @file{mit-scheme-pucked.info} file, the only
+Info file installed in the system Directory node. Plugin selection
+and installation instructions were added, and a @file{style.css} for
+@file{htmldir}, a copy of the style sheets used with online manuals at
+@indicateurl{gnu.org}. Installation of HTML was made the default.
+
+@item $cmd etc/
+No changes were made.
+
+@item $cmd src/microcode/
+Project and executable names, the microcode version and copyright
+notice were change. The C code for the microcode modules was removed,
- @file{x11term}. Modified versions of these can be found in the plugin
++including files @file{prbfish.c}, @file{prgdbm.c}, @file{prmcrypt.c}
++and @file{prpgsql.c}, as well as @file{x11.h},
+@file{x11base.c}, @file{x11color.c}, @file{x11graph.c} and
- was moved here from the @file{doc/} directory. The only change to the
- Scheme code was the addition of @code{(load-option 'md5)} where the
- @code{md5-substring} procedure was used.
++@file{x11term.c}. Modified versions of these can be found in the plugin
+directories, e.g.@: @file{src/blowfish/}. All mention of the modules
+was removed from the makefiles and configure scripts.
+
+@item $cmd src/runtime/
+The Scheme code that wrapped the microcode modules was removed,
+including files @file{berkeley-db.scm}, @file{gdbm.scm},
+@file{pgsql.scm} and @file{x11graph.scm}. The packages @code{(runtime
+x-graphics)}, @code{(runtime gdbm)} and @code{(runtime postgresql)}
+were removed. The @code{--edit} command line argument handler was
+stolen from Edwin as well as the @code{edit}, @code{edwin} and
+@code{spawn-edwin} procedures, which now autoload Edwin. Pucked
+source is included (installed) so runtime options need not be
+installed specially.
+
+@item $cmd src/edwin/
+A number of Debian/GNU standard files were added to make this a
+standalone plugin ready for @code{dpkg-buildpackage}. These include a
+@file{Makefile.am} and a @file{configure.ac} as well as @file{NEWS},
+@file{AUTHORS}, @file{COPYING}, etc. Files specific to X11
+(@file{key-x11.scm}, @file{xcom.scm}, @file{xmodef.scm} and
+@file{xterm.scm}) were moved into the X11 Screen plugin. The
+@code{edit}, @code{edwin} and @code{spawn-edwin} procedures were
+stolen by the runtime system.
+
+Edwin also changed to accommodate a new Gtk Screen plugin. The old
+@code{screen} structure type became the abstract SOS class
+@code{<screen>} and the concrete class @code{<tty-screen>}. Most of
+the existing, tty-specific screen procedures were renamed with a
+@code{tty-} prefix. Many are called only by other tty procedures.
+The few (20) that handle @emph{any} type of screen became SOS generic
+procedures.
+
+@item $cmd src/imail/
+A number of Debian/GNU standard files were added and the manual
++was moved here from the @file{doc/} directory.
+
+@item $cmd src/etc/
+The Emacs tutorial was moved to the Edwin plugin's source directory.
+Both Edwin and Imail were removed from @file{optiondb.scm} and scripts
+like @file{build-bands.sh}.
+
+@item $cmd src/compiler/ src/cref/ src/ffi/ src/sf/ src/star-parser/
+No changes were made to the rest of the core subsystems except their
+@file{Makefile-fragment}s. These now install all source files.
+
+@item $cmd src/6001/ src/sos/ src/ssp/ src/win32/ src/xdoc/ src/xml/
+No changes were made to the rest of the standard subsystems except
+their @file{Makefile-fragment}s.
+
+@item $cmd tests
+No changes were made to the test suite except to enable the FFI test.
+
+@end table
--- /dev/null
- mit-scheme-pucked-md5 (>= 0.1),
+Source: mit-scheme-pucked-edwin
+Section: lisp
+Priority: optional
+Maintainer: Matt Birkholz <matt@birchwood-abbey.net>
+Build-Depends: debhelper (>= 9),
+ mit-scheme-pucked-blowfish (>= 0.1),
- mit-scheme-pucked-md5 (>= 0.1),
+ mit-scheme-pucked-gdbm (>= 0.1)
+Standards-Version: 3.9.4
+Homepage: http://birchwood-abbey.net/~matt/Scheme/
+Vcs-Git: git://birchwood-abbey.net/~matt/mit-scheme.git
+Vcs-Browser: http://birchwood-abbey.net/gitweb/?p=mit-scheme.git;a=summary
+
+Package: mit-scheme-pucked-edwin
+Architecture: any
+Depends: mit-scheme-pucked-blowfish (>= 0.1),
+ mit-scheme-pucked-gdbm (>= 0.1)
+Description: Edwin plugin for MIT/GNU Scheme Pucked
+ This package provides an Edwin plugin for MIT/GNU Scheme Pucked. It
+ includes ONLY the console terminal screen type. The ancient X11
+ screen type is provided by the x11-screen plugin. To get all of the
+ functions of the original MIT/GNU Scheme, install the
+ mit-scheme-pucked-x11-screen package.
;;;; Edwin Packaging
\f
-(global-definitions "../runtime/runtime")
-(global-definitions "../xml/xml")
+(global-definitions runtime/)
+(global-definitions xml/)
+(global-definitions sos/)
- (global-definitions md5/)
+(global-definitions blowfish/)
+(global-definitions gdbm/)
(define-package (edwin)
(files "utils"
|#
(load-option 'CREF)
- (load-option 'MD5)
+(load-option 'SOS)
+(load-option 'XML)
+(load-option 'BLOWFISH)
+(load-option 'GDBM)
(if (not (name->package '(EDWIN)))
(let ((package-set (package-set-pathname "edwin")))
(define ((read/write-encrypted-file? write?) group pathname)
(and (ref-variable enable-encrypted-files group)
(equal? "bf" (pathname-type pathname))
- (ignore-errors (lambda () (load-option 'md5))
- (lambda (condition) condition #f))
- (md5-available?)
- (blowfish-available?)
+ (ignore-errors (lambda () (load-option 'blowfish))
+ (lambda (condition) condition #f))
(or write? (blowfish-file? pathname))
#t))
scmlibdir = @MIT_SCHEME_LIBDIR@
scmlib_subdir = $(scmlibdir)gdbm
scmdocdir = $(datarootdir)/doc/@MIT_SCHEME_PROJECT@
- #scminfodir = $(scmdocdir)/info
++scminfodir = $(scmdocdir)/info
scmlib_LTLIBRARIES = gdbm-shim.la
scmlib_DATA = gdbm-types.bin gdbm-const.bin
scmlib_sub_DATA = $(sources) $(binaries)
scmlib_sub_DATA += make.scm @MIT_SCHEME_PKD@
- #scminfo_DATA = gdbm.info
- #AM_MAKEINFOHTMLFLAGS = --no-split
-info_TEXINFOS = mit-scheme-gdbm.texi
-AM_MAKEINFOHTMLFLAGS = --no-split
++scminfo_DATA = gdbm.info
++info_TEXINFOS = gdbm.texi
++AM_MAKEINFOHTMLFLAGS = --no-split --css-ref=style.css
++AM_UPDATE_INFO_DIR = no
AM_CPPFLAGS = -I@MIT_SCHEME_INCLUDEDIR@
AM_CFLAGS = @MIT_CFLAGS@
TESTS = gdbm-check.sh
CLEANFILES += gdbm-check.db
++check-local:
++ ./check-doc.sh
++
tags: tags-am
./tags-fix.sh gdbm
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
02110-1301, USA.
-mit-scheme-gdbm 0.3 - Matt Birkholz, 2017-12-23
-===============================================
++mit-scheme-pucked-gdbm 0.3.1 - Matt Birkholz, 2017-12-23
++========================================================
+
-Use new FFI Unicode support. Include the gdbm manual, translated into
-Scheme.
++New upstream includes a manual and uses new Unicode support in the
++FFI.
+
-mit-scheme-gdbm 0.2 - Matt Birkholz, 2017-05-18
-===============================================
+mit-scheme-pucked-gdbm 0.2.1 - Matt Birkholz, 2017-05-18
+========================================================
-Use new Unicode support. Convert non-ASCII strings (keys and data) to
-UTF8. This assumes any other program adding non-ASCII keys or data is
-using the same encoding.
+New upstream converts non-ASCII strings (keys and data) to UTF8. This
+assumes any other program adding non-ASCII keys or data is using the
+same encoding.
-mit-scheme-gdbm 0.1 - Matt Birkholz, 2016-02-19
-===============================================
+mit-scheme-pucked-gdbm 0.1.1 - Matt Birkholz, 2017-03-01
+========================================================
-Use libtool and automake.
+Stole v0.1 from MIT/GNU Scheme.
--- /dev/null
--- /dev/null
++#!/bin/bash
++# -*-Scheme-*-
++#
++# Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015,
++# 2016, 2017 Matthew Birkholz
++#
++# This file is part of a Gdbm plugin for MIT/GNU Scheme Pucked.
++#
++# This plugin is free software; you can redistribute it and/or modify
++# it under the terms of the GNU General Public License as published by
++# the Free Software Foundation; either version 2 of the License, or
++# (at your option) any later version.
++#
++# This plugin is distributed in the hope that it will be useful, but
++# WITHOUT ANY WARRANTY; without even the implied warranty of
++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
++# General Public License for more details.
++#
++# You should have received a copy of the GNU General Public License
++# along with this plugin; if not, write to the Free Software
++# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
++# 02110-1301, USA.
++
++# Check the documentation.
++
++set -e
++: ${MIT_SCHEME_EXE=mit-scheme}
++${MIT_SCHEME_EXE} --batch-mode <<\EOF
++
++(let ((pkgset "gdbm")
++ (texi "gdbm.texi")
++ (pkg '(gdbm)))
++ ;; Check that every binding exported to () or PKG has a
++ ;; corresponding @deffn in TEXI.
++
++ (parameterize ((param:suppress-loading-message? #t))
++ (load-option 'cref)
++ (load-option 'regular-expression))
++ (define read-package-model)
++ (define pmodel/packages)
++ (define package/name)
++ (define package/bindings)
++ (define package/links)
++ (define link/source)
++ (define link/destination)
++ (define binding/package)
++ (define binding/name)
++ (let ((cref (->environment '(cross-reference))))
++ (set! read-package-model (access read-package-model cref))
++ (set! pmodel/packages (access pmodel/packages cref))
++ (set! package/name (access package/name cref))
++ (set! package/bindings (access package/bindings cref))
++ (set! package/links (access package/links cref))
++ (set! link/source (access link/source cref))
++ (set! link/destination (access link/destination cref))
++ (set! binding/package (access binding/package cref))
++ (set! binding/name (access binding/name cref)))
++
++ (define (deffn-name line)
++ (let ((regs (re-string-match
++ (string-append "@deffnx?"
++ " \\(Class\\|Procedure\\|{Generic Procedure}\\)"
++ " \\([-A-Za-z0-9<>?!+./:]+\\)")
++ line)))
++ (if regs
++ (intern (re-match-extract line regs 2))
++ (error "Could not find binding name:" line))))
++
++ (define (texinfo-deffns lines)
++ (let ((len (vector-length lines)))
++ (let loop ((i 0) (deffns '()))
++ (if (fix:< i len)
++ (let ((line (vector-ref lines i)))
++ (loop (fix:1+ i)
++ (if (string-prefix? "@deffn" line)
++ (cons (deffn-name line) deffns)
++ deffns)))
++ deffns))))
++
++ (define (read-lines port)
++ (let loop ()
++ (let ((line (read-line port)))
++ (if (eof-object? line)
++ '()
++ (cons line (loop))))))
++
++ (define (pmodel/find-package pmodel package-name)
++ (find-matching-item (pmodel/packages pmodel)
++ (lambda (p) (equal? package-name (package/name p)))))
++
++ (define (pmodel/global-exports pmodel)
++ (define (global-exports package)
++ (append-map! (lambda (link)
++ (if (eq? '() (package/name
++ (binding/package
++ (link/destination link))))
++ (list (binding/name (link/destination link)))
++ '()))
++ (package/links package)))
++ (append-map! global-exports (pmodel/packages pmodel)))
++
++ (define (pmodel/package-bindings pmodel package-name)
++ (let ((package (pmodel/find-package pmodel package-name)))
++ (if package
++ (map binding/name (package/bindings package))
++ (error "No such package:" package-name))))
++
++ (define (duplicates listset)
++ (let loop ((items listset) (duplicates '()))
++ (cond ((null? items)
++ (reverse! duplicates))
++ ((memq (car items) (cdr items))
++ (if (memq (car items) duplicates)
++ (loop (cdr items) duplicates)
++ (loop (cdr items) (cons (car items) duplicates))))
++ (else
++ (loop (cdr items) duplicates)))))
++
++ (define (minus set1 set2)
++ (let loop ((items set1) (difference '()))
++ (cond ((null? items)
++ difference)
++ ((memq (car items) set2)
++ (loop (cdr items) difference))
++ (else
++ (loop (cdr items) (cons (car items) difference))))))
++
++ (define (check)
++ (let* ((texinfo (list->vector (call-with-input-file texi read-lines)))
++ (deffns (texinfo-deffns texinfo))
++ (dups (duplicates deffns))
++ (pmodel (read-package-model pkgset microcode-id/operating-system))
++ (bindings (append (pmodel/global-exports pmodel)
++ (if (null? pkg)
++ '()
++ (pmodel/package-bindings pmodel pkg))))
++ (missing (minus bindings deffns))
++ (extras (minus deffns bindings)))
++ (if (not (null? dups))
++ (for-each (lambda (name) (warn "multiple-descriptions:" name)) dups))
++ (if (not (null? extras))
++ (for-each (lambda (name) (warn "not bound:" name)) extras))
++ (if (not (null? missing))
++ (for-each (lambda (name) (warn "not documented:" name)) missing))))
++
++ (check)
++ )
++EOF
--- /dev/null
- mit-scheme-pucked (>= 9.2.7),
+Source: mit-scheme-pucked-gdbm
+Section: lisp
+Priority: optional
+Maintainer: Matt Birkholz <matt@birchwood-abbey.net>
+Build-Depends: debhelper (>= 9), autotools-dev, libltdl-dev,
- Depends: mit-scheme-pucked (>= 9.2.7), ${shlibs:Depends}, ${misc:Depends}
++ mit-scheme-pucked (>= 9.2.11),
+ libgdbm-dev
+Standards-Version: 3.9.4
+Homepage: http://birchwood-abbey.net/~matt/Scheme/
+Vcs-Git: git://birchwood-abbey.net/~matt/mit-scheme.git
+Vcs-Browser: http://birchwood-abbey.net/gitweb/?p=mit-scheme.git;a=summary
+
+Package: mit-scheme-pucked-gdbm
+Architecture: any
++Depends: mit-scheme-pucked (>= 9.2.11), ${shlibs:Depends}, ${misc:Depends}
+Description: GDBM plugin for MIT/GNU Scheme Pucked
+ This package provides mit-scheme-pucked with a dynamically loadable
+ wrapper of the GDBM (GNU Data Base Management) C API as implemented
+ by libgdbm.
--- /dev/null
-@setfilename mit-scheme-gdbm.info
+ \input texinfo @c -*-texinfo-*-
+ @comment %**start of header
-@set SCMVERS 9.2.1
-@settitle MIT/GNU Scheme GDBM Plugin Manual
++@setfilename gdbm.info
+ @include version.texi
-This manual documents MIT/GNU Scheme GDBM @value{VERSION}.
++@set SCMVERS 9.2.11
++@settitle GDBM Plugin Manual
+ @comment %**end of header
+
+ @copying
-* MIT/GNU Scheme GDBM: (mit-scheme-gdbm).
++This manual documents MIT/GNU Scheme Pucked GDBM @value{VERSION}.
+
+ Copyright @copyright{} 2017 Matthew Birkholz
+ Copyright @copyright{} 1993-99 Free Software Foundation, Inc.
+
+ @quotation
+ Permission is granted to make and distribute verbatim copies of
+ this manual provided the copyright notice and this permission notice
+ are preserved on all copies.
+
+ @ignore
+ Permission is granted to process this file through Tex and print the
+ results, provided the printed document carries copying permission
+ notice identical to this one except for the removal of this paragraph
+ (this paragraph not being relevant to the printed manual).
+
+ @end ignore
+ Permission is granted to copy and distribute modified versions of this
+ manual under the conditions for verbatim copying, provided also that
+ the entire resulting derived work is distributed under the terms of a
+ permission notice identical to this one.
+
+ Permission is granted to copy and distribute translations of this manual
+ into another language, under the above conditions for modified versions,
+ except that this permission notice may be stated in a translation approved
+ by the Free Software Foundation.
+ @end quotation
+ @end copying
+
+ @dircategory Programming Languages
+ @direntry
-@title MIT/GNU Scheme GDBM Plugin Manual
++* GDBM: (mit-scheme-pucked/gdbm).
+ GNU database manager plugin
+ @end direntry
+
+ @titlepage
-@subtitle for MIT/GNU Scheme version @value{SCMVERS}
++@title GDBM Plugin Manual
+ @subtitle a GNU database manager plugin (version @value{VERSION})
++@subtitle for MIT/GNU Scheme Pucked version @value{SCMVERS}
+ @subtitle @value{UPDATED}
+ @author by Matt Birkholz
+ @page
+ @vskip 0pt plus 1filll
+ @insertcopying
+ @end titlepage
+
+ @ifnottex
+ @node Top
+ @top GDBM Plugin Manual
+
+ @insertcopying
+ @end ifnottex
+
+ @menu
+ * Introduction::
+
+ Functions:
+
+ * List:: The exported bindings.
+ * Open:: Opening the database.
+ * Close:: Closing the database.
+ * Store:: Inserting and replacing records in the database.
+ * Fetch:: Searching records in the database.
+ * Delete:: Removing records from the database.
+ * Sequential:: Sequential access to records.
+ * Reorganization:: Database reorganization.
+ * Sync:: Insure all writes to disk have competed.
+ * Options:: Setting internal options.
+ @end menu
+
+
+ @node Introduction
+ @chapter Introduction to GNU dbm.
+
+ This plugin is a dynamically loadable wrapper for the GNU dbm
+ (DataBase Management) C library. This manual is a derivative of
+ Edition 1.5 of the @cite{GNU dbm Manual}, for library version
+ 1.8.3, last updated October 15, 2002.
+
+ GNU dbm (gdbm) is a library of database functions that
+ use extendible hashing; it works similarly to the standard UNIX dbm
+ functions.
+ The basic use of gdbm is to store key/data pairs in a data file.
+ Each key must be unique and each key is paired with only one data item.
+ The keys can not be directly accessed in sorted order.
+
+ The key/data pairs are stored in a gdbm disk file, called a gdbm
+ database. A program must connect to a gdbm database to be able
+ manipulate the keys and data contained in it. Gdbm allows Scheme to
+ connect to multiple databases at the same time. When Scheme connects
+ to a gdbm database, the connection is designated as a @dfn{reader} or
+ a @dfn{writer}. A gdbm database may be connected to at most one
+ writer at a time. However, many readers may connect to the database
+ simultaneously. Readers and writers may not connect to the database
+ at the same time.
+
+ Each connection is encapsulated in a Scheme @code{gdbf} structure
+ which should be used by one Scheme thread at a time. A mutex is used
+ to block any thread attempting to access the database while an
+ operation is in progress.
+
+
+ @node List
+ @chapter The exported bindings.
+
+ The following is a quick list of the procedures provided by the plugin.
+
+ @example
+ gdbm-open
+ gdbm-close
+ gdbm-store
+ gdbm-fetch
+ gdbm-delete
+ gdbm-firstkey
+ gdbm-nextkey
+ gdbm-reorganize
+ gdbm-sync
+ gdbm-exists?
+ gdbm-setopt
+ @end example
+
+ Neither @code{gdbm_errno} nor @code{gdbm_strerror} are exposed because
+ the plugin automatically tests and calls them to detect errors and
+ convert codes into strings. @code{gdbm_fdesc} is also not exposed,
+ treated as an implementation detail the plugin should probably hide,
+ used by tricky code that cooperates with multiple file locking
+ libraries.
+
+ There is one global variable, @code{gdbm-version}, which is
+ initialized from the library's @code{gdbm_version} string.
+
+ And several constants:
+ @example
+ gdbm_cachesize
+ gdbm_fast
+ gdbm_insert
+ gdbm_newdb
+ gdbm_reader
+ gdbm_replace
+ gdbm_wrcreat
+ gdbm_writer
+ @end example
+
+ You can load these bindings into your global environment with the
+ following expresson.
+ @smallexample
+ (load-option 'gdbm)
+ @end smallexample
+
+ And you can include these bindings in your package description
+ (@file{.pkg}) file with the following expression.
+ @smallexample
+ (global-definitions gdbm/)
+ @end smallexample
+
+
+ @node Open
+ @chapter Opening the database.
+
+ Connect to the file. If the file has a size of zero bytes, a file
+ initialization procedure is performed, setting up the initial structure in the
+ file.
+
+ The procedure for opening a gdbm file is:
+
+ @deffn Procedure gdbm-open name block-size flags mode
+ The parameters are:
+
+ @table @var
+ @item name
+ The name of the file (the complete name, gdbm does not append any
+ characters to this name).
+ @item block-size
+ It is used during initialization to determine the size of various constructs. It
+ is the size of a single transfer from disk to memory. This parameter is ignored
+ if the file has been previously initialized. The minimum size is 512.
+ If the value is less than 512, the file system blocksize is used, otherwise the
+ value of @var{block-size} is used.
+ @item flags
+ If @var{flags} is @code{gdbm_reader}, the user wants to just read the
+ database and any call to @code{gdbm-store} or @code{gdbm-delete} will fail.
+ Many readers can access the database at the same time. If @var{flags} is
+ @code{gdbm_writer}, the user wants both read and write access to the database
+ and requires exclusive access. If @var{flags} is @code{gdbm_wrcreat}, the
+ user wants both read and write access to the database and if the database does
+ not exist, create a new one. If @var{flags} is @code{gdbm_newdb}, the
+ user want a new database created, regardless of whether one existed, and wants
+ read and write access to the new database. The following may also be logically
+ or'd into the database flags: @code{gdbm_sync}, which causes all database operations
+ to be synchronized to the disk, and @code{gdbm_nolock}, which prevents the library
+ from performing any locking on the database file. @code{gdbm_fast} is
+ now obsolete, since gdbm defaults to no-sync mode.
+ @item mode
+ File mode (see chmod(2) and open(2) if the file is created).
+ @end table
+
+ The return value is the object needed by all other procedures to
+ access that gdbm file.
+ @end deffn
+
+
+ @node Close
+ @chapter Closing the database.
+
+ It is important that every file opened is also closed. This is needed to
+ update the reader/writer count on the file. Scheme will do this
+ automatically if an open gdbm object is garbage collected, but you can
+ close the file immediately with the @code{gdbm-close} procedure.
+
+ @deffn Procedure gdbm-close dbf
+ The parameter is:
+
+ @table @var
+ @item dbf
+ The object returned by @code{gdbm-open}.
+ @end table
+
+ Closes the gdbm file and frees all memory associated with @var{dbf}.
+ @end deffn
+
+
+ @node Store
+ @chapter Inserting and replacing records in the database.
+
+ The procedure @code{gdbm-store} inserts or replaces records in the database.
+
+ @deffn Procedure gdbm-store dbf key content flag
+ The parameters are:
+
+ @table @var
+ @item dbf
+ The object returned by @code{gdbm-open}.
+ @item key
+ A non-empty string, converted to utf-8 bytes for lookup in the database.
+ @item content
+ Another non-empty string, the content to be stored in the database file, also
+ converted to utf-8.
+ @item flag
+ The action to take when @var{key} is already in the database. The value
+ of @code{gdbm_replace} indicates that the old content should be replaced
+ by @var{content}. The value of @code{gdbm_insert} indicates that
+ @code{#f} should be returned and no action taken if @var{key} already
+ exists.
+ @end table
+
+ The values returned are:
+
+ @table @code
+ @item #t
+ Success. @var{content} is keyed by @var{key}. The file on disk is updated
+ to reflect the structure of the new database before returning from this
+ procedure.
+ @item #f
+ The item was not stored because @var{flag} was @code{gdbm_insert} and
+ @var{key} was already in the database.
+ @end table
+
+ An error is signaled if the caller is not a writer.
+
+ If you store content for a key that is already in the database,
+ gdbm replaces the old content with the new content if called with
+ @code{gdbm_replace}. You do not get two content items for the same key and you do
+ not get an error from @code{gdbm-store}.
+
+ The size in gdbm is not restricted like dbm or ndbm. Your
+ content can be as large as you want.
+ @end deffn
+
+
+ @node Fetch
+ @chapter Searching for records in the database.
+
+ Read content associated with a key.
+
+ @deffn Procedure gdbm-fetch dbf key
+ The parameters are:
+
+ @table @var
+ @item dbf
+ The object returned by @code{gdbm-open}.
+ @item key
+ A non-empty string, converted to utf-8 bytes for lookup in the database.
+ @end table
+
+ The return value is a string created from the utf-8 bytes found in the
+ database, or @code{#f} if no content was found.
+ @end deffn
+
+ You may also search for a particular key without retrieving it, using:
+
+ @deffn Procedure gdbm-exists? dbf key
+ The parameters are:
+
+ @table @var
+ @item dbf
+ The pointer returned by @code{gdbm-open}.
+ @item key
+ A non-empty string, converted to utf-8 bytes for lookup in the database.
+ @end table
+
+ Unlike @code{gdbm-fetch} this procedure does not read any content and
+ simply returns true or false depending on whether @var{key} exists.
+ @end deffn
+
+
+ @node Delete
+ @chapter Removing records from the database.
+
+ To remove some content from the database:
+
+ @deffn Procedure gdbm-delete dbg key
+ The parameters are:
+
+ @table @var
+ @item dbf
+ The object returned by @code{gdbm-open}.
+ @item key
+ A non-empty string, converted to utf-8 bytes for lookup in the database.
+ @end table
+
+ The return value is @code{#f} if the item is not present or the requester is a reader.
+ The return value is @code{#t} if there was a successful delete.
+
+ The keyed content and the key are removed from the database. The file
+ on disk is updated to reflect the structure of the new database before
+ returning from this procedure.
+ @end deffn
+
+
+ @node Sequential
+ @chapter Sequential access to records.
+
+ The next two functions allow for accessing all content in a database
+ @var{dbf}. This access is not key sequential, but it is guaranteed to
+ visit every key in the database once. (The order has to do with the
+ hash values.)
+
+ @deffn Procedure gdbm-firstkey dbf
+ Starts the visit of all keys in the database @var{dbf}.
+ Returns the first key to visit, converting its utf-8 bytes to a string.
+ If there are no keys, returns @code{#f}.
+ @end deffn
+
+ @deffn Procedure gdbm-nextkey dbf key
+ Returns the key to visit after @var{key}, converting its utf-8 bytes
+ to a string.
+ If there are no more keys, returns @code{#f}.
+ @end deffn
+
+ These functions were intended to visit the database in read-only algorithms,
+ for instance, to validate the database or similar operations.
+
+ Visiting keys traverses a hash table which writers may re-arrange.
+ The original key order is @emph{not} guaranteed to
+ remain unchanged in all instances. It is possible that some key will not be
+ visited if the database is changed while traversing the table.
+
+
+ @node Reorganization
+ @chapter Database reorganization.
+
+ The following procedure should be used very seldom.
+
+ @deffn Procedure gdbm-reorganize dbf
+ If you have made a lot of deletions and would like to shrink the space
+ used by the gdbm file, this function will reorganize the database.
+ Gdbm will not shorten a gdbm file (will not reuse deleted space)
+ until this procedure is called.
+
+ The reorganization requires creating a new file and inserting all the elements
+ in the old file @code{dbf} into the new file. The new file is then renamed to
+ the same name as the old file and @code{dbf} is updated to contain all the
+ correct information about the new file.
+ @end deffn
+
++
+ @node Sync
+ @chapter Database Synchronization
+
+ Unless you opened your database with the @code{gdbm_sync} flag, gdbm does not
+ wait for writes to be flushed to the disk. This allows
+ faster writing of databases at the risk of having a corrupted database if
+ Scheme terminates in an abnormal fashion. The following function
+ allows the programmer to flush all changes to disk.
+
+ @deffn Procedure gdbm-sync dbf
+ This would usually be called after a complete set of changes have been
+ made to the database and before some long waiting time.
+ @code{Gdbm-close} always flushes any changes to disk.
+ @end deffn
+
+
+ @node Options
+ @chapter Seting options.
+
+ Gdbm supports the ability to set certain options on an already
+ open database.
+
+ @deffn Procedure gdbm-setopt dbf option value
+ The parameters are:
+
+ @table @var
+ @item dbf
+ The pointer returned by @code{gdbm-open}.
+ @item option
+ The option to be set, the value of @code{gdbm_cachesize} or
+ @code{gdbm_syncmode}.
+ @item value
+ The value to be set, an integer.
+ @end table
+
+ If @var{option} is @code{gdbm_cachesize} the size of the internal
+ bucket cache is set to the given integer. This option may only be set
+ once on a database, and is set to 100 by default when the database is
+ first accessed.
+
+ If @var{option} is @code{gdbm_syncmode} file system synchronization is
+ turned on or off. By default it is off. @var{Value} should @code{1}
+ to turn it on, or @code{0} to turn it off.
+ @end deffn
+
+ The obsolete and experimental options @code{GDBM_FASTMODE},
+ @code{GDBM_CENTFREE} and @code{GDBM_COALESCEBLKS} are not supported by
+ this plugin.
+
+ @bye
(lambda ()
(load-package-set "gdbm")))
- (add-subsystem-identification! "GDBM" '(0 2 1))
-(add-subsystem-identification! "GDBM2" '(0 3))
++(add-subsystem-identification! "GDBM" '(0 3 1))
--- /dev/null
- (load-option 'MD5)
+#!/bin/sh
+# -*-Scheme-*-
+#
+# Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015,
+# 2016, 2017 Matthew Birkholz
+#
+# This file is part of a GLib plugin for MIT/GNU Scheme Pucked.
+#
+# This plugin is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This plugin is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this plugin; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+# 02110-1301, USA.
+
+# Test the GLIB option: copy text file.
+#
+# Copy lines from a text file to a new file and compare the two.
+
+set -e
+: ${MIT_SCHEME_EXE=mit-scheme}
+${MIT_SCHEME_EXE} --prepend-library . <<\EOF
+(begin
+ (load-option 'GLIB)
+ (load "glib-tests")
+ (let ((file1 "glib.texi")
+ (file2 "test-copy-1.txt"))
+ (gcp file1 file2)
+ (if (not (equal? (md5-file file1) (md5-file file2)))
+ (error "gio copy failed")))
+ (assert-clean-ffi "gio copy")
+ )
+EOF
;;;; IMAIL mail reader: packaging
-(global-definitions "../runtime/runtime")
-(global-definitions "../sos/sos")
-(global-definitions "../edwin/edwin")
-(global-definitions "../star-parser/parser")
+(global-definitions runtime/)
+(global-definitions sos/)
+(global-definitions edwin/)
+(global-definitions star-parser/parser)
- (global-definitions md5/)
(define-package (edwin imail)
(files "imail-util"
+++ /dev/null
---*-Text-*-
--
--Please see the git commit log:
--
--$ git clone git://git.savannah.gnu.org/mit-scheme.git whatever
--$ cd whatever/
- $ git remote add puck git://birchwood-abbey.net/~matt/mit-scheme.git
- $ git fetch puck pucked
- $ git log puck/pucked -- src/mhash/ | more
-$ git log origin/master -- src/mhash/ | more
+++ /dev/null
--## Process this file with automake to produce Makefile.in
--##
--## Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
--## 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
--## 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014,
--## 2015, 2016, 2017 Massachusetts Institute of Technology
--##
--## This file is part of MIT/GNU Scheme.
--##
--## MIT/GNU Scheme is free software; you can redistribute it and/or modify
--## it under the terms of the GNU General Public License as published by
--## the Free Software Foundation; either version 2 of the License, or (at
--## your option) any later version.
--##
--## MIT/GNU Scheme is distributed in the hope that it will be useful, but
--## WITHOUT ANY WARRANTY; without even the implied warranty of
--## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
--## General Public License for more details.
--##
--## You should have received a copy of the GNU General Public License
--## along with MIT/GNU Scheme; if not, write to the Free Software
--## Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
--## USA.
--
--ACLOCAL_AMFLAGS = -I m4
--EXTRA_DIST = autogen.sh
--
--MIT_SCHEME_EXE = @MIT_SCHEME_EXE@
--scmlibdir = @MIT_SCHEME_LIBDIR@
--scmlib_subdir = $(scmlibdir)mhash
--scmdocdir = $(datarootdir)/doc/@MIT_SCHEME_PROJECT@
- #scminfodir = $(scmdocdir)/info
--
--scmlib_LTLIBRARIES = mhash-shim.la
--scmlib_DATA = mhash-types.bin mhash-const.bin
--
--sources = @MIT_SCHEME_SCMs@
--cdecls = mhash.cdecl
--
--binaries = @MIT_SCHEME_BCIs@ @MIT_SCHEME_COMs@
--
--scmlib_sub_DATA = $(sources) $(binaries)
--scmlib_sub_DATA += make.scm @MIT_SCHEME_PKD@
--
- #scminfo_DATA = mhash.info
-#info_TEXINFOS = mit-scheme-mhash.texi
--#AM_MAKEINFOHTMLFLAGS = --no-split
--
--AM_CPPFLAGS = -I@MIT_SCHEME_INCLUDEDIR@
--AM_CFLAGS = @MIT_CFLAGS@
--
--mhash_shim_la_LIBADD = mhash-adapter.lo
--mhash_shim_la_LDFLAGS = -module -avoid-version -shared
--
--noinst_PROGRAMS = mhash-const
--mhash_const_SOURCES = mhash-const.c mhash-shim.h
--
--mhash-shim.c: stamp-shim
--mhash-const.c: stamp-shim
--mhash-types.bin: stamp-shim
--stamp-shim: mhash-shim.h $(cdecls)
-- touch stamp-shim
-- echo '(generate-shim "mhash" "#include \"mhash-shim.h\"")' \
-- | $(MIT_SCHEME_EXE) --batch-mode \
-- || rm stamp-shim
--
--mhash-const.bin: mhash-const.scm
-- echo '(sf "mhash-const")' | $(MIT_SCHEME_EXE) --batch-mode
--
--mhash-const.scm: mhash-const
-- ./mhash-const
--
--@MIT_SCHEME_DEPS@
--stamp-scheme: stamp-shim $(sources) mhash.pkg
-- touch stamp-scheme
-- if ! echo '(load "compile.scm")' \
-- | $(MIT_SCHEME_EXE) --prepend-library . --batch-mode; then \
-- rm stamp-scheme; exit 1; fi
--
--CLEANFILES = mhash-const* mhash-shim.c
--CLEANFILES += *.bin *.ext *.com *.bci *.moc *.fni *.crf *.fre *.pkd
--CLEANFILES += stamp-shim stamp-scheme
--CLEANFILES += @MIT_SCHEME_CLEAN@
--
--TESTS = mhash-check.sh
--CLEANFILES += sample
--
--tags: tags-am
-- ./tags-fix.sh mhash
--
--all_sources = $(sources) mhash-adapter.c
--ETAGS_ARGS = $(all_sources) -r '/^([^iI].*/' $(cdecls)
--TAGS_DEPENDENCIES = $(all_sources) $(cdecls)
--
--EXTRA_DIST += $(all_sources) $(cdecls) compile.scm mhash.pkg
--EXTRA_DIST += mhash-check.scm mhash-check.sh
--EXTRA_DIST += make.scm optiondb.scm tags-fix.sh debian
--
--install-data-hook:
-- ( echo '(add-plugin "mhash" "@MIT_SCHEME_PROJECT@"'; \
- echo ' "$(DESTDIR)$(infodir)"'; \
- echo ' ""'; \
-- echo ' "$(DESTDIR)$(scmlibdir)"'; \
-- echo ' "$(DESTDIR)$(scmdocdir)")' ) \
-- | $(MIT_SCHEME_EXE) --batch-mode
--
--install-html: install-html-am
-- ( echo '(add-plugin "mhash" "@MIT_SCHEME_PROJECT@"'; \
- echo ' "$(DESTDIR)$(infodir)"'; \
- echo ' ""'; \
-- echo ' "$(DESTDIR)$(scmlibdir)"'; \
-- echo ' "$(DESTDIR)$(scmdocdir)")' ) \
-- | $(MIT_SCHEME_EXE) --batch-mode
--
--install-info-am:
--
--uninstall-info-am:
--
--uninstall-hook:
-- ( echo '(remove-plugin "mhash" "@MIT_SCHEME_PROJECT@"'; \
- echo ' "$(DESTDIR)$(infodir)"'; \
- echo ' ""'; \
-- echo ' "$(DESTDIR)$(scmlibdir)"'; \
-- echo ' "$(DESTDIR)$(scmdocdir)")' ) \
-- | $(MIT_SCHEME_EXE) --batch-mode
-- [ -d "$(DESTDIR)$(scmlib_subdir)" ] \
-- && rmdir "$(DESTDIR)$(scmlib_subdir)"
+++ /dev/null
--The Mhash option.
--
- This plugin creates an (mhash) package. It is built in the customary
- GNU way:
-This plugin creates an (mhash) package, a drop-in replacement for the
-microcode module based mhash-* procedures in the (runtime crypto)
-package. It is built in the customary GNU way:
--
-- ./configure ...
-- make all check install
--
--To use:
--
-- (load-option 'mhash)
-- (import-mhash)
--
--Import-mhash will modify the REPL's current environment by adding
--bindings linked to the plugin's exports. They are not exported to the
--global environment because they would conflict with the exports from
--(runtime crypto).
--
--To import into a CREF package set, add this to your .pkg file:
--
-- (global-definitions mhash/)
--
-- (define-package (your package name)
-- (parent (your package parent))
-- (import (mhash)
-- mhash-file
-- ...))
+++ /dev/null
--#| -*-Scheme-*- |#
--
--;;;; Compile the MHASH option.
--
--(load-option 'CREF)
--(load-option 'FFI)
--(compile-file "mhash" '() (->environment '(RUNTIME)))
--(cref/generate-constructors "mhash")
+++ /dev/null
--dnl Process this file with autoconf to produce a configure script.
--
--AC_PREREQ([2.69])
- AC_INIT([MIT/GNU Scheme Pucked mhash plugin],
- [0.2.1],
- [matt@birchwood-abbey.net],
- [mit-scheme-pucked-mhash])
-AC_INIT([MIT/GNU Scheme mhash plugin],
- [0.2],
- [bug-mit-scheme@gnu.org],
- [mit-scheme-mhash])
--AC_CONFIG_SRCDIR([mhash.pkg])
--AC_CONFIG_HEADERS([config.h])
--AC_CONFIG_MACRO_DIR([m4])
--
--AC_COPYRIGHT(
- [Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015,
- 2016, 2017 Matthew Birkholz
-
- This file is part of an mhash plugin for MIT/GNU Scheme Pucked,
- an experimental version of MIT/GNU Scheme.
-
- Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
-[Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
-- 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
-- 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
-- 2017 Massachusetts Institute of Technology
-
-This file is part of MIT/GNU Scheme.
--
--MIT/GNU Scheme is free software; you can redistribute it and/or modify
--it under the terms of the GNU General Public License as published by
--the Free Software Foundation; either version 2 of the License, or (at
--your option) any later version.
--
--MIT/GNU Scheme is distributed in the hope that it will be useful, but
--WITHOUT ANY WARRANTY; without even the implied warranty of
--MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
--General Public License for more details.
--
--You should have received a copy of the GNU General Public License
--along with MIT/GNU Scheme; if not, write to the Free Software
--Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
--USA.
--])
--
--AH_TOP([/*
-
- Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015,
- 2016, 2017 Matthew Birkholz
-
- This file is part of an mhash plugin for MIT/GNU Scheme Pucked,
- an experimental version of MIT/GNU Scheme.
--
--Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
-- 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
-- 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
-- 2017 Massachusetts Institute of Technology
-
-This file is part of MIT/GNU Scheme.
--
--MIT/GNU Scheme is free software; you can redistribute it and/or modify
--it under the terms of the GNU General Public License as published by
--the Free Software Foundation; either version 2 of the License, or (at
--your option) any later version.
--
--MIT/GNU Scheme is distributed in the hope that it will be useful, but
--WITHOUT ANY WARRANTY; without even the implied warranty of
--MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
--General Public License for more details.
--
--You should have received a copy of the GNU General Public License
--along with MIT/GNU Scheme; if not, write to the Free Software
--Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
--USA.
--
--*/])
--
--AM_INIT_AUTOMAKE
--
--LT_PREREQ([2.2.6])
--LT_INIT([dlopen])
--
--AC_PROG_CC
--AC_PROG_CPP
--AC_PROG_INSTALL
--
--if test ${GCC} = yes; then
--
-- MIT_CFLAGS="-Wall -Wundef -Wpointer-arith -Winline"
-- MIT_CFLAGS="${MIT_CFLAGS} -Wstrict-prototypes -Wnested-externs"
-- MIT_CFLAGS="${MIT_CFLAGS} -Wredundant-decls"
--
-- AC_MSG_CHECKING([for GCC>=4])
-- AC_COMPILE_IFELSE(
-- [AC_LANG_PROGRAM(
-- [[
-- #if __GNUC__ >= 4
-- ;
-- #else
-- #error "gcc too old"
-- #endif
-- ]],
-- [[]]
-- )],
-- [
-- AC_MSG_RESULT([yes])
-- MIT_CFLAGS="${MIT_CFLAGS} -Wextra -Wno-sign-compare"
-- MIT_CFLAGS="${MIT_CFLAGS} -Wno-unused-parameter"
-- MIT_CFLAGS="${MIT_CFLAGS} -Wold-style-definition"
-- # The generated shim code violates this big-time.
-- # MIT_CFLAGS="${MIT_CFLAGS} -Wmissing-prototypes"
-- MIT_CFLAGS="${MIT_CFLAGS} -Wunreachable-code"
-- MIT_CFLAGS="${MIT_CFLAGS} -Wwrite-strings"
-- ],
-- [AC_MSG_RESULT([no])])
--fi
--
--AC_CHECK_HEADER([mhash.h],[],[
-- AC_MSG_ERROR([Header file <mhash.h> not found.])])
--
--LIBS="-lmhash"
--
- MIT_SCHEME_PROJECT=mit-scheme-pucked
-MIT_SCHEME_PROJECT=mit-scheme
--: ${MIT_SCHEME_EXE=mit-scheme}
--MIT_SCHEME_LIBDIR=`( echo "(display (->namestring" ;\
-- echo " (system-library-directory-pathname)))" ) \
-- | ${MIT_SCHEME_EXE} --batch-mode`
--MIT_SCHEME_INCLUDEDIR=`( echo "(display (->namestring" ;\
-- echo " (directory-pathname" ;\
-- echo " (system-library-pathname" ;\
-- echo ' "mit-scheme.h"))))' ) \
-- | ${MIT_SCHEME_EXE} --batch-mode`
--
--cc_type=`echo "(display microcode-id/compiled-code-type)" \
-- | ${MIT_SCHEME_EXE} --batch-mode`
--os_suffix=`echo "(display (microcode-id/operating-system-suffix))" \
-- | ${MIT_SCHEME_EXE} --batch-mode`
--
--MIT_SCHEME_PKD="mhash-${os_suffix}.pkd"
--
--for f in mhash; do
-- MIT_SCHEME_SCMs="${MIT_SCHEME_SCMs} ${f}.scm"
-- MIT_SCHEME_BCIs="${MIT_SCHEME_BCIs} ${f}.bci"
-- MIT_SCHEME_DEPS="${MIT_SCHEME_DEPS}
--${f}.bci: stamp-scheme"
-- if test "$cc_type" = "c"; then
-- MIT_SCHEME_COMs="${MIT_SCHEME_COMs} ${f}.so"
-- MIT_SCHEME_CLEAN="${MIT_SCHEME_CLEAN} ${f}.c"
-- MIT_SCHEME_DEPS="${MIT_SCHEME_DEPS}
--${f}.so: stamp-scheme"
-- else
-- MIT_SCHEME_COMs="${MIT_SCHEME_COMs} ${f}.com"
-- MIT_SCHEME_DEPS="${MIT_SCHEME_DEPS}
--${f}.com: stamp-scheme"
-- fi
--done
--MIT_SCHEME_DEPS="${MIT_SCHEME_DEPS}
--${MIT_SCHEME_PKD}: stamp-scheme"
-
- # Install plugin docs in Scheme's docdir subdirectories.
- htmldir='$(datarootdir)/doc/$(MIT_SCHEME_PROJECT)/html'
- pdfdir='$(datarootdir)/doc/$(MIT_SCHEME_PROJECT)/pdf'
--
--AC_SUBST([MIT_SCHEME_PROJECT])
--AC_SUBST([MIT_CFLAGS])
--AC_SUBST([MIT_SCHEME_EXE])
--AC_SUBST([MIT_SCHEME_LIBDIR])
--AC_SUBST([MIT_SCHEME_INCLUDEDIR])
--AC_SUBST([MIT_SCHEME_PKD])
--AC_SUBST([MIT_SCHEME_SCMs])
--AC_SUBST([MIT_SCHEME_BCIs])
--AC_SUBST([MIT_SCHEME_COMs])
--AC_SUBST([MIT_SCHEME_CLEAN])
--AC_SUBST([MIT_SCHEME_DEPS])
--AM_SUBST_NOTMAKE([MIT_SCHEME_DEPS])
--AC_CONFIG_FILES([Makefile])
--AC_OUTPUT
+++ /dev/null
--#| -*-Scheme-*- |#
--
--;;;; Load the mhash option.
--
--(with-working-directory-pathname (directory-pathname (current-load-pathname))
-- (lambda ()
-- (load-package-set "mhash")))
-
- (add-subsystem-identification! "mhash" '(0 2 1))
--
- ;; "Export" these to the (runtime crypto) package bindings.
- (let ((crypto (->environment '(runtime crypto)))
- (mhash (->environment '(mhash))))
- (for-each
- (lambda (name)
- (environment-assign! crypto name (environment-lookup mhash name)))
- '(make-mhash-keygen-type
- mhash-bytevector
- mhash-context?
- mhash-end
- mhash-file
- mhash-get-block-size
- mhash-hmac-end
- mhash-hmac-init
- mhash-hmac-update
- mhash-init
- mhash-keygen
- mhash-keygen-max-key-size
- mhash-keygen-salt-size
- mhash-keygen-type-names
- mhash-keygen-type?
- mhash-keygen-uses-count?
- mhash-keygen-uses-hash-algorithm
- mhash-keygen-uses-salt?
- mhash-string
- mhash-type-names
- mhash-update)))
-(add-subsystem-identification! "mhash" '(0 2))
+++ /dev/null
--/* -*-C-*-
--
--Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
-- 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
-- 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
-- 2017 Massachusetts Institute of Technology
--
--This file is part of MIT/GNU Scheme.
--
--MIT/GNU Scheme is free software; you can redistribute it and/or modify
--it under the terms of the GNU General Public License as published by
--the Free Software Foundation; either version 2 of the License, or (at
--your option) any later version.
--
--MIT/GNU Scheme is distributed in the hope that it will be useful, but
--WITHOUT ANY WARRANTY; without even the implied warranty of
--MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
--General Public License for more details.
--
--You should have received a copy of the GNU General Public License
--along with MIT/GNU Scheme; if not, write to the Free Software
--Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
--USA.
--
--*/
--
--/* Adapters for the mhash crypto-hash library. */
--
--#include "mhash-shim.h"
--
--extern void
--do_mhash (MHASH thread, const char *string, int start, int end)
--{
-- mhash (thread, string + start, end - start);
--}
--
--extern void
--do_mhash_end (MHASH context, char *string, size_t size)
--{
-- void * digest = mhash_end (context);
-- memcpy (string, digest, size);
-- free (digest);
--}
--
--extern void
--do_mhash_hmac_end (MHASH context, char *string, size_t size)
--{
-- void * digest = mhash_hmac_end (context);
-- memcpy (string, digest, size);
-- free (digest);
--}
--
--extern int
--do_mhash_keygen (keygenid algorithm,
-- hashid hashid1, hashid hashid2,
-- int count,
-- void *salt, int salt_size,
-- char *keyword, int keysize,
-- unsigned char *password, int passwordlen)
--{
-- KEYGEN keygen;
--
-- keygen.hash_algorithm[0] = hashid1;
-- keygen.hash_algorithm[1] = hashid2;
-- keygen.count = count;
-- keygen.salt = salt;
-- keygen.salt_size = salt_size;
--
-- return (mhash_keygen_ext (algorithm, keygen,
-- keyword, keysize,
-- password, passwordlen));
--}
+++ /dev/null
--#| -*-Scheme-*-
--
--Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
-- 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
-- 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
-- 2017 Massachusetts Institute of Technology
--
--This file is part of MIT/GNU Scheme.
--
--MIT/GNU Scheme is free software; you can redistribute it and/or modify
--it under the terms of the GNU General Public License as published by
--the Free Software Foundation; either version 2 of the License, or (at
--your option) any later version.
--
--MIT/GNU Scheme is distributed in the hope that it will be useful, but
--WITHOUT ANY WARRANTY; without even the implied warranty of
--MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
--General Public License for more details.
--
--You should have received a copy of the GNU General Public License
--along with MIT/GNU Scheme; if not, write to the Free Software
--Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
--USA.
--
--|#
--
--;;;; Test the MHASH option.
--
--(let ((sample "Some text to hash."))
-- (let ((hash (bytevector->hexadecimal (mhash-string 'md5 sample))))
-- (if (not (string=? hash "C8E89C4CBF3ABF9AA758D691CBE4B784"))
-- (error "Bad hash for sample text:" hash)))
-- (call-with-output-file "sample"
-- (lambda (port) (write-string sample port) (newline port)))
-- (let ((hash (bytevector->hexadecimal (mhash-file 'md5 "sample"))))
-- (if (not (string=? hash "43EB9ECCB88C329721925EFC04843AF1"))
-- (error "Bad hash for sample file:" hash))))
+++ /dev/null
--#!/bin/sh
--#
--# Test the MHASH option.
--
--set -e
--${MIT_SCHEME_EXE} --prepend-library . <<\EOF
--(load-option 'MHASH)
--(load "mhash-check" (->environment '(mhash)))
--EOF
+++ /dev/null
--/* -*-C-*-
--
--Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
-- 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
-- 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
-- 2017 Massachusetts Institute of Technology
--
--This file is part of MIT/GNU Scheme.
--
--MIT/GNU Scheme is free software; you can redistribute it and/or modify
--it under the terms of the GNU General Public License as published by
--the Free Software Foundation; either version 2 of the License, or (at
--your option) any later version.
--
--MIT/GNU Scheme is distributed in the hope that it will be useful, but
--WITHOUT ANY WARRANTY; without even the implied warranty of
--MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
--General Public License for more details.
--
--You should have received a copy of the GNU General Public License
--along with MIT/GNU Scheme; if not, write to the Free Software
--Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
--USA.
--
--*/
--
--/* Interface to the mhash crypto-hash library. */
--
--#include "config.h"
--
--#include <mhash.h>
--
--extern void do_mhash (MHASH thread, const char *string, int start, int end);
--extern void do_mhash_end (MHASH context, char *string, size_t size);
--extern void do_mhash_hmac_end (MHASH context, char *string, size_t size);
--extern int do_mhash_keygen (keygenid algorithm,
-- hashid hashid1, hashid hashid2,
-- int count,
-- void *salt, int salt_size,
-- char *keyword, int keysize,
-- unsigned char *password, int passwordlen);
+++ /dev/null
--#| -*-Scheme-*-
--
--Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
-- 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
-- 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
-- 2017 Massachusetts Institute of Technology
--
--This file is part of MIT/GNU Scheme.
--
--MIT/GNU Scheme is free software; you can redistribute it and/or modify
--it under the terms of the GNU General Public License as published by
--the Free Software Foundation; either version 2 of the License, or (at
--your option) any later version.
--
--MIT/GNU Scheme is distributed in the hope that it will be useful, but
--WITHOUT ANY WARRANTY; without even the implied warranty of
--MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
--General Public License for more details.
--
--You should have received a copy of the GNU General Public License
--along with MIT/GNU Scheme; if not, write to the Free Software
--Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
--USA.
--
--|#
--
--;;;; C declarations for mhash-shim.so.
--\f
--(typedef MHASH (* MHASH_INSTANCE))
--(typedef hashid int)
--(typedef keygenid int)
--
--(extern int mhash_count)
--(extern (* char) mhash_get_hash_name (id hashid))
--(extern int mhash_get_block_size (id hashid))
--(extern int mhash_get_hash_pblock (id hashid))
--
--(extern int mhash_keygen_count)
--(extern (* uchar) mhash_get_keygen_name (id keygenid))
--(extern int mhash_get_keygen_salt_size (id keygenid))
--(extern int mhash_get_keygen_max_key_size (id keygenid))
--(extern int mhash_keygen_uses_salt (id keygenid))
--(extern int mhash_keygen_uses_count (id keygenid))
--(extern int mhash_keygen_uses_hash_algorithm (id keygenid))
--
--(extern MHASH mhash_init (type hashid))
--
--(extern void mhash_deinit (context MHASH) (digest (* void)))
--
--(extern void do_mhash
-- (thread MHASH)
-- (string (* (const char)))
-- (start int)
-- (end int))
--
--(extern void do_mhash_end
-- (context MHASH)
-- (string (* char))
-- (size int))
--
--(extern MHASH mhash_hmac_init
-- (type hashid)
-- (key (* void))
-- (keysize int)
-- (blocksize int))
--
--(extern int mhash_hmac_deinit (context MHASH) (digest (* void)))
--
--(extern void do_mhash_hmac_end
-- (context MHASH)
-- (string (* char))
-- (size int))
--
--(extern int do_mhash_keygen
-- (id keygenid)
-- (hashid1 hashid)
-- (hashid2 hashid)
-- (count uint)
-- (salt (* void))
-- (salt_size int)
-- (keyword (* char))
-- (keysize int)
-- (password (* uchar))
-- (passwordlen int))
+++ /dev/null
--#| -*-Scheme-*-
--
--Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
-- 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
-- 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
-- 2017 Massachusetts Institute of Technology
--
--This file is part of MIT/GNU Scheme.
--
--MIT/GNU Scheme is free software; you can redistribute it and/or modify
--it under the terms of the GNU General Public License as published by
--the Free Software Foundation; either version 2 of the License, or (at
--your option) any later version.
--
--MIT/GNU Scheme is distributed in the hope that it will be useful, but
--WITHOUT ANY WARRANTY; without even the implied warranty of
--MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
--General Public License for more details.
--
--You should have received a copy of the GNU General Public License
--along with MIT/GNU Scheme; if not, write to the Free Software
--Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
--USA.
--
--|#
--
--(global-definitions runtime/)
--
--(define-package (mhash)
-- (files "mhash")
-- (parent ())
-- (export ()
-- import-mhash)
-- (initialization (initialize-package!))
- ;; These are "exported" to (runtime crypto) during load-option.
-- (export (mhash global)
-- make-mhash-keygen-type
-- mhash-bytevector
-- mhash-context?
-- mhash-end
-- mhash-file
-- mhash-get-block-size
-- mhash-hmac-end
-- mhash-hmac-init
-- mhash-hmac-update
-- mhash-init
-- mhash-keygen
-- mhash-keygen-max-key-size
-- mhash-keygen-salt-size
-- mhash-keygen-type-names
-- mhash-keygen-type?
-- mhash-keygen-uses-count?
-- mhash-keygen-uses-hash-algorithm
-- mhash-keygen-uses-salt?
-- mhash-string
-- mhash-type-names
-- mhash-update))
--
--(define-package (mhash global)
-- ;; Just to get cref to analyze whether all exports are defined.
-- )
+++ /dev/null
--#| -*-Scheme-*-
--
--Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
-- 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
-- 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
-- 2017 Massachusetts Institute of Technology
--
--This file is part of MIT/GNU Scheme.
--
--MIT/GNU Scheme is free software; you can redistribute it and/or modify
--it under the terms of the GNU General Public License as published by
--the Free Software Foundation; either version 2 of the License, or (at
--your option) any later version.
--
--MIT/GNU Scheme is distributed in the hope that it will be useful, but
--WITHOUT ANY WARRANTY; without even the implied warranty of
--MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
--General Public License for more details.
--
--You should have received a copy of the GNU General Public License
--along with MIT/GNU Scheme; if not, write to the Free Software
--Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
--USA.
--
--|#
--
--;;;; The mhash option.
--;;; package: (mhash)
--
--(declare (usual-integrations))
--\f
--(define (import-mhash)
-- (let ((target-environment (nearest-repl/environment))
-- (source-environment (->environment '(mhash))))
-- (for-each (lambda (name)
-- (link-variables target-environment name
-- source-environment name))
-- '(make-mhash-keygen-type
-- mhash-bytevector
-- mhash-context?
-- mhash-end
-- mhash-file
-- mhash-get-block-size
-- mhash-hmac-end
-- mhash-hmac-init
-- mhash-hmac-update
-- mhash-init
-- mhash-keygen
-- mhash-keygen-max-key-size
-- mhash-keygen-salt-size
-- mhash-keygen-type-names
-- mhash-keygen-type?
-- mhash-keygen-uses-count?
-- mhash-keygen-uses-hash-algorithm
-- mhash-keygen-uses-salt?
-- mhash-string
-- mhash-type-names
-- mhash-update))))
--
--(C-include "mhash")
--
--(define mhash-algorithm-names)
--(define mhash-contexts '())
--(define mhash-hmac-contexts '())
--(define mhash-contexts-mutex)
--
--;;; Lock order:
--;;;
--;;; {mhash-context-mutex, mhash-hmac-context-mutex}
--;;; -> mhash-contexts-mutex
--
--(define (add-context-cleanup context)
-- (with-thread-mutex-lock mhash-contexts-mutex
-- (lambda ()
-- (set! mhash-contexts
-- (cons (weak-cons context (mhash-context-alien context))
-- mhash-contexts)))))
--
--(define (add-hmac-context-cleanup context)
-- (with-thread-mutex-lock mhash-contexts-mutex
-- (lambda ()
-- (set! mhash-hmac-contexts
-- (cons (weak-cons context (mhash-hmac-context-alien context))
-- mhash-contexts)))))
--
--(define (remove-context-cleanup context)
-- (with-thread-mutex-lock mhash-contexts-mutex
-- (lambda ()
-- (let ((entry (weak-assq context mhash-contexts)))
-- (if entry
-- (set! mhash-contexts (delq! entry mhash-contexts)))))))
--
--(define (remove-hmac-context-cleanup context)
-- (with-thread-mutex-lock mhash-contexts-mutex
-- (lambda ()
-- (let ((entry (weak-assq context mhash-hmac-contexts)))
-- (if entry
-- (set! mhash-hmac-contexts (delq! entry mhash-hmac-contexts)))))))
--
--(define (weak-assq obj alist)
-- (let loop ((alist alist))
-- (if (null? alist) #f
-- (let* ((entry (car alist))
-- (key (weak-car entry)))
-- (if (eq? obj key) entry
-- (loop (cdr alist)))))))
--
--(define (cleanup-contexts)
-- (let loop ((entries mhash-contexts)
-- (prev #f))
-- (if (pair? entries)
-- (let ((entry (car entries))
-- (next (cdr entries)))
-- (if (weak-pair/car? entry)
-- (loop next entries)
-- (let ((context (weak-cdr entry)))
-- (if prev
-- (set-cdr! prev next)
-- (set! mhash-contexts next))
-- (if (not (alien-null? context))
-- (begin
-- (C-call "mhash_deinit" context 0)
-- (alien-null! context)))
-- (loop next prev)))))))
--
--(define (cleanup-hmac-contexts)
-- (let loop ((entries mhash-hmac-contexts)
-- (prev #f))
-- (if (pair? entries)
-- (let ((entry (car entries))
-- (next (cdr entries)))
-- (if (weak-pair/car? entry)
-- (loop next entries)
-- (let ((context (weak-cdr entry)))
-- (if prev
-- (set-cdr! prev next)
-- (set! mhash-hmac-contexts next))
-- (if (not (alien-null? context))
-- (begin
-- (C-call "mhash_hmac_deinit" context 0)
-- (alien-null! context)))
-- (loop next prev)))))))
--
--(define (cleanup-mhash-contexts)
-- (with-thread-mutex-try-lock
-- mhash-contexts-mutex
-- (lambda ()
-- (cleanup-contexts)
-- (cleanup-hmac-contexts))
-- (lambda ()
-- unspecific)))
--
--(define (mhash-name->id name procedure)
-- (let ((n (vector-length mhash-algorithm-names)))
-- (let loop ((i 0))
-- (cond ((fix:= i n) (error:bad-range-argument name procedure))
-- ((eq? name (vector-ref mhash-algorithm-names i)) i)
-- (else (loop (fix:+ i 1)))))))
--
--(define-structure mhash-context mutex alien id)
--(define-structure mhash-hmac-context mutex alien id)
--
--(define (guarantee-mhash-context object caller)
-- (if (not (mhash-context? object))
-- (error:wrong-type-argument object "mhash context" caller))
-- (if (alien-null? (mhash-context-alien object))
-- (error:bad-range-argument object caller)))
--
--(define (guarantee-mhash-hmac-context object caller)
-- (if (not (mhash-hmac-context? object))
-- (error:wrong-type-argument object "mhash HMAC context" caller))
-- (if (alien-null? (mhash-hmac-context-alien object))
-- (error:bad-range-argument object caller)))
--
--(define (guarantee-subbytevector object start end operator)
-- (guarantee bytevector? object operator)
-- (guarantee index-fixnum? start operator)
-- (guarantee index-fixnum? end operator)
-- (if (not (fix:<= start end))
-- (error:bad-range-argument start operator))
-- (if (not (fix:<= end (bytevector-length object)))
-- (error:bad-range-argument end operator)))
--
--(define (with-context-locked context thunk)
-- (with-thread-mutex-lock (mhash-context-mutex context) thunk))
--
--(define (with-hmac-context-locked context thunk)
-- (with-thread-mutex-lock (mhash-hmac-context-mutex context) thunk))
--
--(define (with-context-locked-open context operator receiver)
-- (with-thread-mutex-lock (mhash-context-mutex context)
-- (lambda ()
-- (let ((alien (mhash-context-alien context)))
-- (if (alien-null? alien)
-- (error:bad-range-argument context operator))
-- (receiver alien)))))
--
--(define (with-hmac-context-locked-open context operator receiver)
-- (with-thread-mutex-lock (mhash-hmac-context-mutex context)
-- (lambda ()
-- (let ((alien (mhash-hmac-context-alien context)))
-- (if (alien-null? alien)
-- (error:bad-range-argument context operator))
-- (receiver alien)))))
--
--(define (mhash-type-names)
-- (names-vector->list mhash-algorithm-names))
--
--(define (mhash-get-block-size name)
-- (C-call "mhash_get_block_size"
-- (mhash-name->id name 'mhash-get-block-size)))
--
--(define (mhash-init name)
-- (let ((id (mhash-name->id name 'mhash-init))
-- (alien (make-alien '|MHASH_INSTANCE|)))
-- (let ((context (make-mhash-context (make-thread-mutex) alien id)))
-- (add-context-cleanup context)
-- (with-context-locked context
-- (lambda ()
-- (C-call "mhash_init" alien id)
-- (if (alien-null? alien) ; == MHASH_FAILED
-- (error "Unable to allocate mhash context:" name))))
-- context)))
--
--(define (mhash-update context bytes start end)
- (guarantee-mhash-context context 'mhash-update)
-- (guarantee-subbytevector bytes start end 'mhash-update)
-- (with-context-locked-open context 'mhash-update
-- (lambda (alien)
-- (C-call "do_mhash" alien bytes start end))))
--
--(define (mhash-end context)
-- (with-context-locked-open context 'mhash-end
-- (lambda (alien)
-- (let* ((id (mhash-context-id context))
-- (size (C-call "mhash_get_block_size" id))
-- (digest (make-bytevector size)))
-- (C-call "do_mhash_end" alien digest size)
-- (remove-context-cleanup context)
-- digest))))
--
--(define (mhash-hmac-init name key)
-- (let ((id (mhash-name->id name 'mhash-hmac-init))
-- (alien (make-alien '|MHASH_INSTANCE|)))
-- (let ((context (make-mhash-hmac-context (make-thread-mutex) alien id))
-- (block-size (C-call "mhash_get_hash_pblock" id))
-- (key-size (if (bytevector? key)
-- (bytevector-length key)
-- (string-length key))))
-- (add-hmac-context-cleanup context)
-- (with-hmac-context-locked context
-- (lambda ()
-- (C-call "mhash_hmac_init" alien id key key-size block-size)
-- (if (alien-null? alien) ; == MHASH_FAILED
-- (error "Unable to allocate mhash HMAC context:" name))))
-- context)))
--
--(define (mhash-hmac-update context bytes start end)
-- (guarantee-mhash-hmac-context context 'mhash-hmac-update)
-- (guarantee-subbytevector bytes start end 'mhash-hmac-update)
-- (with-hmac-context-locked-open context 'mhash-hmac-update
-- (lambda (alien)
-- (C-call "do_mhash" alien bytes start end))))
--
--(define (mhash-hmac-end context)
-- (with-hmac-context-locked-open context 'mhash-hmac-end
-- (lambda (alien)
-- (let* ((id (mhash-hmac-context-id context))
-- (size (C-call "mhash_get_block_size" id))
-- (digest (make-bytevector size)))
-- (C-call "do_mhash_hmac_end" alien digest size)
-- (remove-hmac-context-cleanup context)
-- digest))))
--\f
--(define mhash-keygen-names)
--
--(define (keygen-name->id name caller)
-- (let ((n (vector-length mhash-keygen-names)))
-- (let loop ((i 0))
-- (cond ((fix:= i n) (error:bad-range-argument name caller))
-- ((eq? name (vector-ref mhash-keygen-names i)) i)
-- (else (loop (fix:+ i 1)))))))
--
--(define (mhash-keygen-type-names)
-- (names-vector->list mhash-keygen-names))
--
--(define (mhash-keygen-uses-salt? name)
-- (not (zero? (C-call "mhash_keygen_uses_salt"
-- (keygen-name->id name 'mhash-keygen-uses-salt?)))))
--
--(define (mhash-keygen-uses-count? name)
-- (not (zero? (C-call "mhash_keygen_uses_count"
-- (keygen-name->id name 'mhash-keygen-uses-count?)))))
--
--(define (mhash-keygen-uses-hash-algorithm name)
-- (C-call "mhash_keygen_uses_hash_algorithm"
-- (keygen-name->id name 'mhash-keygen-uses-hash-algorithm)))
--
--(define (mhash-keygen-salt-size name)
-- (C-call "mhash_get_keygen_salt_size"
-- (keygen-name->id name 'mhash-keygen-salt-size)))
--
--(define (mhash-keygen-max-key-size name)
-- (C-call "mhash_get_keygen_max_key_size"
-- (keygen-name->id name 'mhash-keygen-max-key-size)))
--
--(define (mhash-keygen type passphrase #!optional salt)
-- (if (not (mhash-keygen-type? type))
-- (error:wrong-type-argument type "mhash type" 'mhash-keygen))
-- (let ((keygenid (mhash-keygen-type-id type))
-- (keyword-size (mhash-keygen-type-key-length type))
-- (passbytes (string->utf8 passphrase)))
-- (let ((params (salted-keygen-params
-- keygenid (mhash-keygen-type-parameter-vector type) salt))
-- (keyword (make-bytevector keyword-size))
-- (max-key-size (C-call "mhash_get_keygen_max_key_size" keygenid)))
--
-- (define (hashid-map params i)
-- (let ((name (vector-ref params i)))
-- (if (not name)
-- 0
-- (mhash-name->id name 'mhash-keygen))))
--
-- (if (not (or (zero? max-key-size)
-- (< max-key-size (bytevector-length keyword))))
-- (error "keyword size exceeds maximum:" max-key-size type))
-- (if (not (zero? (C-call "do_mhash_keygen"
-- keygenid
-- (hashid-map params 3) ;hash_algorithm[0]
-- (hashid-map params 4) ;hash_algorithm[1]
-- (vector-ref params 1) ;count
-- (vector-ref params 0) ;salt
-- (bytevector-length (vector-ref params 0))
-- keyword keyword-size
-- passbytes (bytevector-length passbytes))))
-- (error "Error signalled by mhash_keygen."))
-- keyword)))
--
--(define (salted-keygen-params id params #!optional salt)
-- (if (not (zero? (C-call "mhash_keygen_uses_salt" id)))
-- (begin
-- (if (or (default-object? salt) (not salt))
-- (error "Salt required:"
-- (vector-ref mhash-keygen-names id)))
-- (let ((n (C-call "mhash_get_keygen_salt_size" id)))
-- (if (not (or (= n 0)
-- (= n (bytevector-length salt))))
-- (error "Salt size incorrect:"
-- (bytevector-length salt)
-- (error-irritant/noise "; should be:")
-- n)))
-- (let ((p (vector-copy params)))
-- (vector-set! p 0 salt)
-- p))
-- params))
--\f
--(define-structure (mhash-keygen-type (constructor %make-mhash-keygen-type))
-- (id #f read-only #t)
-- (key-length #f read-only #t)
-- (parameter-vector #f read-only #t))
--
--(define (make-mhash-keygen-type name key-length hash-names #!optional count)
-- (guarantee index-fixnum? key-length 'make-mhash-keygen-type)
-- (if (not (let ((m (mhash-keygen-max-key-size name)))
-- (or (= m 0)
-- (<= key-length m))))
-- (error:bad-range-argument key-length 'make-mhash-keygen-type))
-- (%make-mhash-keygen-type
-- (keygen-name->id name 'make-mhash-keygen-type)
-- key-length
-- (let ((n-algorithms (mhash-keygen-uses-hash-algorithm name))
-- (hash-names
-- (if (list? hash-names) hash-names (list hash-names))))
-- (let ((m (length hash-names)))
-- (if (not (= n-algorithms m))
-- (error "Wrong number of hash types supplied:"
-- m
-- (error-irritant/noise "; should be:")
-- n-algorithms)))
-- (let ((n (+ 2 n-algorithms)))
-- (let ((v (make-vector n)))
-- (vector-set! v 0 #f)
-- (vector-set!
-- v 1
-- (and (mhash-keygen-uses-count? name)
-- (begin
-- (if (or (default-object? count) (not count))
-- (error "Iteration count required:" name))
-- (if (not (and (exact-integer? count)
-- (positive? count)))
-- (error:bad-range-argument count 'make-mhash-keygen-type))
-- count)))
-- (do ((i 2 (fix:+ i 1))
-- (names hash-names (cdr names)))
-- ((fix:= i n))
-- (vector-set! v i
-- (mhash-name->id (car names) 'make-mhash-keygen-type)))
-- v)))))
--\f
--(define (initialize-mhash-variables!)
-- (set! mhash-algorithm-names
-- (make-names-vector
-- (lambda () (C-call "mhash_count"))
-- (lambda (hashid)
-- (let* ((alien (make-alien-to-free
-- '(* char)
-- (lambda (alien)
-- (C-call "mhash_get_hash_name"
-- alien hashid))))
-- (string (and (not (alien-null? alien))
-- (c-peek-cstring alien))))
-- (free alien)
-- string))))
-- (set! mhash-keygen-names
-- (make-names-vector
-- (lambda () (C-call "mhash_keygen_count"))
-- (lambda (keygenid)
-- (let* ((alien (make-alien-to-free
-- '(* char)
-- (lambda (alien)
-- (C-call "mhash_get_keygen_name"
-- alien keygenid))))
-- (string (and (not (alien-null? alien))
-- (c-peek-cstring alien))))
-- (free alien)
-- string)))))
--
--(define (reset-mhash-variables!)
-- (for-each (lambda (weak) (alien-null! (weak-cdr weak))) mhash-contexts)
-- (set! mhash-contexts '())
-- (for-each (lambda (weak) (alien-null! (weak-cdr weak))) mhash-hmac-contexts)
-- (set! mhash-hmac-contexts '())
-- (initialize-mhash-variables!)
-- unspecific)
--
--(define (mhash-file hash-type filename)
-- (call-with-binary-input-file filename
-- (port-consumer (lambda () (mhash-init hash-type))
-- mhash-update
-- mhash-end)))
--
--(define (mhash-string hash-type string #!optional start end)
-- (mhash-bytevector hash-type (string->utf8 string start end)))
--
--(define (mhash-bytevector hash-type bytes #!optional start end)
-- (let* ((end (fix:end-index end (bytevector-length bytes) 'mhash-bytevector))
-- (start (fix:start-index start end 'mhash-bytevector))
-- (context (mhash-init hash-type)))
-- (mhash-update context bytes start end)
-- (mhash-end context)))
--
--(define (port-consumer initialize update finalize)
-- (lambda (port)
-- (call-with-buffer #x1000
-- (lambda (buffer)
-- (let ((context (initialize)))
-- (let loop ()
-- (let ((n (read-bytevector! buffer port)))
-- (if (and n (not (eof-object? n)))
-- (begin
-- (update context buffer 0 n)
-- (loop)))))
-- (finalize context))))))
--
--(define (call-with-buffer n procedure)
-- (let ((buffer (make-bytevector n)))
-- (dynamic-wind
-- (lambda ()
-- unspecific)
-- (lambda ()
-- (procedure buffer))
-- (lambda ()
-- (bytevector-fill! buffer 0)))))
--\f
--;;;; Package initialization
--
--(define (initialize-package!)
-- (set! mhash-contexts-mutex (make-thread-mutex))
-- (reset-mhash-variables!)
-- (add-gc-daemon! cleanup-mhash-contexts)
-- (add-event-receiver! event:after-restart reset-mhash-variables!))
--
--(define (make-names-vector get-count get-name)
-- (let ((n (get-count)))
-- (let ((v (make-vector n)))
-- (do ((i 0 (fix:+ i 1)))
-- ((fix:= i n))
-- (vector-set! v i
-- (let ((name (get-name i)))
-- (and name
-- (intern name)))))
-- v)))
--
--(define (names-vector->list v)
-- (let ((end (vector-length v)))
-- (let loop ((index 0) (names '()))
-- (if (fix:< index end)
-- (loop (fix:+ index 1)
-- (let ((name (vector-ref v index)))
-- (if name
-- (cons name names)
-- names)))
-- names))))
+++ /dev/null
--#| -*-Scheme-*- |#
--
--(define-load-option 'MHASH
-- (standard-system-loader "."))
--
--(further-load-options
-- (named-lambda (system-load-options)
-- (merge-pathnames "optiondb"
-- (cadr (access library-directory-path
-- (->environment '(runtime pathname)))))))
AS_FLAGS="-arch x86_64 ${AS_FLAGS}"
;;
esac
- CFLAGS="${CFLAGS} ${MACOSX_CFLAGS} -frounding-math"
+ if ! cc --version | grep -q clang; then
+ dnl -frounding-math not supported by clang.
+ MACOSX_CFLAGS="${MACOSX_CFLAGS} -frounding-math"
+ fi
+ CFLAGS="${CFLAGS} ${MACOSX_CFLAGS}"
LDFLAGS="${LDFLAGS} ${MACOSX_CFLAGS} -Wl,-syslibroot,${MACOSX_SYSROOT}"
LDFLAGS="${LDFLAGS} -framework CoreFoundation"
- MODULE_LDFLAGS="${MODULE_LDFLAGS} -bundle"
- if test "${with_module_loader}" != no; then
- if test "${with_module_loader}" = yes; then
- MODULE_LOADER='${SCHEME_EXE}'
- else
- MODULE_LOADER="${with_module_loader}"
- fi
- MODULE_LDFLAGS="${MODULE_LDFLAGS} -bundle_loader ${MODULE_LOADER}"
- fi
AUX_PROGRAMS="${AUX_PROGRAMS} macosx-starter"
;;
netbsd*)
;;; package: (runtime blowfish)
(declare (usual-integrations))
-
-(define-primitives
- (blowfish-set-key 1)
- (blowfish-ecb 4)
- (blowfish-cbc blowfish-cbc-v2 5)
- (blowfish-cfb64 blowfish-cfb64-substring-v2 9)
- (blowfish-ofb64 blowfish-ofb64-substring 8))
-
-(define (blowfish-available?)
- (load-library-object-file "prbfish" #f)
- (implemented-primitive-procedure?
- (ucode-primitive blowfish-cfb64-substring-v2 9)))
\f
-(define (blowfish-encrypt-port input output key init-vector encrypt?)
- ;; Assumes that INPUT is in blocking mode.
- (let ((key (blowfish-set-key key))
- (input-buffer (make-bytevector 4096))
- (output-buffer (make-bytevector 4096)))
- (dynamic-wind
- (lambda ()
- unspecific)
- (lambda ()
- (let loop ((m 0))
- (let ((n (read-bytevector! input-buffer input)))
- (if (and n (not (eof-object? n)))
- (let ((m
- (blowfish-cfb64 input-buffer 0 n output-buffer 0
- key init-vector m encrypt?)))
- (let ((n* (write-bytevector output-buffer output 0 n)))
- (if (not (eqv? n n*))
- (error "Short write (requested, actual):" n n*)))
- (loop m))))))
- (lambda ()
- (bytevector-fill! input-buffer 0)
- (bytevector-fill! output-buffer 0)))))
-
-(define (compute-blowfish-init-vector)
- ;; This init vector includes a timestamp with a resolution of
- ;; milliseconds, plus 20 random bits. This should make it very
- ;; difficult to generate two identical vectors.
- (let ((iv (make-bytevector 8)))
- (do ((i 0 (fix:+ i 1))
- (t (+ (* (+ (* (get-universal-time) 1000)
- (remainder (real-time-clock) 1000))
- #x100000)
- (random #x100000))
- (quotient t #x100)))
- ((not (fix:< i 8)))
- (bytevector-u8-set! iv i (remainder t #x100)))
- iv))
-
-(define (write-blowfish-file-header port)
- (write-bytevector blowfish-file-header-v2 port)
- (let ((init-vector (compute-blowfish-init-vector)))
- (write-bytevector init-vector port)
- init-vector))
+;;; This package now autoloads the blowfish plugin, which updates the
+;;; bindings during blowfish-available?. During a restore the
+;;; bindings are un-assigned. Restored threads in the midst of using
+;;; the blowfish library thus quickly signal unassigned and can
+;;; restart or abort as appropriate. It is assumed a restart begins
+;;; again with a call to blowfish-available?, thus autoloading the
+;;; plugin in the restored world.
-(define (read-blowfish-file-header port)
- (let ((version (try-read-blowfish-file-header port)))
- (if (not version)
- (error:bad-range-argument port 'read-blowfish-file-header))
- (if (= version 1)
- (make-bytevector 8 0)
- (or (%safe-read-bytevector 8 port)
- (error "Short read while getting init-vector:" port)))))
+(define loaded? #f)
-(define (try-read-blowfish-file-header port)
- (let* ((n (bytevector-length blowfish-file-header-v1))
- (bv1 (%safe-read-bytevector n port)))
- (and bv1
- (if (bytevector=? bv1 blowfish-file-header-v1)
- 1
- (let* ((m (fix:- (bytevector-length blowfish-file-header-v2) n))
- (bv2 (%safe-read-bytevector m port)))
- (and bv2
- (bytevector=? (bytevector-append bv1 bv2)
- blowfish-file-header-v2)
- 2))))))
-
-(define (%safe-read-bytevector n port)
- (let ((bv (read-bytevector n port)))
- (and bv
- (not (eof-object? bv))
- (fix:= (bytevector-length bv) n)
- bv)))
-
-(define (blowfish-file? pathname)
- (call-with-binary-input-file pathname try-read-blowfish-file-header))
-
-(define-deferred blowfish-file-header-v1
- (string->utf8 "Blowfish, 16 rounds\n"))
-
-(define-deferred blowfish-file-header-v2
- (string->utf8 "Blowfish, 16 rounds, version 2\n"))
+(define (blowfish-available?)
+ (or loaded?
+ (and (plugin-available? "blowfish")
+ (begin
+ (load-option 'blowfish)
++ (export-blowfish!)
+ (set! loaded? #t)
+ #t))))
+
++(define names
++ '(blowfish-cbc
++ blowfish-cfb64
++ blowfish-ecb
++ blowfish-encrypt-port
++ blowfish-file?
++ blowfish-ofb64
++ blowfish-set-key
++ compute-blowfish-init-vector
++ read-blowfish-file-header
++ write-blowfish-file-header))
++
++(define (export-blowfish!)
++ (let ((src (->environment '(blowfish)))
++ (dst (->environment '(runtime blowfish))))
++ (for-each (lambda (name)
++ (environment-assign! dst name (environment-lookup src name)))
++ names)))
++
+(define (reset-blowfish!)
+ (set! loaded? #f)
+ (let ((env (->environment '(runtime blowfish))))
- (for-each
- (lambda (name)
- (environment-assign! env name #!default))
- '(blowfish-cbc
- blowfish-cfb64
- blowfish-ecb
- blowfish-encrypt-port
- blowfish-file?
- blowfish-ofb64
- blowfish-set-key
- compute-blowfish-init-vector
- read-blowfish-file-header
- write-blowfish-file-header))))
++ (for-each (lambda (name) (environment-assign! env name #!default))
++ names)))
+
+(define blowfish-cbc)
+(define blowfish-cfb64)
+(define blowfish-ecb)
+(define blowfish-encrypt-port)
+(define blowfish-file?)
+(define blowfish-ofb64)
+(define blowfish-set-key)
+(define compute-blowfish-init-vector)
+(define read-blowfish-file-header)
+(define write-blowfish-file-header)
+
+(add-event-receiver! event:after-restart reset-blowfish!)
(declare (usual-integrations))
\f
- ;;; This package now autoloads plugins that update its bindings when
- ;;; they load. During a restore, the bindings are UN-assigned.
- ;;; Restored threads in the midst of a session thus quickly signal
- ;;; unassigned and can restart or abort as appropriate. It is assumed
- ;;; a restart begins again with a call to an -available? procedure (or
- ;;; load-option) thus autoloading the plugin in the restored world.
-
- (define (mcrypt-available?)
- (autoloaded? 'mcrypt))
+ ;;;; MD5
(define (md5-available?)
- (autoloaded? 'md5))
+ #t)
+
+ (define (md5-file filename)
+ (call-with-binary-input-file filename
+ (port-consumer (ucode-primitive md5-init 0)
+ (ucode-primitive md5-update 4)
+ (ucode-primitive md5-final 1))))
+
+ (define (md5-string string #!optional start end)
+ (md5-bytevector (string->utf8 string start end)))
+
+ (define (md5-bytevector bytes #!optional start end)
+ (let ((end (fix:end-index end (bytevector-length bytes) 'md5-bytevector))
+ (start (fix:start-index start end 'md5-bytevector))
+ (context ((ucode-primitive md5-init 0))))
+ ((ucode-primitive md5-update 4) context bytes start end)
+ ((ucode-primitive md5-final 1) context)))
-\f
-;;;; The mcrypt library
-
-(define mcrypt-initialized?)
-(define mcrypt-algorithm-names-vector)
-(define mcrypt-mode-names-vector)
-(define mcrypt-contexts)
-(define-structure mcrypt-context index)
-
-(define (guarantee-mcrypt-context object procedure)
- (if (not (mcrypt-context? object))
- (error:wrong-type-argument object "mcrypt context" procedure))
- (if (not (mcrypt-context-index object))
- (error:bad-range-argument object procedure)))
-
-(define (mcrypt-available?)
- (load-library-object-file "prmcrypt" #f)
- (and (implemented-primitive-procedure?
- (ucode-primitive mcrypt_module_open 2))
- (begin
- (if (not mcrypt-initialized?)
- (begin
- (set! mcrypt-contexts
- (make-gc-finalizer (ucode-primitive mcrypt_generic_end 1)
- mcrypt-context?
- mcrypt-context-index
- set-mcrypt-context-index!))
- (set! mcrypt-algorithm-names-vector
- ((ucode-primitive mcrypt_list_algorithms 0)))
- (set! mcrypt-mode-names-vector
- ((ucode-primitive mcrypt_list_modes 0)))
- (set! mcrypt-initialized? #t)))
- #t)))
-
-(define (reset-mcrypt-variables!)
- (set! mcrypt-initialized? #f)
- unspecific)
-
-(define (mcrypt-algorithm-names)
- (names-vector->list mcrypt-algorithm-names-vector))
-
-(define (mcrypt-mode-names)
- (names-vector->list mcrypt-mode-names-vector))
-
-(define (mcrypt-open-module algorithm mode)
- (without-interruption
- (lambda ()
- (add-to-gc-finalizer! mcrypt-contexts
- (make-mcrypt-context
- ((ucode-primitive mcrypt_module_open 2) algorithm
- mode))))))
-\f
-(define (mcrypt-init context key init-vector)
- (guarantee-mcrypt-context context 'mcrypt-init)
- (let ((code
- ((ucode-primitive mcrypt_generic_init 3)
- (mcrypt-context-index context) key init-vector)))
- (if (not (eqv? code 0))
- (error "Error code signalled by mcrypt_generic_init:" code))))
-
-(define-integrable (make-mcrypt-transform! name primitive)
- (lambda (context bytes start end)
- (guarantee-mcrypt-context context name)
- (let ((code (primitive (mcrypt-context-index context) bytes start end)))
- (if (not (eqv? code 0))
- (error (string "Error code signalled by "name":") code)))))
-
-(define mcrypt-encrypt!
- (make-mcrypt-transform! 'mcrypt-encrypt!
- (ucode-primitive mcrypt_generic 4)))
-
-(define mcrypt-decrypt!
- (make-mcrypt-transform! 'mcrypt-decrypt!
- (ucode-primitive mdecrypt_generic 4)))
-
-(define (mcrypt-encrypt context input input-start input-end
- output output-start encrypt?)
- ((if encrypt? mcrypt-encrypt! mcrypt-decrypt!)
- context
- output
- output-start
- (bytevector-copy! output output-start input input-start input-end)))
-
-(define (mcrypt-end context)
- (remove-from-gc-finalizer! mcrypt-contexts context))
-
-(define (mcrypt-generic-unary name context-op module-op)
- (lambda (object)
- (cond ((mcrypt-context? object) (context-op (mcrypt-context-index object)))
- ((bytevector? object) (module-op object))
- ((string? object) (module-op (string->utf8 object)))
- (else (error:wrong-type-argument object "mcrypt context" name)))))
-
-(define mcrypt-self-test
- (mcrypt-generic-unary
- 'mcrypt-self-test
- (ucode-primitive mcrypt_enc_self_test 1)
- (ucode-primitive mcrypt_module_self_test 1)))
-
-(define mcrypt-block-algorithm-mode?
- (mcrypt-generic-unary
- 'mcrypt-block-algorithm-mode?
- (ucode-primitive mcrypt_enc_is_block_algorithm_mode 1)
- (ucode-primitive mcrypt_module_is_block_algorithm_mode 1)))
-
-(define mcrypt-block-algorithm?
- (mcrypt-generic-unary
- 'mcrypt-block-algorithm?
- (ucode-primitive mcrypt_enc_is_block_algorithm 1)
- (ucode-primitive mcrypt_module_is_block_algorithm 1)))
-\f
-(define mcrypt-block-mode?
- (mcrypt-generic-unary
- 'mcrypt-block-mode?
- (ucode-primitive mcrypt_enc_is_block_mode 1)
- (ucode-primitive mcrypt_module_is_block_mode 1)))
-
-(define mcrypt-key-size
- (mcrypt-generic-unary
- 'mcrypt-key-size
- (ucode-primitive mcrypt_enc_get_key_size 1)
- (ucode-primitive mcrypt_module_get_algo_key_size 1)))
-
-(define mcrypt-supported-key-sizes
- (mcrypt-generic-unary
- 'mcrypt-supported-key-sizes
- (ucode-primitive mcrypt_enc_get_supported_key_sizes 1)
- (ucode-primitive mcrypt_module_get_algo_supported_key_sizes 1)))
-
-(define (mcrypt-init-vector-size context)
- (guarantee-mcrypt-context context 'mcrypt-init-vector-size)
- ((ucode-primitive mcrypt_enc_get_iv_size 1)
- (mcrypt-context-index context)))
-
-(define (mcrypt-algorithm-name context)
- (guarantee-mcrypt-context context 'mcrypt-algorithm-name)
- ((ucode-primitive mcrypt_enc_get_algorithms_name 1)
- (mcrypt-context-index context)))
-
-(define (mcrypt-mode-name context)
- (guarantee-mcrypt-context context 'mcrypt-mode-name)
- ((ucode-primitive mcrypt_enc_get_modes_name 1)
- (mcrypt-context-index context)))
-
-(define (mcrypt-encrypt-port algorithm mode input output key init-vector
- encrypt?)
- ;; Assumes that INPUT is in blocking mode.
- ((port-transformer (lambda ()
- (let ((context (mcrypt-open-module algorithm mode)))
- (mcrypt-init context key init-vector)
- context))
- (if encrypt? mcrypt-encrypt! mcrypt-decrypt!)
- mcrypt-end)
- input
- output))
-\f
-;;;; Package initialization
-
-(define (initialize-package!)
- (reset-mcrypt-variables!)
- (add-event-receiver! event:after-restart reset-mcrypt-variables!))
-
-(define (make-names-vector get-count get-name)
- (let ((n (get-count)))
- (let ((v (make-vector n)))
- (do ((i 0 (fix:+ i 1)))
- ((fix:= i n))
- (vector-set! v i
- (let ((name (get-name i)))
- (and name
- (intern name)))))
- v)))
-
-(define (names-vector->list v)
- (let ((end (vector-length v)))
- (let loop ((index 0) (names '()))
- (if (fix:< index end)
- (loop (fix:+ index 1)
- (let ((name (vector-ref v index)))
- (if name
- (cons name names)
- names)))
- names))))
+
+ (define (port-consumer initialize update finalize)
+ (lambda (port)
+ (call-with-buffer #x1000
+ (lambda (buffer)
+ (let ((context (initialize)))
+ (let loop ()
+ (let ((n (read-bytevector! buffer port)))
+ (if (and n (not (eof-object? n)))
+ (begin
+ (update context buffer 0 n)
+ (loop)))))
+ (finalize context))))))
+
-(define (port-transformer initialize update finalize)
- (lambda (input-port output-port)
- (call-with-buffer #x1000
- (lambda (buffer)
- (let ((context (initialize)))
- (let loop ()
- (let ((n (read-bytevector! buffer input-port)))
- (if (and n (fix:> n 0))
- (begin
- (update context buffer 0 n)
- (let ((n* (write-bytevector buffer output-port 0 n)))
- (if (not (eqv? n n*))
- (error "Short write (requested, actual):" n n*)))
- (loop)))))
- (finalize context))))))
-
+ (define (call-with-buffer n procedure)
+ (let ((buffer (make-bytevector n)))
+ (dynamic-wind
+ (lambda ()
+ unspecific)
+ (lambda ()
+ (procedure buffer))
+ (lambda ()
- (bytevector-fill! buffer 0)))))
++ (bytevector-fill! buffer 0)))))
++\f
++;;;; The mcrypt library
++
++(define mcrypt-initialized?)
+
- (define (mhash-available?)
- (autoloaded? 'mhash))
++;;; Access to the mcrypt library is now accomplished with the FFI
++;;; rather than a microcode module. The mcrypt bindings in this
++;;; package are initially unassigned, assigned by the mcrypt plugin
++;;; when it is loaded. Upon restore the bindings are UN-assigned
++;;; again. Restored threads in the midst of using mcrypt thus quickly
++;;; signal and can restart or abort as appropriate. It is assumed a
++;;; restart begins again with a call to mcrypt-available? (or
++;;; load-option) thus autoloading the plugin in the restored world.
+
- (define (autoloaded? pkg)
- (or (memq pkg autoloaded-options)
- (and (plugin-available? (symbol->string pkg))
++(define (mcrypt-available?)
++ (or mcrypt-initialized?
++ (and (plugin-available? "mcrypt")
+ (begin
- (load-option pkg)
- (with-thread-mutex-lock autoload-mutex
- (lambda ()
- (if (not (memq pkg autoloaded-options))
- (set! autoloaded-options (cons pkg autoloaded-options)))))
++ (load-option 'mcrypt)
++ (set! mcrypt-initialized? #t)
+ #t))))
+
- (define autoloaded-options '())
-
- (define autoload-mutex (make-thread-mutex))
-
+(define (reset-crypto!)
- ;; Need to break any lock on autoload-mutex, to trip up any restored
- ;; thread that thinks it still has a lock.
- (set! autoloaded-options '())
++ (set! mcrypt-initialized? #t)
+ (let ((env (->environment '(runtime crypto))))
+ (for-each
+ (lambda (name)
+ (environment-assign! env name #!default))
+ '(
+ ;; mcrypt
+ mcrypt-algorithm-name
+ mcrypt-algorithm-names
+ mcrypt-block-algorithm-mode?
+ mcrypt-block-algorithm?
+ mcrypt-block-mode?
+ mcrypt-context?
+ mcrypt-decrypt!
+ mcrypt-encrypt
+ mcrypt-encrypt!
+ mcrypt-encrypt-port
+ mcrypt-end
+ mcrypt-init
+ mcrypt-init-vector-size
+ mcrypt-key-size
+ mcrypt-mode-name
+ mcrypt-mode-names
+ mcrypt-open-module
+ mcrypt-self-test
+ mcrypt-supported-key-sizes
-
- ;; md5
- md5-bytevector
- md5-file
- md5-string
-
- ;; mhash
- make-mhash-keygen-type
- mhash-bytevector
- mhash-context?
- mhash-end
- mhash-file
- mhash-get-block-size
- mhash-hmac-end
- mhash-hmac-init
- mhash-hmac-update
- mhash-init
- mhash-keygen
- mhash-keygen-max-key-size
- mhash-keygen-salt-size
- mhash-keygen-type-names
- mhash-keygen-type?
- mhash-keygen-uses-count?
- mhash-keygen-uses-hash-algorithm
- mhash-keygen-uses-salt?
- mhash-string
- mhash-type-names
- mhash-update
+ ))))
+
+(define mcrypt-algorithm-name)
+(define mcrypt-algorithm-names)
+(define mcrypt-block-algorithm-mode?)
+(define mcrypt-block-algorithm?)
+(define mcrypt-block-mode?)
+(define mcrypt-context?)
+(define mcrypt-decrypt!)
+(define mcrypt-encrypt)
+(define mcrypt-encrypt!)
+(define mcrypt-encrypt-port)
+(define mcrypt-end)
+(define mcrypt-init)
+(define mcrypt-init-vector-size)
+(define mcrypt-key-size)
+(define mcrypt-mode-name)
+(define mcrypt-mode-names)
+(define mcrypt-open-module)
+(define mcrypt-self-test)
+(define mcrypt-supported-key-sizes)
+
- (define md5-bytevector)
- (define md5-file)
- (define md5-string)
- (define md5-substring)
- (define md5-sum->hexadecimal)
- (define md5-sum->number)
-
- (define make-mhash-keygen-type)
- (define mhash-bytevector)
- (define mhash-context?)
- (define mhash-end)
- (define mhash-file)
- (define mhash-get-block-size)
- (define mhash-hmac-end)
- (define mhash-hmac-init)
- (define mhash-hmac-update)
- (define mhash-init)
- (define mhash-keygen)
- (define mhash-keygen-max-key-size)
- (define mhash-keygen-salt-size)
- (define mhash-keygen-type-names)
- (define mhash-keygen-type?)
- (define mhash-keygen-uses-count?)
- (define mhash-keygen-uses-hash-algorithm)
- (define mhash-keygen-uses-salt?)
- (define mhash-string)
- (define mhash-substring)
- (define mhash-sum->hexadecimal)
- (define mhash-sum->number)
- (define mhash-type-names)
- (define mhash-update)
-
+(add-event-receiver! event:after-restart reset-crypto!)
(let ((now last-copyright-year)
(then 1986))
(iota (+ (- now then) 1) then)))
- (add-subsystem-identification! "Release" '(9 2 10))
- (add-subsystem-identification! "Release" '(9 2 1))
++ (add-subsystem-identification! "Release" '(9 2 11))
(snarf-microcode-version!)
(add-event-receiver! event:after-restore snarf-microcode-version!)
- (add-subsystem-identification! "Runtime" '(15 7))))
+ (add-subsystem-identification! "Runtime" '(15 8))))
(define (snarf-microcode-version!)
(add-subsystem-identification! "Microcode"
projects / mit-scheme.git / commitdiff