From e7fd2b3cc6316c822e0d4b083bac78d9849c156d Mon Sep 17 00:00:00 2001 From: LemonBoy Date: Sun, 27 Aug 2017 13:39:19 +0200 Subject: [PATCH 1/2] Rewrite as a message-digest primitive The block size is an inherent property of the hashing function being used and should not be manipulated by the user. --- hmac.scm | 42 +++++++++++++++++++++++++----------------- 1 file changed, 25 insertions(+), 17 deletions(-) diff --git a/hmac.scm b/hmac.scm index bb82bc6..c4edb60 100644 --- a/hmac.scm +++ b/hmac.scm @@ -3,28 +3,36 @@ ; license: bsd (module hmac - (hmac) + (hmac hmac-primitive) -(import scheme chicken srfi-4 srfi-13) -(use message-digest-port) +(import scheme chicken lolevel srfi-13) +(use message-digest-basic message-digest-item message-digest-update-item) -(define (hmac key digest-primitive #!optional (block-size 64)) - (let ((key_ key)) +(define (hmac-primitive key digest-primitive) + (let ((block-size (message-digest-primitive-block-length digest-primitive)) + (key_ key)) (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))) (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_))) - (lambda (message) - (call-with-output-digest - digest-primitive - (cut display - (string-append opad - (call-with-output-digest - digest-primitive - (cut display (string-append ipad message) <>) - 'string)) - <>) - 'string))))) + (make-message-digest-primitive + (lambda () + (initialize-message-digest digest-primitive)) + (message-digest-primitive-digest-length digest-primitive) + (lambda (inner) + (message-digest-update-string inner ipad)) + (lambda (inner blob n) + (message-digest-update-object inner blob)) + (lambda (inner x) + (finalize-message-digest! + (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))) ) From d7634f2773e8bcb9a40d6d41881e76919c2db8f8 Mon Sep 17 00:00:00 2001 From: LemonBoy Date: Sun, 27 Aug 2017 13:40:12 +0200 Subject: [PATCH 2/2] Use the RFC2202 test vectors --- hmac.scm | 2 +- tests/run.scm | 45 +++++++++++++++++++++++++-------------------- 2 files changed, 26 insertions(+), 21 deletions(-) diff --git a/hmac.scm b/hmac.scm index c4edb60..e402e2e 100644 --- a/hmac.scm +++ b/hmac.scm @@ -5,7 +5,7 @@ (module hmac (hmac hmac-primitive) -(import scheme chicken lolevel srfi-13) +(import scheme chicken srfi-13) (use message-digest-basic message-digest-item message-digest-update-item) (define (hmac-primitive key digest-primitive) diff --git a/tests/run.scm b/tests/run.scm index a4d182c..9e0dd85 100644 --- a/tests/run.scm +++ b/tests/run.scm @@ -5,25 +5,30 @@ (use test) (use sha1 string-utils hmac) -(test-group "HMAC" - (test "Short Key and Message" - "64608bd9aa157cdfbca795bf9a727fc191a50b66" - (string->hex ((hmac "hi" (sha1-primitive) 64) "food is good"))) +(test-group "RFC2202 test vectors" + (define (testv key msg expected) + (test "Vector" expected (string->hex ((hmac key (sha1-primitive)) msg)))) - (test "Long Key, Short Message" - "511387216297726a7947c6006f5be89711662b1f" - (string->hex ((hmac "hi my name is the big bad wolf" (sha1-primitive) 64) "hi"))) + (testv (make-string 20 (integer->char #x0b)) + "Hi There" + "b617318655057264e28bc0b6fb378c8ef146be00") + (testv "Jefe" + "what do ya want for nothing?" + "effcdf6ae5eb2fa2d27416d5f184df9c259a7c79") + (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)) + "4c9007f4026250c6bc8414f9bf50c86c2d7235da") + (testv (make-string 20 (integer->char #xaa)) + (make-string 50 (integer->char #xdd)) + "125d7342b9ac11cd91a39af48aa17b4f63f175d3") + (testv (make-string 20 (integer->char #x0c)) + "Test With Truncation" + "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 "Short Key, Long Message (Longer than blocksize)" - "73dc948bab4e0c65b1e5d18ae3694a39a4788bee" - (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."))) - - (test "Larger Blocksize" - "3dbf833dc1e13c88f0366efaa2ec7d89399c5c1a" - (string->hex ((hmac "key key key" (sha1-primitive) 256) "hi what is your name?"))) - - (test "Smaller Blocksize" - "dd9547893c27d1af459601bb571c6da8941ac00c" - (string->hex ((hmac "key key key" (sha1-primitive) 16) "hi what is your name?")))) - -(test-exit) \ No newline at end of file +(test-exit)