diff options
| -rw-r--r-- | hmac.rkt | 62 | ||||
| -rw-r--r-- | util.rkt | 33 | ||||
| -rw-r--r-- | whirlpool.rkt | 4 |
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 #"" #""))) + @@ -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 |