Commits

Taylor Venable committed 77e934f

Finish SHA-1 implementation, huzzah!

Comments (0)

Files changed (3)

 ;;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 ;;; POSSIBILITY OF SUCH DAMAGE.
 
-(import (net metasyntax number))
-(import (net metasyntax vector))
+(load "number.scm")
+(load "vector.scm")
+;(import (net metasyntax number))
+;(import (net metasyntax vector))
 
 (define (sha1 text)
   (define h0 #x67452301)
           ((= (mod n 512) 448) 0)
           (else (+ (- 512 (mod n 512)) 448))))
 
-  (let* ((addendum (make-vector (div (add-bits (* (vector-length text) 8)) 8) #x00))
-         (with-one-bit (vector-set! addendum 0 (expt 2 7)))
-         (new-text (vector-append text with-one-bit))
-         (with-length (vector-append new-text (fixnum->bytevector/64 (div (vector-length text) 8)))))
+  (define (process-block block)
+    (let ((new-block (make-vector (div (vector-length block) 4))))
+      (do ((i 0 (+ i 1)))
+          ((> i 15) #t)
+        (vector-set! new-block i
+          (list->vector
+            (list (vector-ref block (+ (* i 4) 0))
+                  (vector-ref block (+ (* i 4) 1))
+                  (vector-ref block (+ (* i 4) 2))
+                  (vector-ref block (+ (* i 4) 3))))))
+      (set! new-block (vector-map (lambda (_ e) (bytevector->fixnum e)) new-block))
 
-  (let ((w (vector-extend sub-chunk 80 #x00)))
-    (do ((i 16 (+ i 1)))
-        ((> i 79) w)
-      (vector-set! w i
-        (ash (bitwise-xor
-               (vector-ref w (- i 3))
-               (vector-ref w (- i 8))
-               (vector-ref w (- i 14))
-               (vector-ref w (- i 16))) 1)))
-    (let ((a h0) (b h1) (c h2) (d h3) (e h4))
-      (do ((i 0 (+ i 1)))
-          ((> i 79) w)
-        (cond ((and (<= 0 i) (<= i 19))
-               (set! f (bitwise-ior (bitwise-and b c) (bitwise-and (bitwise-not b) d)))
-               (set! k #x5A827999))
-              ((and (<= 20 i) (<= 39 i))
-               (set! f (bitwise-xor b c d))
-               (set! k #x6ED9EBA1))
-              ((and (<= 40 i) (<= 59 i))
-               (set! f (bitwise-ior (bitwise-and b c) (bitwise-and b d) (bitwise-and c d)))
-               (set! k #x8F1BBCDC))
-              ((and (<= 60 i) (<= 79 i))
-               (set! f (bitwise-xor b c d))
-               (set! k #xCA62C1D6))
-              (else
-               (error "impossible")))
-        (let* ((temp (+trunc/32 (rotate-left/32 a 5) f e k (vector-ref w i)))
-               (e d)
-               (d c)
-               (c (rotate-left/32 b 30))
-               (b a)
-               (a temp))
+      (display "Sub-block for processing:")
+      (newline)
+      (u32vector-dump new-block #t)
+      (newline)
+
+      (let ((w (vector-extend new-block 80 #x00)))
+        (do ((i 16 (+ i 1)))
+            ((> i 79) w)
+          (vector-set! w i
+            (rotate-left/32
+              (bitwise-xor
+                (vector-ref w (- i 3))
+                (vector-ref w (- i 8))
+                (vector-ref w (- i 14))
+                (vector-ref w (- i 16))) 1)))
+
+        (display "Extended sub-block for processing:")
+        (newline)
+        (u32vector-dump w #t)
+        (newline)
+
+        (let ((a h0) (b h1) (c h2) (d h3) (e h4))
+          (do ((i 0 (+ i 1)))
+              ((> i 79) w)
+            (let-values (((f k)
+                          (cond ((and (<= 0 i) (<= i 19))
+                                 (values (bitwise-ior (bitwise-and b c) (bitwise-and (bitwise-not b) d)) #x5A827999))
+                                ((and (<= 20 i) (<= i 39))
+                                 (values (bitwise-xor b c d) #x6ED9EBA1))
+                                ((and (<= 40 i) (<= i 59))
+                                 (values (bitwise-ior (bitwise-and b c) (bitwise-and b d) (bitwise-and c d)) #x8F1BBCDC))
+                                ((and (<= 60 i) (<= i 79))
+                                 (values (bitwise-xor b c d) #xCA62C1D6))
+                                (else
+                                  (error (format #f "impossible: i = ~a" i))))))
+              (set! temp (+trunc/32 (rotate-left/32 a 5) f e k (vector-ref w i)))
+              (set! e d)
+              (set! d c)
+              (set! c (rotate-left/32 b 30))
+              (set! b a)
+              (set! a temp)))
+
           (set! h0 (+trunc/32 h0 a))
           (set! h1 (+trunc/32 h1 b))
           (set! h2 (+trunc/32 h2 c))
           (set! h3 (+trunc/32 h3 d))
-          (set! h4 (+trunc/32 h4 e)))))))
+          (set! h4 (+trunc/32 h4 e))))))
+
+  (format #t "Message text: ~a~%" text)
+  (format #t "Number of bits to add for padding: ~a~%" (add-bits (* (vector-length text) 8)))
+
+  (let ((addendum (make-vector (div (add-bits (* (vector-length text) 8)) 8) #x00)))
+    (vector-set! addendum 0 (expt 2 7))
+    (format #t "Bytes that we're going to add: ~a~%" addendum)
+    (let* ((new-text (vector-append text addendum))
+           (with-length (vector-append new-text (fixnum->bytevector/64 (* (vector-length text) 8)))))
+      (format #t "Bytes added with length: ~a~%" with-length)
+
+      (do ((i 0 (+ i 64)))
+          ((>= i (vector-length with-length)) #t)
+        (format #t "Slicing vector in range [~a,~a)~%" i (+ i 64))
+        (process-block (vector-slice with-length i (+ i 64))))))
+
+  (bytevector-write `#(,h0 ,h1 ,h2 ,h3 ,h4)))
 
 (define (hash-test text)
-  (sha1 (list->u8vector (map char->integer (string->list text)))))
+  (sha1 (list->vector (map char->integer (string->list text)))))
 
 (define (hmac-md5 key text)
   (let ((block-size 64))
 (define (+trunc/32 n . ns)
   (define (%+ b a)
     (let ((c (+ a b)))
-      (if (>= c (expt 2 32))
-        (- c (expt 2 32)) c)))
+      (bitwise-and c #xFFFFFFFF)))
   (fold %+ n ns))
 
 (define (rotate-left/32 n count)
-  (bitwise-rotate-bit-field n 0 31 count))
+  (bitwise-and (bitwise-rotate-bit-field n 0 32 count) #xFFFFFFFF))
 (define (rotate-right/32 n count)
-  (bitwise-rotate-bit-field n 0 31 (* count -1)))
+  (bitwise-rotate-bit-field n 0 32 (* count -1)))
     (vector-append v (make-vector (- len (vector-length v))))
     (vector-append v (make-vector (- len (vector-length v)) init))))
 
+(define (bytevector-write v #!optional (port #f))
+  (format port "#( ~{#x~:@(~8,'0X~) ~})" (vector->list v)))
+
+(define (u32vector-dump v #!optional (port #f))
+  (let loop ((i 0))
+    (if (>= i (vector-length v)) #t
+      (let ((n (vector-ref v i)))
+        (format port "[~4,'0d] ~:@(~8,'0X~) |~{ ~:@(~2,'0X~)~}~%" i n
+          (list (arithmetic-shift (bitwise-and n #xFF000000) -24)
+                (arithmetic-shift (bitwise-and n #x00FF0000) -16)
+                (arithmetic-shift (bitwise-and n #x0000FF00)  -8)
+                (bitwise-and n #x000000FF)))
+        (loop (+ i 1))))))
+
+(define (vector-slice v start end)
+  (if (< start 0)
+    (error (format #f "out of range: start (~a) < 0" start)))
+  (if (> end (vector-length v))
+    (error (format #f "out of range: end (~a) > len v (~a)" end (vector-length v))))
+  (let ((output (make-vector (- end start))))
+    (do ((i 0 (+ i 1)))
+        ((>= (+ i start) end) output)
+      (vector-set! output i (vector-ref v (+ i start))))))
+
 (define (u8vector->vector v)
   (let ((output (make-vector (u8vector-length v))))
     (do ((i 0 (+ i 1)))
         (list->vector l)
         (loop (arithmetic-shift m -8) (cons (bitwise-and m #xFF) l))))))
 
+(define (bytevector->fixnum v)
+  (let loop ((i 0) (n 0))
+    (if (>= i (vector-length v)) n
+      (loop (+ i 1) (+ (arithmetic-shift n 8)
+                       (vector-ref v i))))))
+
 ;; Convert an integer into a bytevector. The vector will be padded with zeroes
 ;; so that it's 64 bits long. Providing an integer that's too big to fit in 64
 ;; bits will cause an error.
   (if (>= n (expt 2 64))
     (error "number too big to fit in 64-bit field"))
 
-  (let ((zeroes (make-vector (do ((i 56 (- i 8))
-                                  (j 0  (+ j 1)))
-                                 ((>= n (expt 2 i)) j)) #x00)))
-    (vector-append zeroes (fixnum->bytevector n))))
+  (let ((data (fixnum->bytevector n)))
+    (vector-append (make-vector (- 8 (vector-length data)) #x00) data)))