From b56c6724c295f00396d65bd13250c37e8c553c7d Mon Sep 17 00:00:00 2001
From: Matt Birkholz <matt@birchwood-abbey.net>
Date: Fri, 24 Feb 2017 11:42:52 -0700
Subject: [PATCH] md5: Use bytevectors instead of strings.

---
 src/md5/md5-check.scm |  4 +--
 src/md5/md5.scm       | 71 ++++++++++++-------------------------------
 2 files changed, 22 insertions(+), 53 deletions(-)

diff --git a/src/md5/md5-check.scm b/src/md5/md5-check.scm
index 181740b9f..73c611df9 100644
--- a/src/md5/md5-check.scm
+++ b/src/md5/md5-check.scm
@@ -28,10 +28,10 @@ USA.
 
 (let ((sample "Some text to hash."))
   (let ((hash (md5-sum->hexadecimal (md5-string sample))))
-    (if (not (string=? hash "c8e89c4cbf3abf9aa758d691cbe4b784"))
+    (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"))
+    (if (not (string=? hash "43EB9ECCB88C329721925EFC04843AF1"))
 	(error "Bad hash for sample file:" hash))))
\ No newline at end of file
diff --git a/src/md5/md5.scm b/src/md5/md5.scm
index ee04babe2..e4a4ff6e3 100644
--- a/src/md5/md5.scm
+++ b/src/md5/md5.scm
@@ -31,84 +31,53 @@ USA.
 
 (C-include "md5")
 
-(define (%md5-init)
-  ;; Create and return an MD5 digest context.
-  (let ((context (make-legacy-string (C-sizeof "MD5_CTX"))))
+(define-integrable (%md5-init)
+  (let ((context (make-bytevector (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-integrable (%md5-update context bytevector start end)
+  (C-call "do_MD5_UPDATE" context bytevector 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-legacy-string (C-enum "MD5_DIGEST_LENGTH"))))
+(define-integrable (%md5-final context)
+  (let ((result (make-bytevector (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-legacy-string (C-enum "MD5_DIGEST_LENGTH"))))
-    (C-call "do_MD5" string length result)
-    result))
-
 (define (md5-file filename)
-  (call-with-legacy-binary-input-file filename
+  (call-with-binary-input-file filename
     (lambda (port)
-      (let ((buffer (make-legacy-string 4096))
+      (let ((buffer (make-bytevector 4096))
 	    (context (%md5-init)))
 	(dynamic-wind (lambda ()
 			unspecific)
 		      (lambda ()
 			(let loop ()
-			  (let ((n (read-string! buffer port)))
-			    (if (fix:= 0 n)
+			  (let ((n (read-bytevector! buffer port)))
+			    (if (or (eof-object? n)
+				    (fix:= 0 n))
 				(%md5-final context)
 				(begin
 				  (%md5-update context buffer 0 n)
 				  (loop))))))
 		      (lambda ()
-			(string-fill! buffer #\NUL)))))))
+			(bytevector-fill! buffer 0)))))))
 
 (define (md5-string string)
-  (md5-substring string 0 (string-length string)))
+  (md5-bytevector (string->utf8 string)))
 
 (define (md5-substring string start end)
+  (md5-bytevector (string->utf8 (substring string start end))))
+
+(define (md5-bytevector bytevector)
   (let ((context (%md5-init)))
-    (%md5-update context string start end)
+    (%md5-update context bytevector 0 (bytevector-length bytevector))
     (%md5-final context)))
 
 (define (md5-sum->number sum)
-  (let ((l (string-length sum)))
+  (let ((l (bytevector-length sum)))
     (do ((i 0 (fix:+ i 1))
-	 (n 0 (+ (* n #x100) (vector-8b-ref sum i))))
+	 (n 0 (+ (* n #x100) (bytevector-u8-ref sum i))))
 	((fix:= i l) n))))
 
-(define (md5-sum->hexadecimal sum)
-  (let ((n (string-length sum))
-	(digits "0123456789abcdef"))
-    (let ((s (make-legacy-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
+(define md5-sum->hexadecimal bytevector->hexadecimal)
\ No newline at end of file
-- 
2.25.1