From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Sun, 8 Sep 2013 01:46:56 +0000 (-0700)
Subject: md5: A separately buildable FFI wrapper.
X-Git-Tag: release-9.2.0~121
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=3ade56605a9af7a58efdaa937894ddcc69fe9704;p=mit-scheme.git

md5: A separately buildable FFI wrapper.
---

diff --git a/src/md5/Makefile.in b/src/md5/Makefile.in
new file mode 100644
index 000000000..30009f989
--- /dev/null
+++ b/src/md5/Makefile.in
@@ -0,0 +1,67 @@
+# 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
+#     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.
+
+MIT_SCHEME_EXE = mit-scheme
+EXE = '$(MIT_SCHEME_EXE)' --batch-mode
+
+CFLAGS = @CFLAGS@
+CPPFLAGS = @CPPFLAGS@ -I. -I$(srcdir)
+LDFLAGS = @LDFLAGS@
+LIBS = @LIBS@
+
+all: md5-shim.so
+	echo '(load "compile")' | $(EXE)
+
+check: all
+	echo '(load "check")' | $(EXE)
+
+install: all
+	echo '(install-shim "md5")' | $(EXE) -- *.com *.bci *.pkd make.scm
+
+clean:
+	rm -f md5-const.scm md5-const md5-const.c md5-shim.c
+	rm -f md5-*.crf md5-*.fre md5-*.pkd
+	rm -f *.o *.so *.bin *.ext *.com *.bci
+	rm -f *.moc *.fni *-init.c *-init.h *-init.o
+	rm -f sample
+
+distclean: clean
+	rm -f Makefile config.h config.log config.status
+
+maintainer-clean: distclean
+	rm -f configure config.h.in
+	rm -rf autom4te.cache
+
+md5-shim.so: md5-shim.o md5-adapter.o
+	echo "(link-shim)" | $(EXE) -- $(LDFLAGS) -o $@ $^ $(LIBS)
+
+md5-adapter.o: md5-adapter.c md5-shim.h
+	echo '(compile-shim)' | $(EXE) -- $(CPPFLAGS) $(CFLAGS) -c $<
+
+md5-shim.o: md5-shim.c md5-shim.h
+	echo '(compile-shim)' | $(EXE) -- $(CPPFLAGS) $(CFLAGS) -c $<
+
+md5-shim.c: md5.cdecl md5-shim.h
+	echo '(generate-shim "md5" "#include \"md5-shim.h\"")' \
+	| $(EXE)
+
+.PHONY: all check install clean distclean maintainer-clean
diff --git a/src/md5/README b/src/md5/README
new file mode 100644
index 000000000..bbabe599d
--- /dev/null
+++ b/src/md5/README
@@ -0,0 +1,23 @@
+The md5 wrapper.
+
+This is a drop-in replacement for the md5 microcode module and the
+md5-* procedures in runtime/crypto.scm.  It is not part of the core
+build and can be built outside the core build tree in the customary
+way:
+
+    ./configure [--with-openssl=directory]...
+    make all check install
+
+The install target copies a shared library shim and compiled Scheme
+files into the system library path.  You can override the default
+command name "mit-scheme" (and thus the system library path) by
+setting MIT_SCHEME_EXE.
+
+To load via load-option, install the following in your optiondb.scm:
+
+    (define-load-option 'MD5
+      (guarded-system-loader '(md5) "md5"))
+
+You will need to import the bindings you want to use.  They are not
+exported to the global environment because they would conflict with
+the exports from (runtime crypto).
diff --git a/src/md5/check.scm b/src/md5/check.scm
new file mode 100644
index 000000000..09647192b
--- /dev/null
+++ b/src/md5/check.scm
@@ -0,0 +1,9 @@
+#| -*-Scheme-*- |#
+
+;;;; Test the MD5 wrapper.
+
+(load "make")
+(with-system-library-directories
+ '("./")
+ (lambda ()
+   (load "md5-check" (->environment '(md5)))))
\ No newline at end of file
diff --git a/src/md5/compile.scm b/src/md5/compile.scm
new file mode 100644
index 000000000..bae363634
--- /dev/null
+++ b/src/md5/compile.scm
@@ -0,0 +1,12 @@
+#| -*-Scheme-*- |#
+
+;;;; Compile the MD5 wrapper.
+
+(fluid-let ((load/suppress-loading-message? #t))
+  (load-option 'CREF)
+  (load-option 'FFI))
+
+(with-system-library-directories
+ '("./")
+ (lambda ()
+   (compile-system "md5" (directory-pathname (current-load-pathname)))))
\ No newline at end of file
diff --git a/src/md5/configure.ac b/src/md5/configure.ac
new file mode 100644
index 000000000..0f1b3c068
--- /dev/null
+++ b/src/md5/configure.ac
@@ -0,0 +1,87 @@
+dnl Process this file with autoconf to produce a configure script.
+
+AC_INIT([MIT/GNU Scheme md5 interface],
+        [0.1],
+        [bug-mit-scheme@gnu.org],
+        [mit-scheme-md5])
+AC_CONFIG_SRCDIR([md5.pkg])
+AC_CONFIG_HEADERS([config.h])
+
+AC_COPYRIGHT(
+[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 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) 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 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.
+
+*/])
+
+AC_ARG_WITH([openssl],
+    AS_HELP_STRING([--with-openssl],
+	[Use OpenSSL crypto library if available [[yes]]]))
+: ${with_openssl='yes'}
+
+dnl The OpenSSL crypto library provides support for md5.
+if test "${with_openssl}" != no; then
+    if test "${with_openssl}" != yes; then
+	CPPFLAGS="${CPPFLAGS} -I${with_openssl}/include"
+	LDFLAGS="${LDFLAGS} -L${with_openssl}/lib"
+    fi
+    FOUND=
+    AC_CHECK_HEADERS([openssl/md5.h md5.h],[FOUND=yes])
+    if test -n "${FOUND}"; then
+	AC_CHECK_LIB([crypto], [BF_set_key],
+	    [
+	    AC_DEFINE([HAVE_LIBCRYPTO], [1],
+		[Define to 1 if you have the `crypto' library (-lcrypto).])
+	    LIBS="-lcrypto"
+	    ])
+    fi
+fi
+
+AC_SUBST([LIBS])
+AC_SUBST([CPPFLAGS])
+AC_SUBST([LDFLAGS])
+AC_CONFIG_FILES([Makefile])
+AC_OUTPUT
diff --git a/src/md5/make.scm b/src/md5/make.scm
new file mode 100644
index 000000000..b84c650c3
--- /dev/null
+++ b/src/md5/make.scm
@@ -0,0 +1,9 @@
+#| -*-Scheme-*- |#
+
+;;;; Load the MD5 option.
+
+(with-working-directory-pathname (directory-pathname (current-load-pathname))
+  (lambda ()
+    (load-package-set "md5")))
+
+(add-subsystem-identification! "MD5" '(0 1))
\ No newline at end of file
diff --git a/src/md5/md5-adapter.c b/src/md5/md5-adapter.c
new file mode 100644
index 000000000..f2e2d2b65
--- /dev/null
+++ b/src/md5/md5-adapter.c
@@ -0,0 +1,61 @@
+/* -*-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 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 MD5 crypto-hash library. */
+
+#include "md5-shim.h"
+
+extern void
+do_MD5 (unsigned char * string, int length, unsigned char * result)
+{
+  MD5_CTX context;
+
+  MD5_INIT (&context);
+  MD5_UPDATE (&context, string, length);
+#ifdef HAVE_LIBCRYPTO
+  MD5_FINAL (result, &context);
+#else
+  MD5_FINAL (&context);
+  memcpy (result, context.digest, MD5_DIGEST_LENGTH);
+#endif
+}
+
+extern void
+do_MD5_UPDATE (MD5_CTX *context, unsigned char *string, int start, int end)
+{
+  MD5_UPDATE (context, string + start, end - start);
+}
+
+extern void
+do_MD5_FINAL (MD5_CTX *context, unsigned char *result)
+{
+#ifdef HAVE_LIBCRYPTO
+  MD5_FINAL (result, context);
+#else
+  MD5_FINAL (context);
+  memcpy (result, context->digest, MD5_DIGEST_LENGTH);
+#endif
+}
diff --git a/src/md5/md5-check.scm b/src/md5/md5-check.scm
new file mode 100644
index 000000000..6a732be17
--- /dev/null
+++ b/src/md5/md5-check.scm
@@ -0,0 +1,39 @@
+#| -*-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 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 MD5 wrapper.
+
+(if (not (md5-available?))
+    (warn "md5 wrapper not found")
+    (let ((sample "Some text to hash."))
+      (let ((hash (md5-sum->hexadecimal (md5-string 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 (md5-sum->hexadecimal (md5-file "sample"))))
+	(if (not (string=? hash "43eb9eccb88c329721925efc04843af1"))
+	    (error "Bad hash for sample file:" hash)))))
\ No newline at end of file
diff --git a/src/md5/md5-shim.h b/src/md5/md5-shim.h
new file mode 100644
index 000000000..7b52d522c
--- /dev/null
+++ b/src/md5/md5-shim.h
@@ -0,0 +1,53 @@
+/* -*-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 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 MD5 crypto-hash library. */
+
+#include "config.h"
+
+#if defined(HAVE_LIBCRYPTO) && defined(HAVE_OPENSSL_MD5_H)
+#  include <openssl/md5.h>
+#else
+#  ifdef HAVE_MD5_H
+#    include <md5.h>
+#  endif
+#endif
+
+#ifdef HAVE_LIBCRYPTO
+#  define MD5_INIT MD5_Init
+#  define MD5_UPDATE MD5_Update
+#  define MD5_FINAL MD5_Final
+#else
+#  define MD5_INIT MD5Init
+#  define MD5_UPDATE MD5Update
+#  define MD5_FINAL MD5Final
+#  define MD5_DIGEST_LENGTH 16
+#endif
+
+extern void do_MD5 (unsigned char * string, int length, unsigned char * result);
+extern void do_MD5_UPDATE (MD5_CTX *context,
+			   unsigned char *string, int start, int end);
+extern void do_MD5_FINAL (MD5_CTX *context, unsigned char *result);
diff --git a/src/md5/md5.cdecl b/src/md5/md5.cdecl
new file mode 100644
index 000000000..025b40224
--- /dev/null
+++ b/src/md5/md5.cdecl
@@ -0,0 +1,52 @@
+#| -*-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 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 md5-shim.so.
+
+(enum (MD5_DIGEST_LENGTH))
+
+(typedef MD5_CTX
+	 (struct MD5state_st
+		 ;; mumble
+		 (num uint)))
+
+(extern int MD5_INIT
+	(c (* MD5_CTX)))
+
+(extern void do_MD5
+	(string (* uchar))
+	(length int)
+	(result (* uchar)))
+
+(extern void do_MD5_UPDATE
+	(context (* MD5_CTX))
+	(string (* uchar))
+	(start int)
+	(end int))
+
+(extern void do_MD5_FINAL
+	(context (* MD5_CTX))
+	(result (* uchar)))
\ No newline at end of file
diff --git a/src/md5/md5.pkg b/src/md5/md5.pkg
new file mode 100644
index 000000000..c11e1a6ee
--- /dev/null
+++ b/src/md5/md5.pkg
@@ -0,0 +1,40 @@
+#| -*-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 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 (md5)
+  (files "md5")
+  (parent ())
+  ;; You'll have to import these from (gdbm), after a (global-
+  ;; definitions gdbm/) declaration(?).
+  #;(export #f
+	  md5-available?
+	  md5-file
+	  md5-string
+	  md5-substring
+	  md5-sum->hexadecimal
+	  md5-sum->number))
\ No newline at end of file
diff --git a/src/md5/md5.scm b/src/md5/md5.scm
new file mode 100644
index 000000000..8beaa880a
--- /dev/null
+++ b/src/md5/md5.scm
@@ -0,0 +1,142 @@
+#| -*-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 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.
+
+|#
+
+;;;; MD5 wrapper
+;;; package: (md5)
+
+(declare (usual-integrations))
+
+(C-include "md5")
+
+(define-integrable (mhash-available?) #f)
+
+(define (%md5-init)
+  ;; Create and return an MD5 digest context.
+  (let ((context (make-string (C-sizeof "MD5_CTX"))))
+    (C-call "MD5_INIT" context)
+    context))
+
+(define (%md5-update context string start end)
+  ;; Update CONTEXT with the contents of the substring (STRING,START,END).
+  (guarantee-md5-context context '%MD5-UPDATE)
+  (guarantee-substring string start end '%MD5-UPDATE)
+  (C-call "do_MD5_UPDATE" context string start end))
+
+(define (%md5-final context)
+  ;; Finalize CONTEXT and return the digest as a 16-byte string.
+  (guarantee-md5-context context '%MD5-FINAL)
+  (let ((result (make-string (C-enum "MD5_DIGEST_LENGTH"))))
+    (C-call "do_MD5_FINAL" context result)
+    result))
+
+(define (guarantee-md5-context object operator)
+  (if (and (string? object)
+	   (= (string-length object) (C-sizeof "MD5_CTX")))
+      object
+      (error:bad-range-argument object
+				"an MD5 context"
+				operator)))
+
+(define (%md5 string)
+  ;; Generate an MD5 digest of string.
+  ;; The digest is returned as a 16-byte string.
+  (guarantee-string string '%MD5)
+  (let ((length (string-length string))
+	(result (make-string (C-enum "MD5_DIGEST_LENGTH"))))
+    (C-call "do_MD5" string length result)
+    result))
+
+(define (md5-available?)
+  (or (mhash-available?)
+      (%md5-available?)))
+
+(define (%md5-available?)
+  (let ((path (ignore-errors (lambda ()
+			       (system-library-pathname "md5-shim.so")))))
+    (and (pathname? path)
+	 (file-loadable? path))))
+
+(define (md5-file filename)
+  (cond ((mhash-available?)
+	 (mhash-file 'MD5 filename))
+	((%md5-available?)
+	 (%md5-file filename))
+	(else
+	 (error "This Scheme system was built without MD5 support."))))
+
+(define (%md5-file filename)
+  (call-with-binary-input-file filename
+    (lambda (port)
+      (let ((buffer (make-string 4096))
+	    (context (%md5-init)))
+	(dynamic-wind (lambda ()
+			unspecific)
+		      (lambda ()
+			(let loop ()
+			  (let ((n (read-substring! buffer 0 4096 port)))
+			    (if (fix:= 0 n)
+				(%md5-final context)
+				(begin
+				  (%md5-update context buffer 0 n)
+				  (loop))))))
+		      (lambda ()
+			(string-fill! buffer #\NUL)))))))
+
+(define (md5-string string)
+  (md5-substring string 0 (string-length string)))
+
+(define (md5-substring string start end)
+  (cond ((mhash-available?)
+	 (mhash-substring 'MD5 string start end))
+	((%md5-available?)
+	 (%md5-substring string start end))
+	(else
+	 (error "This Scheme system was built without MD5 support."))))
+
+(define (%md5-substring string start end)
+  (let ((context (%md5-init)))
+    (%md5-update context string start end)
+    (%md5-final context)))
+
+(define (md5-sum->number sum)
+  (let ((l (string-length sum)))
+    (do ((i 0 (fix:+ i 1))
+	 (n 0 (+ (* n #x100) (vector-8b-ref sum i))))
+	((fix:= i l) n))))
+
+(define (md5-sum->hexadecimal sum)
+  (let ((n (string-length sum))
+	(digits "0123456789abcdef"))
+    (let ((s (make-string (fix:* 2 n))))
+      (do ((i 0 (fix:+ i 1)))
+	  ((fix:= i n))
+	(string-set! s (fix:* 2 i)
+		     (string-ref digits
+				 (fix:lsh (vector-8b-ref sum i) -4)))
+	(string-set! s (fix:+ (fix:* 2 i) 1)
+		     (string-ref digits
+				 (fix:and (vector-8b-ref sum i) #x0F))))
+      s)))
\ No newline at end of file