Taylor Venable avatar Taylor Venable committed 1be32d8

Finish HMAC-SHA-1 implementation, fix bug in SHA-1

Comments (0)

Files changed (2)

 ;(import (net metasyntax number))
 ;(import (net metasyntax vector))
 
-(define (sha1 text)
-  (define h0 #x67452301)
-  (define h1 #xEFCDAB89)
-  (define h2 #x98BADCFE)
-  (define h3 #x10325476)
-  (define h4 #xC3D2E1F0)
+(define (sha-1 text)
+  (define +h0+ #x67452301)
+  (define +h1+ #xEFCDAB89)
+  (define +h2+ #x98BADCFE)
+  (define +h3+ #x10325476)
+  (define +h4+ #xC3D2E1F0)
+
+  ;; n + m = a + b   (mod 512)
+  ;;       = 448     (mod 512)
+  ;;     n = x       (mod 512)
+  ;;     m = 448 - x (mod 512)
 
   (define (add-bits n)
-    (cond ((<= n 448) (- 448 n))
-          ((= (mod n 512) 448) 0)
-          (else (+ (- 512 (mod n 512)) 448))))
+    (let* ((x (mod n 512))
+           (a (- 448 x)))
+      (- a (* (div a 512) 512))))
 
   (define (process-block block)
     (let ((new-block (make-vector (div (vector-length block) 4))))
                   (vector-ref block (+ (* i 4) 3))))))
       (set! new-block (vector-map (lambda (_ e) (bytevector->fixnum e)) new-block))
 
-      (display "Sub-block for processing:")
-      (newline)
-      (u32vector-dump new-block #t)
-      (newline)
+      ; (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)))
                 (vector-ref w (- i 14))
                 (vector-ref w (- i 16))) 1)))
 
-        (display "Extended sub-block for processing:")
-        (newline)
-        (u32vector-dump w #t)
-        (newline)
+        ; (display "Extended sub-block for processing:") (newline)
+        ; (u32vector-dump w #t) (newline)
 
-        (let ((a h0) (b h1) (c h2) (d h3) (e h4))
+        (let ((a +h0+) (b +h1+) (c +h2+) (d +h3+) (e +h4+))
           (do ((i 0 (+ i 1)))
               ((> i 79) w)
             (let-values (((f k)
               (set! c (rotate-left/32 b 30))
               (set! b a)
               (set! a temp)))
+          ; outside the do-loop
 
-          (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! +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))))))
 
-  (format #t "Message text: ~a~%" text)
-  (format #t "Number of bits to add for padding: ~a~%" (add-bits (* (vector-length text) 8)))
+  (define (%sha-1 text)
+    ; (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)
+    (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))))))
+        (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)))
+    (u32vector->u8vector (list->vector (list +h0+ +h1+ +h2+ +h3+ +h4+))))
 
-(define (hash-test text)
-  (sha1 (list->vector (map char->integer (string->list text)))))
+  (cond ((string? text)
+         (%sha-1 (list->vector (map char->integer (string->list text)))))
+        ((vector? text)
+         (%sha-1 text))
+        (else
+          (error "invalid arguments"))))
 
 (define (hmac-md5 key text)
   (let ((block-size 64))
     #f))
 
-(define (hmac-sha1 key text)
-  (let ((block-size 64))
-    (if (> (vector-length key) block-size)
-      (set! key (sha1 key)))
-    (if (< (vector-length key) block-size)
-      (let ((padding (make-vector (- block-size (length key)) #x00)))
-        (set! key (vector-append key padding))))
-    (let ((o-key-pad (bitwise-xor (make-vector block-size #x5C) key))
-          (i-key-pad (bitwise-xor (make-vector block-size #x36) key)))
-      (sha1 (vector-append o-key-pad (sha1 (vector-append i-key-pad message)))))))
+;; WARNING
+;; When given string arguments, the strings must be encoded in ASCII.
+
+(define (hmac-sha-1 key text)
+  (define (%hmac-sha-1 key text)
+    (let ((block-size 64))
+      (if (> (vector-length key) block-size)
+        (set! key (sha-1 key)))
+
+      (if (< (vector-length key) block-size)
+        (let ((padding (make-vector (- block-size (vector-length key)) #x00)))
+          (set! key (vector-append key padding))))
+
+      (let ((o-key-pad (vector-xor (make-vector block-size #x5C) key))
+            (i-key-pad (vector-xor (make-vector block-size #x36) key)))
+        (sha-1 (vector-append o-key-pad (sha-1 (vector-append i-key-pad text)))))))
+  (cond ((and (string? key) (string? text))
+         (%hmac-sha-1
+           (list->vector (map char->integer (string->list key)))
+           (list->vector (map char->integer (string->list text)))))
+        ((and (vector? key) (vector? text))
+         (%hmac-sha-1 key text))
+        (else
+          (error "invalid arguments"))))
 
 (define (hmac-sha256 key text)
   (let ((block-size 64))
     (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 (u8vector-write v #!optional (port #f))
+  (format port "#( ~{#x~:@(~2,'0X~) ~})" (vector->list v)))
+
+(define (u8vector-dump v #!optional (port #f) #!key (break #f))
+  (do ((i 0 (+ i 1)))
+      ((>= i (vector-length v)) #t)
+    (if (and break (zero? (mod i break)))
+      (format port "[~4,'0d]" i))
+    (format port " ~:@(~2,'0X~)" (vector-ref v i))
+    (if (and break (zero? (mod (+ i 1) break)))
+      (format port "~%"))))
 
 (define (u32vector-dump v #!optional (port #f))
   (let loop ((i 0))
 
   (let ((data (fixnum->bytevector n)))
     (vector-append (make-vector (- 8 (vector-length data)) #x00) data)))
+
+(define (vector-xor v1 v2)
+  (if (not (and (vector? v1) (vector? v2)))
+    (error "invalid arguments"))
+  (if (not (= (vector-length v1) (vector-length v2)))
+    (error "vectors must be the same length"))
+  (let ((output (make-vector (vector-length v1))))
+    (do ((i 0 (+ i 1)))
+        ((>= i (vector-length v1)) output)
+      (vector-set! output i (bitwise-xor (vector-ref v1 i) (vector-ref v2 i))))))
+
+(define (u32vector->u8vector v)
+  (apply vector-append (vector-map (lambda (_ e) (fixnum->bytevector e)) v)))
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.