From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 17 Jun 1997 04:59:30 +0000 (+0000)
Subject: Add code to compute MD5 checksum for a file; to convert a checksum to
X-Git-Tag: 20090517-FFI~5131
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=fa250ef8efb570550aa5d4c9437fd271b0882c02;p=mit-scheme.git

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 5ad9dd86c..1b2a53d06 100644
--- 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. |#
 
 (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