summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Andreas Benkard <code@mail.matthias.benkard.de>2011-08-16 00:33:19 +0200
committerMatthias Andreas Benkard <code@mail.matthias.benkard.de>2011-08-16 00:33:19 +0200
commit34a9c6bef7db450e0d8ea58dbc04740e3b261b12 (patch)
tree92fbf35538d24102245e74a94673ae62a0628fb1
parent3aaa523f41df21b493133c4f3580c4cfed1611ff (diff)
Implement HMAC.
-rw-r--r--hmac.rkt62
-rw-r--r--util.rkt33
-rw-r--r--whirlpool.rkt4
3 files changed, 96 insertions, 3 deletions
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