--- /dev/null
+# 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
--- /dev/null
+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).
--- /dev/null
+#| -*-Scheme-*- |#
+
+;;;; Test the MD5 wrapper.
+
+(load "make")
+(with-system-library-directories
+ '("./")
+ (lambda ()
+ (load "md5-check" (->environment '(md5)))))
\ No newline at end of file
--- /dev/null
+#| -*-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
--- /dev/null
+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
--- /dev/null
+#| -*-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
--- /dev/null
+/* -*-C-*-
+
+Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
+ 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+ 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 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
+}
--- /dev/null
+#| -*-Scheme-*-
+
+Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
+ 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+ 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 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
--- /dev/null
+/* -*-C-*-
+
+Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
+ 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+ 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 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);
--- /dev/null
+#| -*-Scheme-*-
+
+Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
+ 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+ 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 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.
+\f
+(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
--- /dev/null
+#| -*-Scheme-*-
+
+Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
+ 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+ 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 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
--- /dev/null
+#| -*-Scheme-*-
+
+Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
+ 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+ 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 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))
+\f
+(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
projects / mit-scheme.git / commitdiff