Add code to compute MD5 checksum for a file; to convert a checksum to

either a number or a hex string; and to encrypt a substring.

diff --git a/v7/src/runtime/blowfish.scm b/v7/src/runtime/blowfish.scm
index 5ad9dd86c2fd45b6c2964a5de9060e4870e13702..1b2a53d06a86f4011511b38b6764b100cff8275e 100644 (file)
--- a/v7/src/runtime/blowfish.scm
+++ b/v7/src/runtime/blowfish.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: blowfish.scm,v 1.2 1997/06/09 08:08:00 cph Exp $
+$Id: blowfish.scm,v 1.3 1997/06/17 04:59:30 cph Exp $
 
 Copyright (c) 1997 Massachusetts Institute of Technology
 
@@ -39,39 +39,43 @@ MIT in each case. |#
 \f
 (define-primitives
   (md5 1)
+  (md5-init 0)
+  (md5-update 4)
+  (md5-final 1)
   (blowfish-set-key 1)
   (blowfish-cbc 4)
-  (blowfish-cfb64 5))
+  (blowfish-cfb64 5)
+  (blowfish-cfb64-substring 7))
 
 (define (blowfish-available?)
-  (and (implemented-primitive-procedure? md5)
-       (implemented-primitive-procedure? blowfish-set-key)))
+  (and (implemented-primitive-procedure? md5-init)
+       (implemented-primitive-procedure? blowfish-cfb64-substring)))
 
 (define (blowfish-encrypt-string plaintext key-string encrypt?)
-  (blowfish-cfb64 plaintext
-                 (blowfish-set-key (md5 key-string))
-                 (make-string 8 #\NUL)
-                 0
-                 encrypt?))
+  (blowfish-encrypt-substring plaintext 0 (string-length plaintext)
+                             key-string encrypt?))
+
+(define (blowfish-encrypt-substring plaintext start end key-string encrypt?)
+  (blowfish-cfb64-substring plaintext start end
+                           (blowfish-set-key (md5 key-string))
+                           (make-string 8 #\NUL)
+                           0
+                           encrypt?))
 
 (define (blowfish-encrypt-port input output key-string encrypt?)
   ;; Assumes that INPUT is in blocking mode.
   (let ((key (blowfish-set-key (md5 key-string)))
-       (buffer (make-string 512))
+       (buffer (make-string 4096))
        (init-vector (make-string 8 #\NUL)))
     (let loop ((m 0))
       (let ((n (input-port/read-string! input buffer)))
        (if (not (fix:= 0 n))
            (begin
-             (write-string (blowfish-cfb64 (if (fix:= 512 n)
-                                               buffer
-                                               (string-head buffer n))
-                                           key
-                                           init-vector
-                                           m
-                                           encrypt?)
+             (write-string (blowfish-cfb64-substring buffer 0 n
+                                                     key init-vector m
+                                                     encrypt?)
                            output)
-             (loop (fix:and #x7 (fix:+ m (fix:and #x7 n))))))))))
+             (loop (fix:and #x7 (fix:+ m n)))))))))
 
 (define (write-blowfish-file-header port)
   (write-string blowfish-file-header port)
@@ -82,4 +86,31 @@ MIT in each case. |#
       (error "Not a Blowfish file:" port)))
 
 (define blowfish-file-header
-  "Blowfish, 16 rounds")
\ No newline at end of file
+  "Blowfish, 16 rounds")
+
+(define (md5-file filename)
+  (call-with-binary-input-file filename
+    (lambda (port)
+      (let ((buffer (make-string 4096))
+           (context (md5-init)))
+       (let loop ()
+         (let ((n (read-string! buffer 0 4096 port)))
+           (if (fix:= 0 n)
+               (md5-final context)
+               (begin
+                 (md5-update context buffer 0 n)
+                 (loop)))))))))
+
+(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 ((s (number->string (md5-sum->number sum) 16)))
+    (string-downcase! s)
+    (let ((d (fix:- 32 (string-length s))))
+    (if (fix:> d 0)
+       (string-append (make-string d #\0) s)
+       s))))
\ No newline at end of file