Merge pull request #3 from LemonBoy/mdapi

Use the message-digest API
master
Thomas Hintz 7 years ago committed by GitHub
commit b980254c59

@ -3,28 +3,36 @@
; license: bsd ; license: bsd
(module hmac (module hmac
(hmac) (hmac hmac-primitive)
(import scheme chicken srfi-4 srfi-13) (import scheme chicken srfi-13)
(use message-digest-port) (use message-digest-basic message-digest-item message-digest-update-item)
(define (hmac key digest-primitive #!optional (block-size 64)) (define (hmac-primitive key digest-primitive)
(let ((key_ key)) (let ((block-size (message-digest-primitive-block-length digest-primitive))
(key_ key))
(when (> (string-length key_) block-size) (when (> (string-length key_) block-size)
(set! key_ (call-with-output-digest digest-primitive (cut display key_ <>) 'string))) (set! key_ (message-digest-string digest-primitive key_ 'string)))
(set! key_ (string-pad-right key_ block-size (integer->char 0))) (set! key_ (string-pad-right key_ block-size (integer->char 0)))
(let ((ipad (string-map (lambda (c) (integer->char (bitwise-xor (char->integer c) #x36))) key_)) (let ((ipad (string-map (lambda (c) (integer->char (bitwise-xor (char->integer c) #x36))) key_))
(opad (string-map (lambda (c) (integer->char (bitwise-xor (char->integer c) #x5c))) key_))) (opad (string-map (lambda (c) (integer->char (bitwise-xor (char->integer c) #x5c))) key_)))
(lambda (message) (make-message-digest-primitive
(call-with-output-digest (lambda ()
digest-primitive (initialize-message-digest digest-primitive))
(cut display (message-digest-primitive-digest-length digest-primitive)
(string-append opad (lambda (inner)
(call-with-output-digest (message-digest-update-string inner ipad))
digest-primitive (lambda (inner blob n)
(cut display (string-append ipad message) <>) (message-digest-update-object inner blob))
'string)) (lambda (inner x)
<>) (finalize-message-digest!
'string))))) (let ((outer (initialize-message-digest digest-primitive)))
(message-digest-update-string outer opad)
(message-digest-update-string outer (finalize-message-digest inner 'string))
outer)
x))))))
(define (hmac key digest-primitive #!optional (result-form 'string))
(lambda (message)
(message-digest-object (hmac-primitive key digest-primitive) message result-form)))
) )

@ -5,25 +5,30 @@
(use test) (use test)
(use sha1 string-utils hmac) (use sha1 string-utils hmac)
(test-group "HMAC" (test-group "RFC2202 test vectors"
(test "Short Key and Message" (define (testv key msg expected)
"64608bd9aa157cdfbca795bf9a727fc191a50b66" (test "Vector" expected (string->hex ((hmac key (sha1-primitive)) msg))))
(string->hex ((hmac "hi" (sha1-primitive) 64) "food is good")))
(test "Long Key, Short Message" (testv (make-string 20 (integer->char #x0b))
"511387216297726a7947c6006f5be89711662b1f" "Hi There"
(string->hex ((hmac "hi my name is the big bad wolf" (sha1-primitive) 64) "hi"))) "b617318655057264e28bc0b6fb378c8ef146be00")
(testv "Jefe"
(test "Short Key, Long Message (Longer than blocksize)" "what do ya want for nothing?"
"73dc948bab4e0c65b1e5d18ae3694a39a4788bee" "effcdf6ae5eb2fa2d27416d5f184df9c259a7c79")
(string->hex ((hmac "key" (sha1-primitive) 64) "this is a really long message that is going to being run through this hmac test to make sure that it works correctly."))) (testv "\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B\x0C\x0D\x0E\x0F\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19"
(make-string 50 (integer->char #xcd))
(test "Larger Blocksize" "4c9007f4026250c6bc8414f9bf50c86c2d7235da")
"3dbf833dc1e13c88f0366efaa2ec7d89399c5c1a" (testv (make-string 20 (integer->char #xaa))
(string->hex ((hmac "key key key" (sha1-primitive) 256) "hi what is your name?"))) (make-string 50 (integer->char #xdd))
"125d7342b9ac11cd91a39af48aa17b4f63f175d3")
(test "Smaller Blocksize" (testv (make-string 20 (integer->char #x0c))
"dd9547893c27d1af459601bb571c6da8941ac00c" "Test With Truncation"
(string->hex ((hmac "key key key" (sha1-primitive) 16) "hi what is your name?")))) "4c1a03424b55e07fe7f27be1d58bb9324a9a5a04")
(testv (make-string 80 (integer->char #xaa))
"Test Using Larger Than Block-Size Key - Hash Key First"
"aa4ae5e15272d00e95705637ce8a3b55ed402112")
(testv (make-string 80 (integer->char #xaa))
"Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data"
"e8e99d0f45237d786d6bbaa7965c7808bbff1a91"))
(test-exit) (test-exit)
Loading…
Cancel
Save