md5: Use bytevectors instead of strings.

diff --git a/src/md5/md5-check.scm b/src/md5/md5-check.scm
index 181740b9f46920a6565d7a31723dba1242d31761..73c611df9155931f2c7ece418eda5aaa9c510e91 100644 (file)
--- 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 ee04babe23ee8d2f5f7eccd247308e91ba602562..e4a4ff6e3af762dfaa2aacaa6f9ba3f9670f4b4e 100644 (file)
--- a/src/md5/md5.scm
+++ b/src/md5/md5.scm
@@ -31,84 +31,53 @@ USA.
 \f
 (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