* whirlpool-sum
@ 2005-09-27 16:19 Thien-Thi Nguyen
0 siblings, 0 replies; only message in thread
From: Thien-Thi Nguyen @ 2005-09-27 16:19 UTC (permalink / raw)
Cc: guile-user
[-- Attachment #1: Type: text/plain, Size: 239 bytes --]
looks like md5 is "vulnerable", so here's an alternative. note that
MD5SUMS files under <http://www.glug.org/people/ttn/software/> have all
been replaced w/ WHIRLPOOLSUMS. nice food for hobbit...
thi
___________________________________
[-- Attachment #2: whirlpool-sum.scm --]
[-- Type: application/octet-stream, Size: 18701 bytes --]
#!/bin/sh
exec ${GUILE-guile} -e '(ttn-do whirlpool-sum)' -s $0 "$@" # -*- scheme -*-
!#
;;; whirlpool-sum
;;;
;;; Copyright (C) 2005 Thien-Thi Nguyen
;;; This program is part of ttn-do, released under GNU GPL v2 with ABSOLUTELY
;;; NO WARRANTY. See http://www.gnu.org/copyleft/gpl.txt for details.
;;; Commentary:
;; Usage: whirlpool-sum [FILE... | --test-vectors]
;;
;; For each FILE, display filename on a line by itself followed by
;; two lines containing its whirlpool summary (512 bits) in eight
;; groups of 64-bit hex numbers. For example:
;;
;; $ whirlpool-sum COPYING ttn-do.texi
;; COPYING
;; 932DD32C054C7C02 5140F4001CF59D37 143ACC854A13AE7C 4E198CF6FFC7318D
;; DD822574641015F3 131483E8D8E821B3 53E1F8524488DD9F 3512E8FB00BCD6D0
;; ttn-do.texi
;; E2F2A43E7559F5C7 C3729041B1511C09 A11222CF07882901 5598F919346AC10C
;; DB019E814B049ADF 33D28828F10579DE 5647E00D8EAE8D7E EB66127F35D026FB
;;
;; Alternatively, if invoked with single option `--test-vectors', display
;; NESSIE and ISO test vectors in a format that allows diff of the output
;; against the files nessie-test-vectors.txt and iso-test-vectors.txt,
;; respectively, from the Whirlpool authors' distribution (see below).
;; Note that this computation may take several weeks to complete!
;;
;; The Whirlpool algorithm was developed by
;; Paulo S. L. M. Barreto (pbarreto@scopus.com.br) and
;; Vincent Rijmen (vincent.rijmen@cryptomathic.com).
;;
;; P.S.L.M. Barreto, V. Rijmen,
;; ``The Whirlpool hashing function,''
;; First NESSIE workshop, 2000 (tweaked version, 2003),
;; https://www.cosic.esat.kuleuven.ac.be/nessie/workshop/submissions/whirlpool.zip
;;
;; This program implements version 3.0 (2003.03.12) of the algorithm.
;;; Code:
(define-module (ttn-do whirlpool-sum)
#:use-module ((scripts PROGRAM) #:select (HVQC-MAIN))
#:use-module (scripts slurp)
#:use-module (ice-9 format)
#:export (whirlpool-sum main))
(define v: vector-ref)
(define v! vector-set!)
(define (b3b n) ; bottom 3 bits
(logand n #x7))
(define (byte n)
(logand n #xff))
(define (long n)
(logand n #xffffffffffffffff))
(define lsr64 ; logical shift right 64 bit
(let ((masks (list->vector (map (lambda (count)
(1- (ash 1 count)))
(iota 65)))))
(lambda (n count)
(let ((neg (- count)))
(logand (ash n neg) (v: masks (+ 64 neg)))))))
(define (blsr n shift)
(byte (lsr64 n shift)))
(define (v8<- to from)
(vector-move-left! from 0 8 to 0))
(define (apply-map2-proc op proc)
(lambda (ls-a ls-b)
(apply op (map proc ls-a ls-b))))
(define xor*ash (apply-map2-proc logxor ash))
(define INC-BY-1-FROM-0 (iota 8))
(define DEC-BY-8-FROM-56 (map (lambda (n) (- 56 (* 8 n))) INC-BY-1-FROM-0))
(define DIGESTBITS
;; The message digest size (in bits).
512)
(define DIGESTBYTES
;; The message digest size (in bytes).
(ash DIGESTBITS -3))
(define R
;; The number of rounds of the internal dedicated block cipher.
10)
(define sbox
;; The substitution box.
(let ((java-rep '("\u1823\uc6E8\u87B8\u014F\u36A6\ud2F5\u796F\u9152"
"\u60Bc\u9B8E\uA30c\u7B35\u1dE0\ud7c2\u2E4B\uFE57"
"\u1577\u37E5\u9FF0\u4AdA\u58c9\u290A\uB1A0\u6B85"
"\uBd5d\u10F4\ucB3E\u0567\uE427\u418B\uA77d\u95d8"
"\uFBEE\u7c66\udd17\u479E\ucA2d\uBF07\uAd5A\u8333"
"\u6302\uAA71\uc819\u49d9\uF2E3\u5B88\u9A26\u32B0"
"\uE90F\ud580\uBEcd\u3448\uFF7A\u905F\u2068\u1AAE"
"\uB454\u9322\u64F1\u7312\u4008\uc3Ec\udBA1\u8d3d"
"\u9700\ucF2B\u7682\ud61B\uB5AF\u6A50\u45F3\u30EF"
"\u3F55\uA2EA\u65BA\u2Fc0\udE1c\uFd4d\u9275\u068A"
"\uB2E6\u0E1F\u62d4\uA896\uF9c5\u2559\u8472\u394c"
"\u5E78\u388c\ud1A5\uE261\uB321\u9c1E\u43c7\uFc04"
"\u5199\u6d0d\uFAdF\u7E24\u3BAB\ucE11\u8F4E\uB7EB"
"\u3c81\u94F7\uB913\u2cd3\uE76E\uc403\u5644\u7FA9"
"\u2ABB\uc153\udc0B\u9d6c\u3174\uF646\uAc89\u14E1"
"\u163A\u6909\u70B6\ud0Ed\ucc42\u98A4\u285c\uF886")))
(define (append-map proc ls)
(apply append (map proc ls)))
(list->vector (append-map
(lambda (s)
(append-map
(lambda (idx)
(let ((group (* 5 idx)))
(define (x2i b e)
(string->number
(substring s (+ b group) (+ e group))
16))
(list (x2i 1 3) (x2i 3 5))))
INC-BY-1-FROM-0))
java-rep))))
(define C
;; The circulant table.
(let ((ra (make-array 1 8 256))
(ior*ash (apply-map2-proc logior ash)))
(define (maybe-11d n)
(if (<= #x100 n)
(logxor #x11d n)
n))
(define (?? a b)
(array-ref ra a b))
(define (!! a b v)
(array-set! ra v a b))
(do ((x 0 (1+ x)))
((= x 256))
(let* ((v1 (v: sbox x))
(v2 (maybe-11d (ash v1 1)))
(v4 (maybe-11d (ash v2 1)))
(v5 (logxor v4 v1))
(v8 (maybe-11d (ash v4 1)))
(v9 (logxor v8 v1)))
;; Build the circulant table C[0][x] = S[x].[1, 1, 4, 1, 8, 5, 2, 9].
(!! 0 x (ior*ash (list v1 v1 v4 v1 v8 v5 v2 v9)
DEC-BY-8-FROM-56))
;; Build the remaining circulant tables C[t][x] = C[0][x] rotr t.
(do ((t 1 (1+ t)))
((= t 8))
(let ((prev (?? (1- t) x)))
(!! t x (long (logior (lsr64 prev 8)
(ash prev 56))))))))
ra))
(define rc
;; The round constants.
(let ((vec (make-vector (1+ R) #f)))
;; Build the round constants.
(v! vec 0 0) ; unused
(do ((r 1 (1+ r)))
((= r (1+ R)))
(let* ((i (* 8 (1- r)))
(from-C (lambda (mask a)
(logand mask (array-ref C a (+ a i)))))
(xor*from-C (apply-map2-proc logxor from-C)))
(v! vec r (xor*from-C (map ash (make-list 8 #xff) DEC-BY-8-FROM-56)
INC-BY-1-FROM-0))))
vec))
(define bit-length
;; Global number of hashed bits (256-bit counter).
(make-vector 32))
(define buffer
;; Buffer of data to hash.
(make-vector DIGESTBYTES))
(define nbits
;; Current number of bits on the buffer.
0)
(define bufpos
;; Current (possibly incomplete) byte slot on the buffer.
0)
;; The hashing state.
(define hash (make-vector 8))
(define K (make-vector 8)) ; the round key
(define L (make-vector 8))
(define block (make-vector 8)) ; mu(buffer)
(define state (make-vector 8)) ; the cipher state
(define (process-buffer)
;; The core Whirlpool transform.
;; Map the buffer to a block.
(do ((i 0 (1+ i)) (j 0 (+ j 8)))
((= 8 i))
(v! block i (xor*ash (map (lambda (n)
(byte (v: buffer (+ n j))))
INC-BY-1-FROM-0)
DEC-BY-8-FROM-56)))
;; Compute and apply K^0 to the cipher state.
(v8<- K hash)
(array-index-map! state (lambda (i) (logxor (v: block i)
(v: K i))))
;; Iterate over all rounds.
(do ((r 1 (1+ r)))
((= (1+ R) r))
;; Compute K^r from K^{r-1}.
(do ((i 0 (1+ i)))
((= 8 i))
(v! L i 0)
(do ((t 0 (1+ t)) (s 56 (- s 8)))
((= 8 t))
(v! L i (logxor (v: L i)
(array-ref C t (blsr (v: K (b3b (- i t))) s))))))
(v8<- K L)
(v! K 0 (logxor (v: K 0)
(v: rc r)))
;; Apply the r-th round transformation.
(v8<- L K)
(do ((i 0 (1+ i)))
((= 8 i))
(do ((t 0 (1+ t)) (s 56 (- s 8)))
((= 8 t))
(v! L i (logxor (v: L i)
(array-ref C t (blsr (v: state (b3b (- i t))) s))))))
(v8<- state L))
;; Apply the Miyaguchi-Preneel compression function.
(array-index-map! hash (lambda (i) (logxor (v: hash i)
(v: state i)
(v: block i)))))
(define (init!)
;; Initialize the hashing state.
(vector-fill! bit-length 0)
(set! nbits 0)
(set! bufpos 0)
;; It's only necessary to cleanup buffer[bufpos].
(v! buffer 0 0)
(vector-fill! hash 0))
(define (add! source srcbits)
;; Deliver input data to the hashing algorithm.
;;
;; source -- plaintext data to hash.
;; srcbits -- how many bits of plaintext to process.
;;
;; This method maintains the invariant: (< nbits 512).
;;
;; srcpos
;; |
;; +-------+-------+-------
;; ||||||||||||||||||||| source
;; +-------+-------+-------
;; +-------+-------+-------+-------+-------+-------
;; |||||||||||||||||||||| buffer
;; +-------+-------+-------+-------+-------+-------
;; |
;; bufpos
;;
(let* ((srcpos
;; Index of leftmost source byte containing data (1 to 8 bits).
0)
(gap
;; Space on source[srcpos].
(b3b (- 8 (b3b srcbits))))
(rem
;; Occupied bits on buffer[bufpos].
(b3b nbits))
(b #f)
(value #f))
;; Tally the length of the added data.
(set! value srcbits)
(do ((i 31 (1- i)) (carry 0))
((not (and (>= i 0)
(or (not (= 0 carry))
(not (= 0 value))))))
(set! carry (+ carry
(byte (v: bit-length i))
(byte value)))
(v! bit-length i (byte carry))
(set! carry (lsr64 carry 8))
(set! value (lsr64 value 8)))
;; Process data in chunks of 8 bits.
(let loop ()
;; At least source[srcpos] and source[srcpos+1] contain data.
(and (< 8 srcbits)
(begin
;; Take a byte from the source.
(set! b (logior
(byte (ash (v: source srcpos) gap))
(ash (byte (v: source (1+ srcpos)))
(- gap 8))))
(or (<= 0 b 255)
(error "LOGIC ERROR"))
;; Process this byte.
(v! buffer bufpos (logior
(v: buffer bufpos)
(lsr64 b rem)))
(set! bufpos (1+ bufpos))
(set! nbits (+ nbits 8 (- rem)))
(cond ((= DIGESTBITS nbits)
;; Process data block.
(process-buffer)
;; Reset buffer.
(set! nbits 0)
(set! bufpos 0)))
(v! buffer bufpos (byte (ash b (- 8 rem))))
(set! nbits (+ nbits rem))
;; Proceed to remaining data.
(set! srcbits (- srcbits 8))
(set! srcpos (1+ srcpos))
(loop))))
;; Now 0 <= srcbits <= 8.
;; Furthermore, all data (if any is left) is in source[srcpos].
(cond ((< 0 srcbits)
;; Bits are left-justified on b.
(set! b (byte (ash (v: source srcpos) gap)))
;; Process the remaining bits.
(v! buffer bufpos (logior
(v: buffer bufpos)
(lsr64 b rem))))
(else
(set! b 0)))
(cond ((> 8 (+ rem srcbits))
;; All remaining data fits on buffer[bufpos],
;; and there still remains some space.
(set! nbits (+ nbits srcbits)))
(else
;; buffer[bufpos] is full.
(set! bufpos (1+ bufpos))
(set! nbits (+ nbits 8 (- rem)))
(set! srcbits (+ srcbits -8 rem))
;; Now 0 <= srcbits < 8; furthermore,
;; all data is in source[srcpos].
(cond ((= DIGESTBITS nbits)
;; Process data block.
(process-buffer)
;; Reset buffer.
(set! nbits 0)
(set! bufpos 0)))
(v! buffer bufpos (byte (ash b (- 8 rem))))
(set! nbits (+ nbits srcbits))))))
(define (finalize! digest)
;; Get the hash value from the hashing state.
;;
;; This method uses the invariant: (< nbits 512).
;; Append a '1'-bit.
(v! buffer bufpos (logior
(v: buffer bufpos)
(lsr64 #x80 (b3b nbits))))
;; All remaining bits on the current byte are set to zero.
(set! bufpos (1+ bufpos))
;; Pad with zero bits to complete (+ 256 (* 512 N)) bits.
(cond ((< 32 bufpos)
(let loop ()
(and (> DIGESTBYTES bufpos)
(begin
(v! buffer bufpos 0)
(set! bufpos (1+ bufpos))
(loop))))
;; Process data block.
(process-buffer)
;; Reset buffer.
(set! bufpos 0)))
(let loop ()
(and (> 32 bufpos)
(begin
(v! buffer bufpos 0)
(set! bufpos (1+ bufpos))
(loop))))
;; Append bit length of hashed data.
(do ((i 0 (1+ i)))
((= 32 i))
(v! buffer (+ i 32) (v: bit-length i)))
;; Process data block.
(process-buffer)
;; Return the completed message digest.
(do ((i 0 (1+ i)) (j 0 (+ 8 j)))
((= 8 i))
(let ((h (v: hash i)))
(vector-set! digest j (blsr h 56))
(vector-set! digest (+ 1 j) (blsr h 48))
(vector-set! digest (+ 2 j) (blsr h 40))
(vector-set! digest (+ 3 j) (blsr h 32))
(vector-set! digest (+ 4 j) (blsr h 24))
(vector-set! digest (+ 5 j) (blsr h 16))
(vector-set! digest (+ 6 j) (blsr h 8))
(vector-set! digest (+ 7 j) (byte h)))))
(define (add!-string source)
;; Deliver string input data to the hashing algorithm.
;;
;; source -- plaintext data to hash (ASCII text string).
;;
;; This method maintains the invariant: (< nbits 512).
;;
(let* ((len (string-length source))
(data (make-vector len)))
(array-index-map! data (lambda (x) (char->integer (string-ref source x))))
(add! data (* 8 len))))
(define LONG-ITERATION 100000000)
(define (digest->string digest)
(format #f "~{~:@(~2,'0X~)~}"
(map (lambda (x)
(v: digest x))
(iota DIGESTBYTES))))
(define (display-digest digest)
(do ((i 0 (1+ i)))
((= i DIGESTBYTES))
(and (= 0 (modulo i 32)) (newline))
(and (= 0 (modulo i 8)) (display " "))
(format #t "~:@(~2,'0X~)" (v: digest i)))
(newline))
(define (test-vectors)
;; Generate the NESSIE test vector set for Whirlpool.
;;
;; The test consists of:
;; 1. hashing all bit strings containing only zero bits
;; for all lengths from 0 to 1023;
;; 2. hashing all 512-bit strings containing a single set bit;
;; 3. the iterated hashing of the 512-bit string of zero bits
;; a large number of times.
;;
(let ((digest (make-vector DIGESTBYTES))
(data (make-vector 128)))
(vector-fill! data 0)
(write-line "Message digests of strings of 0-bits and length L:")
(do ((i 0 (1+ i)))
((= 1024 i))
(init!)
(add! data i)
(finalize! digest)
(format #t " L = ~4D: ~A\n" i (digest->string digest)))
(write-line "Message digests of all 512-bit strings S containing a single 1-bit:")
(set! data (make-vector (/ 512 8)))
(vector-fill! data 0)
(do ((i 0 (1+ i)))
((= 512 i))
;; Set bit i.
(v! data (quotient i 8) (ash #x80 (- (modulo i 8))))
(init!)
(add! data 512)
(finalize! digest)
(format #t " S = ~A: ~A\n"
(digest->string data) (digest->string digest))
;; Reset bit i.
(v! data (quotient i 8) 0))
(vector-fill! digest 0)
(do ((i 0 (1+ i)))
((= LONG-ITERATION i))
(init!)
(add! digest 512)
(finalize! digest))
(format #t "Iterated message digest computation (~A times): ~A\n"
LONG-ITERATION (digest->string digest)))
;; Generate the ISO/IEC 10118-3 test vector set for Whirlpool.
(let ((digest (make-vector DIGESTBYTES)))
(define (test n blurb . s)
(format #t "~A. In this example the data-string ~A.\n" n blurb)
(init!)
(or (null? s) (add!-string (car s)))
(finalize! digest)
(format #t "\nThe hash-code is the following 512-bit string.\n\n")
(display-digest digest)
(newline))
(test 1 "is the empty string, i.e. the string of length zero")
(test 2 "consists of a single byte, namely the ASCII-coded version of the letter 'a'"
"a")
(test 3 "is the three-byte string consisting of the ASCII-coded version of 'abc'"
"abc")
(test 4 "is the 14-byte string consisting of the ASCII-coded version of 'message digest'"
"message digest")
(test 5 "is the 26-byte string consisting of the ASCII-coded version of 'abcdefghijklmnopqrstuvwxyz'"
"abcdefghijklmnopqrstuvwxyz")
(test 6 "is the 62-byte string consisting of the ASCII-coded version of 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789'"
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789")
(test 7 "is the 80-byte string consisting of the ASCII-coded version of eight repetitions of '1234567890'"
"12345678901234567890123456789012345678901234567890123456789012345678901234567890")
(test 8 "is the 32-byte string consisting of the ASCII-coded version of 'abcdbcdecdefdefgefghfghighijhijk'"
"abcdbcdecdefdefgefghfghighijhijk")
(test 9 "is the 1000000-byte string consisting of the ASCII-coded version of 'a' repeated 10^6 times"
(make-string 1000000 #\a))))
(define (process-file filename)
(let ((s (slurp filename))
(digest (make-vector DIGESTBYTES)))
(init!)
(add!-string s)
(finalize! digest)
(display filename)
(display-digest digest)))
(define (main args)
(HVQC-MAIN args (lambda (qop)
(cond ((qop 'test-vectors)
(test-vectors))
((null? (qop '()))
(error "no input specified"))
(else
(for-each process-file (qop '())))))
'(package . "ttn-do")
'(version . "1.0")
'(usage . commentary)
'(option-spec (test-vectors))))
;;; whirlpool-sum ends here
[-- Attachment #3: Type: text/plain, Size: 140 bytes --]
_______________________________________________
Guile-user mailing list
Guile-user@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-user
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2005-09-27 16:19 UTC | newest]
Thread overview: (only message) (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2005-09-27 16:19 whirlpool-sum Thien-Thi Nguyen
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).