From: Matt Birkholz Date: Sun, 24 Dec 2017 18:51:02 +0000 (-0700) Subject: Merge branch 'master' into pucked. X-Git-Tag: mit-scheme-pucked-9.2.12~14 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b80a243a7a5969a7b5aa86672d302c389caab644;p=mit-scheme.git Merge branch 'master' into pucked. Remove md5 and mhash plugins. Increment doc and src versions. --- b80a243a7a5969a7b5aa86672d302c389caab644 diff --cc dist/shared.sh index cc37be335,352830c12..b534f07d2 --- a/dist/shared.sh +++ b/dist/shared.sh @@@ -100,9 -100,7 +100,9 @@@ LIARC_OUT=${OUTPUT_DIR}/liar 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 () { diff --cc doc/configure.ac index 78cfd5261,efb269bd9..eca8a0d56 --- a/doc/configure.ac +++ b/doc/configure.ac @@@ -1,9 -1,9 +1,9 @@@ 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( diff --cc doc/user-manual/user.texinfo index 6ef26e691,8a60c8b24..d1d45306f --- a/doc/user-manual/user.texinfo +++ b/doc/user-manual/user.texinfo @@@ -1,11 -1,10 +1,11 @@@ \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 @@@ -3830,468 -4223,13 +3830,465 @@@ Edwin's internal display data structure 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 diff --cc src/README.txt index 3316f5ae3,63dfa0708..9b3df9fe5 --- a/src/README.txt +++ b/src/README.txt @@@ -73,20 -79,9 +73,14 @@@ There are a few C/Unix FFI plugins 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. These are miscellaneous extras: diff --cc src/Tags.sh index 6d839172c,4725fd25c..2ebdb9551 --- a/src/Tags.sh +++ b/src/Tags.sh @@@ -32,11 -32,12 +32,9 @@@ DEFAULT_SUBDIRS=( blowfish \ compiler \ cref \ - edwin \ ffi \ gdbm \ - imail \ mcrypt \ - md5 \ -- mhash \ microcode \ runtime \ sf \ diff --cc src/blowfish/NEWS index 45122788c,cd0ac9f2a..b4ed06469 --- a/src/blowfish/NEWS +++ b/src/blowfish/NEWS @@@ -26,26 -22,19 +26,26 @@@ along with MIT/GNU Scheme; if not, writ 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. diff --cc src/blowfish/blowfish.pkg index ec4f4abce,ea43a5647..4929860df --- a/src/blowfish/blowfish.pkg +++ b/src/blowfish/blowfish.pkg @@@ -29,7 -29,9 +29,7 @@@ USA (define-package (blowfish) (files "blowfish") (parent ()) -- (export () - import-blowfish) + (export (blowfish global) blowfish-cbc blowfish-cfb64 blowfish-ecb @@@ -39,4 -41,8 +39,8 @@@ 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. + ) diff --cc src/blowfish/blowfish.texi index 16e6ecd88,2fbf3b284..cbc1edeb1 --- a/src/blowfish/blowfish.texi +++ b/src/blowfish/blowfish.texi @@@ -95,8 -77,8 +95,8 @@@ decryption phase @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? diff --cc src/devops/pucked.texi index ad512473b,000000000..275ec11f2 mode 100644,000000..100644 --- a/src/devops/pucked.texi +++ b/src/devops/pucked.texi @@@ -1,103 -1,0 +1,101 @@@ +@node Changes +@chapter How so ``pucked?'' + +The user visible differences between MIT/GNU Scheme version 9.2.2 and - MIT/GNU Scheme Pucked version 9.2.7 are detailed in @ref{Release ++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, - including files @file{prbfish.c}, @file{prgdbm.c}, @file{prmcrypt.c}, - @file{prmd5.c}, @file{prmhash.c} and @file{prpgsql.c}, as well as ++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 - @file{x11term}. Modified versions of these can be found in the plugin ++@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{} and the concrete class @code{}. 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. The only change to the - Scheme code was the addition of @code{(load-option 'md5)} where the - @code{md5-substring} procedure was used. ++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 diff --cc src/edwin/debian/control index 586fbda78,000000000..c5a17ea16 mode 100644,000000..100644 --- a/src/edwin/debian/control +++ b/src/edwin/debian/control @@@ -1,24 -1,0 +1,22 @@@ +Source: mit-scheme-pucked-edwin +Section: lisp +Priority: optional +Maintainer: Matt Birkholz +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-md5 (>= 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. diff --cc src/edwin/edwin.pkg index f691ba560,3c98a4b77..8ac498f94 --- a/src/edwin/edwin.pkg +++ b/src/edwin/edwin.pkg @@@ -26,12 -26,8 +26,11 @@@ USA ;;;; Edwin Packaging -(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" diff --cc src/edwin/edwin.sf index 7cb405f82,b0ddb5f0c..607a35cff --- a/src/edwin/edwin.sf +++ b/src/edwin/edwin.sf @@@ -25,11 -25,6 +25,10 @@@ USA |# (load-option 'CREF) +(load-option 'SOS) +(load-option 'XML) - (load-option 'MD5) +(load-option 'BLOWFISH) +(load-option 'GDBM) (if (not (name->package '(EDWIN))) (let ((package-set (package-set-pathname "edwin"))) diff --cc src/edwin/fileio.scm index 1c3116f50,eb3d69dc0..549542f4c --- a/src/edwin/fileio.scm +++ b/src/edwin/fileio.scm @@@ -40,10 -40,8 +40,8 @@@ filename suffix \".bf\". (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)) diff --cc src/gdbm/Makefile.am index f76720244,c12960e82..65aba7d29 --- a/src/gdbm/Makefile.am +++ b/src/gdbm/Makefile.am @@@ -29,7 -29,6 +29,7 @@@ MIT_SCHEME_EXE = @MIT_SCHEME_EXE 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 @@@ -42,8 -41,8 +42,10 @@@ binaries = @MIT_SCHEME_BCIs@ @MIT_SCHEM 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@ @@@ -84,6 -83,6 +86,9 @@@ CLEANFILES += @MIT_SCHEME_CLEAN TESTS = gdbm-check.sh CLEANFILES += gdbm-check.db ++check-local: ++ ./check-doc.sh ++ tags: tags-am ./tags-fix.sh gdbm diff --cc src/gdbm/NEWS index b61dec188,436e8e1d4..b11584349 --- a/src/gdbm/NEWS +++ b/src/gdbm/NEWS @@@ -26,14 -22,20 +26,20 @@@ along with MIT/GNU Scheme; if not, writ 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. diff --cc src/gdbm/check-doc.sh index 000000000,000000000..a9a3ed0d9 new file mode 100755 --- /dev/null +++ b/src/gdbm/check-doc.sh @@@ -1,0 -1,0 +1,148 @@@ ++#!/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 diff --cc src/gdbm/debian/control index 8233921e5,000000000..cc4c6fbae mode 100644,000000..100644 --- a/src/gdbm/debian/control +++ b/src/gdbm/debian/control @@@ -1,19 -1,0 +1,19 @@@ +Source: mit-scheme-pucked-gdbm +Section: lisp +Priority: optional +Maintainer: Matt Birkholz +Build-Depends: debhelper (>= 9), autotools-dev, libltdl-dev, - mit-scheme-pucked (>= 9.2.7), ++ 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.7), ${shlibs:Depends}, ${misc:Depends} ++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. diff --cc src/gdbm/gdbm.texi index 000000000,f6a58eacd..f9b86cacd mode 000000,100644..100644 --- a/src/gdbm/gdbm.texi +++ b/src/gdbm/gdbm.texi @@@ -1,0 -1,434 +1,435 @@@ + \input texinfo @c -*-texinfo-*- + @comment %**start of header -@setfilename mit-scheme-gdbm.info ++@setfilename gdbm.info + @include version.texi -@set SCMVERS 9.2.1 -@settitle MIT/GNU Scheme GDBM Plugin Manual ++@set SCMVERS 9.2.11 ++@settitle GDBM Plugin Manual + @comment %**end of header + + @copying -This manual documents MIT/GNU Scheme GDBM @value{VERSION}. ++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 -* MIT/GNU Scheme GDBM: (mit-scheme-gdbm). ++* GDBM: (mit-scheme-pucked/gdbm). + GNU database manager plugin + @end direntry + + @titlepage -@title MIT/GNU Scheme GDBM Plugin Manual ++@title GDBM Plugin Manual + @subtitle a GNU database manager plugin (version @value{VERSION}) -@subtitle for MIT/GNU Scheme version @value{SCMVERS} ++@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 diff --cc src/gdbm/make.scm index dad660971,f942ccc55..f0fc364f6 --- a/src/gdbm/make.scm +++ b/src/gdbm/make.scm @@@ -6,4 -6,4 +6,4 @@@ (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)) diff --cc src/glib/glib-check-copy.sh index 3f1bff97d,000000000..0795cf449 mode 100755,000000..100755 --- a/src/glib/glib-check-copy.sh +++ b/src/glib/glib-check-copy.sh @@@ -1,42 -1,0 +1,41 @@@ +#!/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) - (load-option 'MD5) + (if (not (equal? (md5-file file1) (md5-file file2))) + (error "gio copy failed"))) + (assert-clean-ffi "gio copy") + ) +EOF diff --cc src/imail/imail.pkg index e17a810e3,96a16b634..a47b1aae4 --- a/src/imail/imail.pkg +++ b/src/imail/imail.pkg @@@ -26,11 -26,10 +26,10 @@@ USA ;;;; 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" diff --cc src/mhash/ChangeLog index fb8d47d6c,9a732ac7d..000000000 deleted file mode 100644,100644 --- a/src/mhash/ChangeLog +++ /dev/null @@@ -1,9 -1,7 +1,0 @@@ ---*-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 diff --cc src/mhash/Makefile.am index 94eb1925b,fc33e21d4..000000000 deleted file mode 100644,100644 --- a/src/mhash/Makefile.am +++ /dev/null @@@ -1,123 -1,122 +1,0 @@@ --## 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)" diff --cc src/mhash/README index 729f89bb6,ce97f35b8..000000000 deleted file mode 100644,100644 --- a/src/mhash/README +++ /dev/null @@@ -1,27 -1,28 +1,0 @@@ --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 -- ...)) diff --cc src/mhash/compile.scm index 816740ca9,816740ca9..000000000 deleted file mode 100644,100644 --- a/src/mhash/compile.scm +++ /dev/null @@@ -1,8 -1,8 +1,0 @@@ --#| -*-Scheme-*- |# -- --;;;; Compile the MHASH option. -- --(load-option 'CREF) --(load-option 'FFI) --(compile-file "mhash" '() (->environment '(RUNTIME))) --(cref/generate-constructors "mhash") diff --cc src/mhash/configure.ac index 3facf12ba,9f43b53ae..000000000 deleted file mode 100644,100644 --- a/src/mhash/configure.ac +++ /dev/null @@@ -1,169 -1,157 +1,0 @@@ --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 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 diff --cc src/mhash/make.scm index 241ffeb43,e0ab4b163..000000000 deleted file mode 100644,100644 --- a/src/mhash/make.scm +++ /dev/null @@@ -1,37 -1,9 +1,0 @@@ --#| -*-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)) diff --cc src/mhash/mhash-adapter.c index 095595e28,095595e28..000000000 deleted file mode 100644,100644 --- a/src/mhash/mhash-adapter.c +++ /dev/null @@@ -1,72 -1,72 +1,0 @@@ --/* -*-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)); --} diff --cc src/mhash/mhash-check.scm index fc73c6e61,fc73c6e61..000000000 deleted file mode 100644,100644 --- a/src/mhash/mhash-check.scm +++ /dev/null @@@ -1,37 -1,37 +1,0 @@@ --#| -*-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)))) diff --cc src/mhash/mhash-check.sh index fb7038977,fb7038977..000000000 deleted file mode 100755,100755 --- a/src/mhash/mhash-check.sh +++ /dev/null @@@ -1,9 -1,9 +1,0 @@@ --#!/bin/sh --# --# Test the MHASH option. -- --set -e --${MIT_SCHEME_EXE} --prepend-library . <<\EOF --(load-option 'MHASH) --(load "mhash-check" (->environment '(mhash))) --EOF diff --cc src/mhash/mhash-shim.h index 1201b07d5,1201b07d5..000000000 deleted file mode 100644,100644 --- a/src/mhash/mhash-shim.h +++ /dev/null @@@ -1,41 -1,41 +1,0 @@@ --/* -*-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 -- --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); diff --cc src/mhash/mhash.cdecl index 55381d11e,55381d11e..000000000 deleted file mode 100644,100644 --- a/src/mhash/mhash.cdecl +++ /dev/null @@@ -1,84 -1,84 +1,0 @@@ --#| -*-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. -- --(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)) diff --cc src/mhash/mhash.pkg index 34a96d587,617f7eb7c..000000000 deleted file mode 100644,100644 --- a/src/mhash/mhash.pkg +++ /dev/null @@@ -1,61 -1,60 +1,0 @@@ --#| -*-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. -- ) diff --cc src/mhash/mhash.scm index 626069f3c,c086ceb1f..000000000 deleted file mode 100644,100644 --- a/src/mhash/mhash.scm +++ /dev/null @@@ -1,503 -1,502 +1,0 @@@ --#| -*-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)) -- --(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)))) -- --(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)) -- --(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))))) -- --(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))))) -- --;;;; 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)))) diff --cc src/mhash/optiondb.scm index 61bacdc40,61bacdc40..000000000 deleted file mode 100644,100644 --- a/src/mhash/optiondb.scm +++ /dev/null @@@ -1,10 -1,10 +1,0 @@@ --#| -*-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))))))) diff --cc src/microcode/configure.ac index 1c7998b4c,feb26f8b5..8b822c0ed --- a/src/microcode/configure.ac +++ b/src/microcode/configure.ac @@@ -315,9 -347,22 +317,13 @@@ darwin* 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*) diff --cc src/runtime/blowfish.scm index e582f72ae,64aefb225..e592ff675 --- a/src/runtime/blowfish.scm +++ b/src/runtime/blowfish.scm @@@ -28,51 -28,97 +28,60 @@@ USA ;;; 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))) -(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!) diff --cc src/runtime/crypto.scm index 0143e0812,886007607..0f772c72f --- a/src/runtime/crypto.scm +++ b/src/runtime/crypto.scm @@@ -29,146 -29,245 +29,118 @@@ USA (declare (usual-integrations)) - ;;; 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))) - -;;;; 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)))))) - -(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))) - -(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)) - -;;;; 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))))) ++ ++;;;; 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!) diff --cc src/runtime/version.scm index 2dd38b7cc,04d1737e3..22b6ced8a --- a/src/runtime/version.scm +++ b/src/runtime/version.scm @@@ -39,10 -39,10 +39,10 @@@ USA (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"