From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Fri, 6 Sep 2013 23:52:14 +0000 (-0700)
Subject: blowfish: A separately buildable FFI wrapper.
X-Git-Tag: release-9.2.0~129
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=900f4a852e6a4e9180e59051d617f3a01bc74457;p=mit-scheme.git

blowfish: A separately buildable FFI wrapper.
---

diff --git a/src/blowfish/Makefile.in b/src/blowfish/Makefile.in
new file mode 100644
index 000000000..b618b7325
--- /dev/null
+++ b/src/blowfish/Makefile.in
@@ -0,0 +1,68 @@
+# 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: blowfish-shim.so
+	echo '(load "compile")' | $(EXE)
+
+check: all
+	echo '(load "check")' | $(EXE)
+
+install: all
+	echo '(install-shim "blowfish")' | $(EXE) -- *.com *.bci *.pkd make.scm
+
+clean:
+	rm -f blowfish-const.scm blowfish-const blowfish-const.c
+	rm -f blowfish-shim.c
+	rm -f blowfish-*.crf blowfish-*.fre blowfish-*.pkd
+	rm -f *.o *.so *.bin *.ext *.com *.bci
+	rm -f *.moc *.fni *-init.c *-init.h *-init.o
+	rm -f test
+
+distclean: clean
+	rm -f Makefile config.h config.log config.status
+
+maintainer-clean: distclean
+	rm -f configure
+	rm -rf autom4te.cache
+
+blowfish-shim.so: blowfish-shim.o blowfish-adapter.o
+	echo "(link-shim)" | $(EXE) -- $(LDFLAGS) -o $@ $^ $(LIBS)
+
+blowfish-adapter.o: blowfish-adapter.c blowfish-shim.h
+	echo '(compile-shim)' | $(EXE) -- $(CPPFLAGS) $(CFLAGS) -c $<
+
+blowfish-shim.o: blowfish-shim.c blowfish-shim.h
+	echo '(compile-shim)' | $(EXE) -- $(CPPFLAGS) $(CFLAGS) -c $<
+
+blowfish-shim.c: blowfish.cdecl blowfish-shim.h
+	echo '(generate-shim "blowfish" "#include \"blowfish-shim.h\"")' \
+	| $(EXE)
+
+.PHONY: all check install clean distclean maintainer-clean
diff --git a/src/blowfish/README b/src/blowfish/README
new file mode 100644
index 000000000..f535d29e5
--- /dev/null
+++ b/src/blowfish/README
@@ -0,0 +1,22 @@
+The blowfish wrapper.
+
+This is a drop-in replacement for the bfish microcode module and
+runtime/blowfish.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 'BLOWFISH
+      (guarded-system-loader '(blowfish) "blowfish"))
+
+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 blowfish).
diff --git a/src/blowfish/blowfish-adapter.c b/src/blowfish/blowfish-adapter.c
new file mode 100644
index 000000000..fece888fe
--- /dev/null
+++ b/src/blowfish/blowfish-adapter.c
@@ -0,0 +1,59 @@
+/* -*-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 Blowfish encryption library. */
+#include "blowfish-shim.h"
+
+int
+do_BF_cfb64_encrypt (const unsigned char *in,
+		     long istart,
+		     unsigned char *out,
+		     long ostart,
+		     long length,
+		     const BF_KEY *schedule,
+		     unsigned char *ivec,
+		     int num,
+		     int enc)
+{
+  BF_cfb64_encrypt(&in[istart], &out[ostart], length,
+		   schedule, ivec, &num, enc);
+  return (num);
+}
+
+extern int
+do_BF_ofb64_encrypt (const unsigned char *in,
+		     long istart,
+		     unsigned char *out,
+		     long ostart,
+		     long length,
+		     const BF_KEY *schedule,
+		     unsigned char *ivec,
+		     int num)
+{
+  BF_ofb64_encrypt(&in[istart], &out[ostart], length,
+		   schedule, ivec, &num);
+  return (num);
+}
diff --git a/src/blowfish/blowfish-check.scm b/src/blowfish/blowfish-check.scm
new file mode 100644
index 000000000..065b68dd5
--- /dev/null
+++ b/src/blowfish/blowfish-check.scm
@@ -0,0 +1,48 @@
+#| -*-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 Blowfish wrapper.
+
+(if (not (blowfish-available?))
+    (warn "blowfish wrapper not found")
+    (let ((sample "Some text to encrypt and decrypt."))
+      (call-with-binary-output-file "test"
+	(lambda (output)
+	  (call-with-input-string sample
+	    (lambda (input)
+	      (blowfish-encrypt-port input output "secret"
+				     (write-blowfish-file-header output)
+				     #t)))))
+      (let ((read-back
+	     (call-with-binary-input-file "test"
+	       (lambda (input)
+		 (call-with-output-string
+		  (lambda (output)
+		    (blowfish-encrypt-port input output "secret"
+					   (read-blowfish-file-header input)
+					   #f)))))))
+	(if (not (string=? sample read-back))
+	    (error "sample did not decrypt correctly")))))
\ No newline at end of file
diff --git a/src/blowfish/blowfish-shim.h b/src/blowfish/blowfish-shim.h
new file mode 100644
index 000000000..a8fa5d2f1
--- /dev/null
+++ b/src/blowfish/blowfish-shim.h
@@ -0,0 +1,58 @@
+/* -*-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 Blowfish encryption library */
+
+#include "config.h"
+
+#if defined(HAVE_OPENSSL_BLOWFISH_H)
+#  include <openssl/blowfish.h>
+#else
+#  ifdef HAVE_BLOWFISH_H
+#    include <blowfish.h>
+#  endif
+#endif
+
+int
+do_BF_cfb64_encrypt (const unsigned char *in,
+		     long istart,
+		     unsigned char *out,
+		     long ostart,
+		     long length,
+		     const BF_KEY *schedule,
+		     unsigned char *ivec,
+		     int num,
+		     int enc);
+
+extern int
+do_BF_ofb64_encrypt (const unsigned char *in,
+		     long istart,
+		     unsigned char *out,
+		     long ostart,
+		     long length,
+		     const BF_KEY *schedule,
+		     unsigned char *ivec,
+		     int num);
diff --git a/src/blowfish/blowfish.cdecl b/src/blowfish/blowfish.cdecl
new file mode 100644
index 000000000..b031ce31a
--- /dev/null
+++ b/src/blowfish/blowfish.cdecl
@@ -0,0 +1,85 @@
+#| -*-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 blowfish-shim.so.
+
+(enum (BF_ENCRYPT)
+      (BF_DECRYPT))
+
+(struct bf_key_st (P (array mumble)))
+
+(typedef BF_KEY
+	 (struct bf_key_st))
+
+(extern void BF_set_key
+	(key (* BF_KEY))
+	(len int)
+	(data (* (const uchar))))
+
+(extern void BF_ecb_encrypt
+	(in (* (const uchar)))
+	(out (* uchar))
+	(key (* BF_KEY))
+	(enc int))
+
+(extern void BF_cbc_encrypt
+	(in (* (const uchar)))
+	(out (* uchar))
+	(length long)
+	(schedule (* BF_KEY))
+	(ivec (* uchar))
+	(enc int))
+
+(extern int do_BF_cfb64_encrypt
+	(in (* (const uchar)))
+	(istart long)
+	(out (* uchar))
+	(ostart long)
+	(length long)
+	(schedule (* BF_KEY))
+	(ivec (* uchar))
+	(num int)
+	(enc int))
+
+(extern int do_BF_ofb64_encrypt
+	(in (* (const uchar)))
+	(istart long)
+	(out (* uchar))
+	(ostart long)
+	(length long)
+	(schedule (* BF_KEY))
+	(ivec (* uchar))
+	(num (* int)))
+
+(extern (* (const char)) BF_options)
+
+(extern void BF_encrypt
+	(data (* BF_LONG))
+	(key (* (const BF_KEY))))
+
+(extern void BF_decrypt
+	(data (* BF_LONG))
+	(key (* (const BF_KEY))))
\ No newline at end of file
diff --git a/src/blowfish/blowfish.pkg b/src/blowfish/blowfish.pkg
new file mode 100644
index 000000000..f256630a9
--- /dev/null
+++ b/src/blowfish/blowfish.pkg
@@ -0,0 +1,45 @@
+#| -*-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 (blowfish)
+  (files "blowfish")
+  (parent ())
+  ;; You'll have to import these from (gdbm), after a (global-
+  ;; definitions gdbm/) declaration(?).
+  #;(export #f
+	  blowfish-available?
+	  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))
\ No newline at end of file
diff --git a/src/blowfish/blowfish.scm b/src/blowfish/blowfish.scm
new file mode 100644
index 000000000..64e6fa437
--- /dev/null
+++ b/src/blowfish/blowfish.scm
@@ -0,0 +1,254 @@
+#| -*-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.
+
+|#
+
+;;;; Blowfish wrapper
+;;; package: (blowfish)
+
+(declare (usual-integrations))
+
+(C-include "blowfish")
+
+(define (blowfish-set-key string)
+  ;; Generate a Blowfish key from STRING.
+  ;; STRING must be 72 bytes or less in length.
+  ;; For text-string keys, use MD5 on the text, and pass the digest here.
+  (guarantee-string string 'blowfish-set-key)
+  (let ((length (string-length string)))
+    (if (> length 72)
+	(error:bad-range-argument string
+				  "a string of no more than 72 characters"
+				  'blowfish-set-key))
+    (let ((result (make-string (C-sizeof "BF_KEY"))))
+      (C-call "BF_set_key" result length string)
+      result)))
+
+(define (blowfish-ecb input output key encrypt?)
+  ;; Apply Blowfish in Electronic Code Book mode.
+  ;; INPUT is an 8-byte string.
+  ;; OUTPUT is an 8-byte string.
+  ;; KEY is a Blowfish key.
+  ;; ENCRYPT? says whether to encrypt (non-#F) or decrypt (#F).
+  (guarantee-bfkey key 'BLOWFISH-ECB)
+  (guarantee-8char-arg input 'BLOWFISH-ECB)
+  (guarantee-8char-arg output 'BLOWFISH-ECB)
+  (C-call "BF_ecb_encrypt" input output key (bf-de/encrypt encrypt?)))
+
+(define (blowfish-cbc input output key init-vector encrypt?)
+  ;; Apply Blowfish in Cipher Block Chaining mode.
+  ;; INPUT is a string whose length is a multiple of 8 bytes.
+  ;; OUTPUT is a string whose length is the same as INPUT.
+  ;; KEY is a Blowfish key.
+  ;; INIT-VECTOR is an 8-byte string; it is modified after each call.
+  ;; The value from any call may be passed in to a later call.
+  ;; ENCRYPT? says whether to encrypt (non-#F) or decrypt (#F).
+  (guarantee-init-vector init-vector 'BLOWFISH-CBC)
+  (guarantee-bfkey key 'BLOWFISH-CBC)
+  (guarantee-8Xchar-arg input 'BLOWFISH-CBC)
+  (if (or (eq? input output)
+	  (not (= (string-length output) (string-length input))))
+      (error:bad-range-argument output
+				"a string as long as the input string"
+				'BLOWFISH-CBC))
+  (C-call "BF_cbc_encrypt" input output (string-length input)
+	  key init-vector (bf-de/encrypt encrypt?)))
+
+(define (blowfish-cfb64 input istart iend output ostart
+			key init-vector num encrypt?)
+  ;; Apply Blowfish in Cipher Feed-Back mode.
+  ;; (INPUT,ISTART,IEND) is an arbitrary substring.
+  ;; OUTPUT is a string as large as the input substring.
+  ;; OSTART says where to start writing to the output string.
+  ;; KEY is a Blowfish key.
+  ;; INIT-VECTOR is an 8-byte string; it is modified after each call.
+  ;; The value from any call may be passed in to a later call.
+  ;; The initial value must be unique for each message/key pair.
+  ;; NUM is a digit from 0 to 7 inclusive; it is the low 3 bits of the
+  ;; number of bytes that have previously been processed in this stream.
+  ;; ENCRYPT? says whether to encrypt (non-#F) or decrypt (#F). 
+  ;; Returned value is the new value of NUM.
+  (guarantee-bfkey key 'BLOWFISH-CFB64)
+  (guarantee-init-vector init-vector 'BLOWFISH-CFB64)
+  (guarantee-substring-indices input istart iend 'BLOWFISH-CFB64)
+  (guarantee-substring-indices output ostart (+ ostart (- iend istart))
+			       'BLOWFISH-CFB64)
+  (guarantee-init-index num 'BLOWFISH-CFB64)
+  (let ((ilen (- iend istart)))
+    (if (and (eq? input output)
+	     (< ostart iend)
+	     (< istart (+ ostart ilen)))
+	(error:bad-range-argument
+	 ostart
+	 "an index of a substring not overlapping the input substring"
+	 'BLOWFISH-CFB64))
+    (C-call "do_BF_cfb64_encrypt" input istart output ostart ilen
+	    key init-vector num (bf-de/encrypt encrypt?))))
+
+(define (blowfish-ofb64 input istart iend output ostart
+			key init-vector num)
+  ;; Apply Blowfish in Output Feed-Back mode.
+  ;; (INPUT,ISTART,IEND) is an arbitrary substring.
+  ;; OUTPUT is a string as large as the input substring.
+  ;; OSTART says where to start writing to the output string.
+  ;; KEY is a Blowfish key.
+  ;; INIT-VECTOR is an 8-byte string; it is modified after each call.
+  ;;   The value from any call may be passed in to a later call.
+  ;;   The initial value must be unique for each message/key pair.
+  ;; NUM is a digit from 0 to 7 inclusive; it is the low 3 bits of the
+  ;;   number of bytes that have previously been processed in this stream.
+  ;; Returned value is the new value of NUM.
+  (guarantee-bfkey key 'BLOWFISH-OFB64)
+  (guarantee-init-vector init-vector 'BLOWFISH-OFB64)
+  (guarantee-substring-indices input istart iend 'BLOWFISH-OFB64)
+  (guarantee-substring-indices output ostart (+ ostart (- iend istart))
+			       'BLOWFISH-OFB64)
+  (guarantee-init-index num 'BLOWFISH-OFB64)
+  (let ((ilen (- iend istart)))
+    (if (and (eq? input output)
+	     (< ostart iend)
+	     (< istart (+ ostart ilen)))
+	(error:bad-range-argument
+	 ostart
+	 "an index of a substring not overlapping the input substring"
+	 'BLOWFISH-OFB64))
+    (C-call "do_BF_ofb64_encrypt" input istart output ostart ilen
+	    key init-vector num)))
+
+(define (bf-de/encrypt encrypt?)
+  (if encrypt? (C-enum "BF_ENCRYPT") (C-enum "BF_DECRYPT")))
+
+(define (guarantee-8char-arg arg operator)
+  (guarantee-string arg operator)
+  (if (not (= 8 (string-length arg)))
+      (error:bad-range-argument arg
+				"an 8 character string"
+				operator)))
+
+(define (guarantee-8Xchar-arg arg operator)
+  (guarantee-string arg operator)
+  (if (not (= 0 (modulo (string-length arg) 8)))
+      (error:bad-range-argument arg
+				"a multiple of 8 characters string"
+				operator)))
+
+(define (guarantee-substring-indices string start end operator)
+  (guarantee-string string operator)
+  (guarantee-fixnum start operator)
+  (guarantee-fixnum end operator)
+  (if (not (fix:<= 0 start))
+      (error:bad-range-argument start "a string index" operator))
+  (if (not (and (fix:<= start end)
+		(fix:<= end (string-length string))))
+      (error:bad-range-argument end "a string index" operator)))
+
+(define (guarantee-bfkey object operator)
+  (if (not (and (string? object)
+		(fix:= (C-sizeof "BF_KEY")
+		       (string-length object))))
+      (error:bad-range-argument object "a blowfish key" operator)))
+
+(define (guarantee-init-vector object operator)
+  (guarantee-string object operator)
+  (if (not (= 8 (string-length object)))
+      (error:bad-range-argument object
+				"a blowfish init vector"
+				operator)))
+
+(define (guarantee-init-index object operator)
+  (guarantee-fixnum object 'operator)
+  (if (not (and (fix:<= 0 object) (fix:< object 8)))
+      (error:bad-range-argument object
+				"a blowfish init-vector index"
+				operator)))
+
+(define (blowfish-available?)
+  (let ((path (ignore-errors (lambda ()
+			       (system-library-pathname "blowfish-shim.so")))))
+    (and (pathname? path)
+	 (file-loadable? path))))
+
+(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-string 4096))
+	(output-buffer (make-string 4096)))
+    (dynamic-wind
+     (lambda ()
+       unspecific)
+     (lambda ()
+       (let loop ((m 0))
+	 (let ((n (input-port/read-string! input input-buffer)))
+	   (if (not (fix:= 0 n))
+	       (let ((m
+		      (blowfish-cfb64 input-buffer 0 n output-buffer 0
+				      key init-vector m encrypt?)))
+		 (write-substring output-buffer 0 n output)
+		 (loop m))))))
+     (lambda ()
+       (string-fill! input-buffer #\NUL)
+       (string-fill! output-buffer #\NUL)))))
+
+(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-string 8)))
+    (do ((i 0 (fix:+ i 1))
+	 (t (+ (* (+ (* (get-universal-time) 1000)
+		     (remainder (real-time-clock) 1000))
+		  #x100000)
+	       (random #x100000))
+	    (quotient t #x100)))
+	((fix:= 8 i))
+      (vector-8b-set! iv i (remainder t #x100)))
+    iv))
+
+(define (write-blowfish-file-header port)
+  (write-string blowfish-file-header-v2 port)
+  (newline port)
+  (let ((init-vector (compute-blowfish-init-vector)))
+    (write-string init-vector port)
+    init-vector))
+
+(define (read-blowfish-file-header port)
+  (let ((line (read-line port)))
+    (cond ((string=? blowfish-file-header-v1 line)
+	   (make-string 8 #\NUL))
+	  ((string=? blowfish-file-header-v2 line)
+	   (let ((init-vector (make-string 8)))
+	     (if (not (= 8 (read-substring! init-vector 0 8 port)))
+		 (error "Short read while getting init-vector:" port))
+	     init-vector))
+	  (else
+	   (error:bad-range-argument port 'READ-BLOWFISH-FILE-HEADER)))))
+
+(define (blowfish-file? pathname)
+  (let ((line (call-with-binary-input-file pathname read-line)))
+    (and (not (eof-object? line))
+	 (or (string=? line blowfish-file-header-v1)
+	     (string=? line blowfish-file-header-v2)))))
+
+(define blowfish-file-header-v1 "Blowfish, 16 rounds")
+(define blowfish-file-header-v2 "Blowfish, 16 rounds, version 2")
\ No newline at end of file
diff --git a/src/blowfish/check.scm b/src/blowfish/check.scm
new file mode 100644
index 000000000..36ce18590
--- /dev/null
+++ b/src/blowfish/check.scm
@@ -0,0 +1,9 @@
+#| -*-Scheme-*- |#
+
+;;;; Test the Blowfish wrapper.
+
+(load "make")
+(with-system-library-directories
+ '("./")
+ (lambda ()
+   (load "blowfish-check" (->environment '(blowfish)))))
\ No newline at end of file
diff --git a/src/blowfish/compile.scm b/src/blowfish/compile.scm
new file mode 100644
index 000000000..7f6406d5f
--- /dev/null
+++ b/src/blowfish/compile.scm
@@ -0,0 +1,12 @@
+#| -*-Scheme-*- |#
+
+;;;; Compile the Blowfish wrapper.
+
+(fluid-let ((load/suppress-loading-message? #t))
+  (load-option 'CREF)
+  (load-option 'FFI))
+
+(with-system-library-directories
+ '("./")
+ (lambda ()
+   (compile-system "blowfish" (directory-pathname (current-load-pathname)))))
\ No newline at end of file
diff --git a/src/blowfish/configure.ac b/src/blowfish/configure.ac
new file mode 100644
index 000000000..440a3a628
--- /dev/null
+++ b/src/blowfish/configure.ac
@@ -0,0 +1,87 @@
+dnl Process this file with autoconf to produce a configure script.
+
+AC_INIT([MIT/GNU Scheme blowfish interface],
+        [0.1],
+        [bug-mit-scheme@gnu.org],
+        [mit-scheme-blowfish])
+AC_CONFIG_SRCDIR([blowfish.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 blowfish.
+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/blowfish.h blowfish.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/blowfish/make.scm b/src/blowfish/make.scm
new file mode 100644
index 000000000..1abe46fb0
--- /dev/null
+++ b/src/blowfish/make.scm
@@ -0,0 +1,9 @@
+#| -*-Scheme-*- |#
+
+;;;; Load the BLOWFISH option.
+
+(with-working-directory-pathname (directory-pathname (current-load-pathname))
+  (lambda ()
+    (load-package-set "blowfish")))
+
+(add-subsystem-identification! "Blowfish2" '(0 1))
\ No newline at end of file