suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Jepri's changes so that md5 works on ports

Browse Source 
svn: r2194
This commit is contained in:
Matthew Flatt 2006-02-11 05:35:35 +00:00
parent 17e10b396e
commit a59d668f6d
1 changed files with 485 additions and 419 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

136
collects/mzlib/md5.ss
View File

@ -1,4 +1,5 @@
(module md5 mzscheme
(provide md5)
;;; -*- mode: scheme; mode: font-lock -*-
@ -54,6 +55,15 @@
; According to RFC 1321, the message should still be padded in this
; case.
; 23-12-2005 / Jepri
; - Mucked around with the insides to get it to read from a port
; - Now it accepts a port or a string as input
; - Doesn't explode when handed large strings anymore
; - Now much slower
; 2-10-2006 / Matthew
; - Cleaned up a little
; - Despite comment above, it seems consistently faster
;;; Summary
@ -97,7 +107,6 @@
[(word c)
(cons (quotient c 65536) (remainder c 65536))]))
(let ()
;;; PORTING NOTES
@ -226,39 +235,88 @@
;; string->bytes : string -> (list byte)
(define (string->bytes s)
(bytes->list s))
;; Converts a list of words to a vector, just like vector-from-string
;; vector-from-list: byte-string -> (vector ...)
(define vector-from-list list->vector)
;; Converts a byte string to a more useful vector
;; vector-from-string: byte string -> (vector ...)
(define vector-from-string
(lambda (l-raw)
(list->vector (bytes->words (string->bytes l-raw)))))
(define empty-port (open-input-bytes #""))
;; List Helper
;; block/list : list -> (values vector list)
;; return a vector of the first 16 elements of the list,
;; and the rest of the list
(define (block/list l)
(let* (( v0 (car l)) ( l0 (cdr l))
( v1 (car l0)) ( l1 (cdr l0))
( v2 (car l1)) ( l2 (cdr l1))
( v3 (car l2)) ( l3 (cdr l2))
( v4 (car l3)) ( l4 (cdr l3))
( v5 (car l4)) ( l5 (cdr l4))
( v6 (car l5)) ( l6 (cdr l5))
( v7 (car l6)) ( l7 (cdr l6))
( v8 (car l7)) ( l8 (cdr l7))
( v9 (car l8)) ( l9 (cdr l8))
(v10 (car l9)) (l10 (cdr l9))
(v11 (car l10)) (l11 (cdr l10))
(v12 (car l11)) (l12 (cdr l11))
(v13 (car l12)) (l13 (cdr l12))
(v14 (car l13)) (l14 (cdr l13))
(v15 (car l14)) (l15 (cdr l14)))
(values (vector v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15)
l15)))
;; block/list : a-port done-n -> (values vector a-port done-n)
;; reads 512 bytes from the port, turns them into a vector of 16 32-bit words
;; when the port is exhausted it returns #f for the port and
;; the last few bytes padded
(define (block/list a-port done)
(let* ((l-raw (read-bytes (/ 512 8) a-port)))
(cond
;; File size was a multiple of 512 bits, or we're doing one more round to
;; add the correct padding from the short case
((eof-object? l-raw)
(if (zero? (modulo done (/ 512 8)))
;; The file is a multiple of 512 or was 0, so there hasn't been a
;; chance to add the 1-bit pad, so we need to do a full pad
(values (vector-from-list (step2 (* 8 done)
(step1 (string->bytes #""))))
#f
done)
;; We only enter this block when the previous block didn't have
;; enough room to fit the 64-bit file length,
;; so we just add 448 bits of zeros and then the 64-bit file length (step2)
(values (vector-from-list (step2 (* 8 done)
(vector->list (make-vector (quotient 448 8) 0))))
#f
done)))
;; We read exactly 512 bits, the algorythm proceeds as usual
((= (bytes-length l-raw) (/ 512 8))
(values (vector-from-string l-raw) a-port (+ done (bytes-length l-raw))))
;; We read less than 512 bits, so the file has ended.
;; However, we don't have enough room to add the correct trailer,
;; so we add what we can, then go for one more round which will
;; automatically fall into the (eof-object? case)
((> (* 8 (bytes-length l-raw)) 446)
(let ([done (+ done (bytes-length l-raw))])
(values (vector-from-list (step2 (* 8 done)
(step1 (string->bytes l-raw))))
empty-port
done)))
;; Returning a longer vector than we should, luckily it doesn't matter.
;; We read less than 512 bits and there is enough room for the correct trailer.
;; Add trailer and bail
(else
(let ([done (+ done (bytes-length l-raw))])
(values (vector-from-list (step2 (* 8 done)
(step1 (string->bytes l-raw))))
#f
done))))))
;(step2 (* 8 (bytes-length str))
; (step1 (string->bytes str)))
;; MD5
;; The algorithm consists of five steps.
;; All we need to do, is to call them in order.
;; md5 : string -> string
(define (md5-computation str)
(step5 (step4 (step2 (* 8 (bytes-length str))
(step1 (string->bytes str))))))
(define (md5-computation a-thing)
(let ((a-port (cond
[(bytes? a-thing)
(open-input-bytes a-thing)]
[(input-port? a-thing)
a-thing]
[else
(raise-type-error 'md5
"input-port or bytes"
a-thing)])))
(step5 (step4 a-port))))
;; Step 1 - Append Padding Bits
;; The message is padded so the length (in bits) becomes 448 modulo 512.
@ -304,14 +362,20 @@
;; For each 16 word block, go through a round one to four.
;; step4 : (list word) -> "(list word word word word)"
(define (step4 message)
(define (step4 a-port)
(define (loop A B C D a-port done)
(define (loop A B C D message)
(if (null? message)
(if (not a-port)
(list A B C D)
(let-values (((X rest) (block/list message)))
(let* ((AA A) (BB B) (CC C) (DD D)
(let-values (((X b-port done) (block/list a-port done)))
(if (not X)
(list A B C D)
(begin
(let* ((AA A)
(BB B)
(CC C)
(DD D)
(A (word+ B (word<<< (word.4+ A (F B C D) (vector-ref X 0) (word 3614090360)) 7)))
(D (word+ A (word<<< (word.4+ D (F A B C) (vector-ref X 1) (word 3905402710)) 12)))
@ -385,10 +449,12 @@
(B (word+ B BB))
(C (word+ C CC))
(D (word+ D DD)))
(loop A B C D rest)))))
(loop A B C D b-port done)))))))
;; Step 3 :-) (magic constants)
(loop (word #x67452301) (word #xefcdab89) (word #x98badcfe) (word #x10325476) message))
;; (display (format "Message is: ~a~n~n" message))
(loop (word #x67452301) (word #xefcdab89) (word #x98badcfe) (word #x10325476) a-port 0))
;; Each round consists of the application of the following
;; basic functions. They functions on a word bitwise, as follows.
@ -426,8 +492,8 @@
(apply bytes-append
(map number->hex
(apply append (map word->bytes l)))))
(set! md5 md5-computation))
(set! md5 md5-computation)
)
;(define (md5-test)
; (if (and (equal? (md5 "")