diff options
| -rw-r--r-- | cubehash.rkt | 149 | ||||
| -rw-r--r-- | main.rkt | 13 |
2 files changed, 160 insertions, 2 deletions
diff --git a/cubehash.rkt b/cubehash.rkt new file mode 100644 index 0000000..3aed1f3 --- /dev/null +++ b/cubehash.rkt @@ -0,0 +1,149 @@ +#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/>. +;;;----------------------------------------------------------------------------- +;;; + +;;; +;;; NOTE: The original version of CubeHash defaulted to +;;; init-rounds = fin-rounds = (* 10 rounds/block). Therefore, if you see +;;; references to “Cubehash r/b-h” variants, you can instantiate those by using +;;; something like the following: +;;; +;;; (cubehash (* 10 r) r b (* 10 r) h) +;;; + + +(require "util.rkt") + +(provide: [cubehash (Exact-Nonnegative-Integer Exact-Nonnegative-Integer + Exact-Nonnegative-Integer Exact-Nonnegative-Integer + Exact-Nonnegative-Integer -> + Bytes -> Exact-Nonnegative-Integer)] + [cubehash-128 (Bytes -> Exact-Nonnegative-Integer)] + [cubehash-160 (Bytes -> Exact-Nonnegative-Integer)] + [cubehash-224 (Bytes -> Exact-Nonnegative-Integer)] + [cubehash-256 (Bytes -> Exact-Nonnegative-Integer)] + [cubehash-384 (Bytes -> Exact-Nonnegative-Integer)] + [cubehash-512 (Bytes -> Exact-Nonnegative-Integer)] + [cubehash-512x (Bytes -> Exact-Nonnegative-Integer)] + #;[cubemac-128 (Bytes Bytes -> Exact-Nonnegative-Integer)]) + + +(define-type Word Exact-Nonnegative-Integer) +(define-type Bit (U Zero One)) + +(: w+ (Word Word -> Word)) +(define (w+ a b) + (bitwise-and (+ a b) #xffffffff)) + +(: wxor (Word Word -> Word)) +(define wxor bitwise-xor) + +(: wrot (Word Exact-Positive-Integer -> Word)) +(define (wrot a e) + (let ([ash (arithmetic-shift a e)]) + (bitwise-ior (bitwise-and ash #xffffffff) + (arithmetic-shift ash -32)))) + + +(define (cubehash init-rounds rounds/block block-size fin-rounds output-bits) + (λ: ([msg : Bytes]) + (let*: ([state : (Vectorof Word) + (make-vector 32 #x0)] + [msg-pad : Bytes + (bytes-append msg + (list->bytes '(#x80)) + (make-bytes (modulo (- (+ 1 (bytes-length msg))) + block-size) + #x0))] + [x : (Integer Integer Integer Integer Integer -> Word) + (λ (i j k l m) + (vector-ref state (+ (* i 16) (* j 8) (* k 4) (* l 2) m)))] + [set-x! : (Integer Integer Integer Integer Integer Word -> Void) + (λ (i j k l m v) + (vector-set! state (+ (* i 16) (* j 8) (* k 4) (* l 2) m) v))] + [round! : (-> Void) + (λ () + (for*: ([j : Bit '(0 1)] [k : Bit '(0 1)] [l : Bit '(0 1)] [m : Bit '(0 1)]) + (set-x! 1 j k l m (w+ (x 0 j k l m) + (x 1 j k l m)))) + (for*: ([j : Bit '(0 1)] [k : Bit '(0 1)] [l : Bit '(0 1)] [m : Bit '(0 1)]) + (set-x! 0 j k l m (wrot (x 0 j k l m) 7))) + (for*: ([k : Bit '(0 1)] [l : Bit '(0 1)] [m : Bit '(0 1)]) + (let ([tmp (x 0 0 k l m)]) + (set-x! 0 0 k l m (x 0 1 k l m)) + (set-x! 0 1 k l m tmp))) + (for*: ([j : Bit '(0 1)] [k : Bit '(0 1)] [l : Bit '(0 1)] [m : Bit '(0 1)]) + (set-x! 0 j k l m (wxor (x 0 j k l m) + (x 1 j k l m)))) + (for*: ([j : Bit '(0 1)] [k : Bit '(0 1)] [m : Bit '(0 1)]) + (let ([tmp (x 1 j k 0 m)]) + (set-x! 1 j k 0 m (x 1 j k 1 m)) + (set-x! 1 j k 1 m tmp))) + (for*: ([j : Bit '(0 1)] [k : Bit '(0 1)] [l : Bit '(0 1)] [m : Bit '(0 1)]) + (set-x! 1 j k l m (w+ (x 0 j k l m) + (x 1 j k l m)))) + (for*: ([j : Bit '(0 1)] [k : Bit '(0 1)] [l : Bit '(0 1)] [m : Bit '(0 1)]) + (set-x! 0 j k l m (wrot (x 0 j k l m) 11))) + (for*: ([j : Bit '(0 1)] [l : Bit '(0 1)] [m : Bit '(0 1)]) + (let ([tmp (x 0 j 0 l m)]) + (set-x! 0 j 0 l m (x 0 j 1 l m)) + (set-x! 0 j 1 l m tmp))) + (for*: ([j : Bit '(0 1)] [k : Bit '(0 1)] [l : Bit '(0 1)] [m : Bit '(0 1)]) + (set-x! 0 j k l m (wxor (x 0 j k l m) + (x 1 j k l m)))) + (for*: ([j : Bit '(0 1)] [k : Bit '(0 1)] [l : Bit '(0 1)]) + (let ([tmp (x 1 j k l 0)]) + (set-x! 1 j k l 0 (x 1 j k l 1)) + (set-x! 1 j k l 1 tmp))))]) + (vector-set! state 0 (quotient output-bits 8)) + (vector-set! state 1 block-size) + (vector-set! state 2 rounds/block) + (for ([i (in-range 0 init-rounds)]) + (round!)) + (for ([i (in-range 0 (quotient (bytes-length msg-pad) block-size))]) + (let ([block (subbytes msg-pad (* i block-size) (* (add1 i) block-size))]) + (for: ([byte : Byte block] + [i : Exact-Nonnegative-Integer (in-naturals)]) + (let ([s (vector-ref state (quotient i 4))]) + (vector-set! state + (quotient i 4) + (bitwise-xor s (arithmetic-shift byte + (* (remainder i 4) 8)))))) + (for ([i (in-range 0 rounds/block)]) + (round!)))) + (vector-set! state 31 (bitwise-xor (vector-ref state 31) 1)) + (for ([i (in-range 0 fin-rounds)]) + (round!)) + (bytes->integer + (subbytes (bytes-append* (vector->list + (vector-map (λ: ([w : Word]) + (integer->bytes/size w 'little-endian 4)) + state))) + 0 + (quotient output-bits 8)))))) + + +(define cubehash-128 (cubehash 16 16 32 32 128)) +(define cubehash-160 (cubehash 16 16 32 32 160)) +(define cubehash-224 (cubehash 16 16 32 32 224)) +(define cubehash-256 (cubehash 16 16 32 32 256)) +(define cubehash-384 (cubehash 16 16 32 32 384)) +(define cubehash-512 (cubehash 16 16 32 32 512)) +(define cubehash-512x (cubehash 16 16 1 32 512)) + +#;(define cubemac-128 ...) @@ -1,8 +1,17 @@ #lang typed/racket (require "hmac.rkt" "whirlpool.rkt" - "salsa-chacha.rkt") + "salsa-chacha.rkt" + "cubehash.rkt") (provide hmac whirlpool - salsa20) + salsa20 + cubehash + cubehash-128 + cubehash-160 + cubehash-224 + cubehash-256 + cubehash-384 + cubehash-512 + cubehash-512x) |