From 34a9c6bef7db450e0d8ea58dbc04740e3b261b12 Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <code@mail.matthias.benkard.de>
Date: Tue, 16 Aug 2011 00:33:19 +0200
Subject: Implement HMAC.

---
 hmac.rkt      | 62 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 util.rkt      | 33 ++++++++++++++++++++++++++++++-
 whirlpool.rkt |  4 ++--
 3 files changed, 96 insertions(+), 3 deletions(-)
 create mode 100644 hmac.rkt

diff --git a/hmac.rkt b/hmac.rkt
new file mode 100644
index 0000000..6ff03cf
--- /dev/null
+++ b/hmac.rkt
@@ -0,0 +1,62 @@
+#lang typed/racket
+;;; Copyright 2011, Matthias Andreas Benkard.
+;;;
+;;;-----------------------------------------------------------------------------
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU Affero General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Affero General Public License
+;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;;-----------------------------------------------------------------------------
+;;;
+
+(require "util.rkt")
+
+(provide: [hmac ((Bytes -> Exact-Nonnegative-Integer)
+                 Exact-Nonnegative-Integer
+                 Exact-Nonnegative-Integer
+                 Bytes
+                 Bytes
+                 ->
+                 Exact-Nonnegative-Integer)])
+
+;; Example:
+;;
+;;  (hmac whirlpool 64 64 #"<secret key>" #"hello")
+;;
+(define (hmac hashfn blocksize hashsize key msg)
+  (let ([opad (make-bytes blocksize #x5c)]
+        [ipad (make-bytes blocksize #x36)]
+        [padded-key
+         (pad-bytes (if (> (bytes-length key) blocksize)
+                        (integer->bytes (hashfn key))
+                        key)
+                    blocksize
+                    #x0
+                    'left)])
+    (hashfn (bytes-append (integer->bytes/size
+                           (bitwise-xor (bytes->integer opad)
+                                        (bytes->integer key))
+                           blocksize)
+                          (integer->bytes/size
+                           (hashfn
+                            (bytes-append
+                             (integer->bytes/size
+                              (bitwise-xor (bytes->integer ipad)
+                                           (bytes->integer key))
+                              blocksize)
+                             msg))
+                           hashsize)))))
+
+#;
+(begin
+  (require "whirlpool.rkt")
+  (printf "~x~%" (hmac whirlpool 64 64 #"" #"")))
+
diff --git a/util.rkt b/util.rkt
index 5c1f2d3..43dbe01 100644
--- a/util.rkt
+++ b/util.rkt
@@ -17,7 +17,13 @@
 ;;;-----------------------------------------------------------------------------
 ;;;
 
-(provide integer->bytes)
+(provide integer->bytes
+         integer->bytes/size
+         bytes->integer
+         pad-bytes
+         Justification)
+
+(define-type Justification (U 'left 'right))
 
 (define: (integer->bytes [x : Exact-Nonnegative-Integer]) : Bytes
   (let: loop : Bytes
@@ -27,3 +33,28 @@
         (list->bytes acc)
         (loop (cons (bitwise-and #xff x) acc)
               (arithmetic-shift x -8)))))
+
+(define: (integer->bytes/size [x : Exact-Nonnegative-Integer]
+                              [size : Exact-Nonnegative-Integer])
+  : Bytes
+  (pad-bytes (integer->bytes x) size #x0 'right))
+
+(define: (bytes->integer [b : Bytes]) : Exact-Nonnegative-Integer
+  (for/fold: ([n : Exact-Nonnegative-Integer 0])
+             ([byte : Byte (in-bytes b)])
+    (bitwise-ior (arithmetic-shift n 8)
+                 byte)))
+
+(define: (pad-bytes [b : Bytes]
+                    [s : Exact-Nonnegative-Integer]
+                    [fill : Byte]
+                    [justify : Justification])
+  : Bytes
+  (if (>= (bytes-length b) s)
+      b
+      (let* ([delta   (- s (bytes-length b))]
+             [padding (make-bytes delta fill)])
+        (if (eq? justify 'left)
+            (bytes-append b padding)
+            (bytes-append padding b)))))
+
diff --git a/whirlpool.rkt b/whirlpool.rkt
index d57cf51..5d436aa 100644
--- a/whirlpool.rkt
+++ b/whirlpool.rkt
@@ -207,7 +207,7 @@
   (let ([b (integer->bytes n)])
     (bytes-append (make-bytes (- 32 (bytes-length b)) 0) b)))
 
-(define: (pad-bytes [b : Bytes]) : Bytes
+(define: (pad-whirlpool-bytes [b : Bytes]) : Bytes
   (let* ([missingno (modulo (- 32 (remainder (bytes-length b) 64))
                             64)]
          [padding   (cons #x80 (make-list (sub1 missingno) 0))]
@@ -215,7 +215,7 @@
     (bytes-append b (list->bytes padding) len)))
 
 (define: (bytes->message [b : Bytes]) : (Listof Matrix)
-  (let: ([pb : Bytes (pad-bytes b)])
+  (let: ([pb : Bytes (pad-whirlpool-bytes b)])
     (reverse
      (for/fold: ([acc : (Listof Matrix) (list)])
                 ([i : Exact-Nonnegative-Integer
-- 
cgit v1.2.3