diff --git a/hmac.meta b/hmac.meta new file mode 100644 index 0000000..f7bd246 --- /dev/null +++ b/hmac.meta @@ -0,0 +1,15 @@ +; author: Thomas Hintz +; email: t@thintz.com +; license: bsd + +( +(license "BSD") + +(category cryptography) + +(needs message-digest-port srfi-4-utils) + +(test-depends test sha1 string-utils) + +(author "Thomas Hintz") +(synopsis "HMAC provides a HMAC using the message-digest interface.")) \ No newline at end of file diff --git a/hmac.release-info b/hmac.release-info new file mode 100644 index 0000000..1d9604f --- /dev/null +++ b/hmac.release-info @@ -0,0 +1,4 @@ +(repo git "git://example.com/{egg-name}.git") ; optional + +(uri targz "http://example.com/{egg-name}/releases/{egg-name}-{egg-release}.tar.gz") +(release "1") \ No newline at end of file diff --git a/hmac.scm b/hmac.scm index c884d16..643cbb4 100644 --- a/hmac.scm +++ b/hmac.scm @@ -1,11 +1,22 @@ -(use sha1 srfi-4 srfi-4-utils) +; author: Thomas Hintz +; email: t@thintz.com +; license: bsd + +(module hmac + (hmac) + +(import scheme chicken srfi-4 srfi-13) +(use srfi-4-utils message-digest-port) ; taken from example at http://wiki.call-cc.org/drupal-xml-rpc -(define (sha1-hmac key) - (when (> (string-length key) 64) (set! key (sha1-binary-digest key))) - (set! key (string-pad-right key 64 (integer->char 0))) +(define (hmac key digest-primitive #!optional (block-size 64)) + (when (> (string-length key) block-size) + (set! key (call-with-output-digest digest-primitive (cut display key <>) 'string))) + (set! key (string-pad-right key block-size (integer->char 0))) (set! key (blob->u8vector (string->blob key))) (let ((ipad (blob->string (u8vector->blob (u8vector-map (lambda (v) (bitwise-xor v #x36)) key)))) (opad (blob->string (u8vector->blob (u8vector-map (lambda (v) (bitwise-xor v #x5c)) key))))) (lambda (message) - (sha1-binary-digest (string-append opad (sha1-binary-digest (string-append ipad message))))))) \ No newline at end of file + (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)))) + +) \ No newline at end of file diff --git a/hmac.setup b/hmac.setup new file mode 100644 index 0000000..6e68c48 --- /dev/null +++ b/hmac.setup @@ -0,0 +1,15 @@ +; author: Thomas Hintz +; email: t@thintz.com +; license: bsd + +(compile -s -O2 -d1 hmac.scm -j hmac) +(compile -s hmac.import.scm -O2 -d0) +(compile -c -O2 -d1 hmac.scm -unit hmac -j hmac) + +(install-extension + 'hmac + ; Files to install for your extension: + '("hmac.o" "hmac.so" "hmac.import.so") + ; Assoc list with properties for your extension: + '((version 1) + (static "hmac.o"))) ;; for static linking \ No newline at end of file diff --git a/tests/run.scm b/tests/run.scm new file mode 100644 index 0000000..fed961c --- /dev/null +++ b/tests/run.scm @@ -0,0 +1,29 @@ +; author: Thomas Hintz +; email: t@thintz.com +; license: bsd + +(use test) +(use sha1 string-utils) + +(test-group "HMAC" + (test "Short Key and Message" + "64608bd9aa157cdfbca795bf9a727fc191a50b66" + (string->hex ((hmac "hi" (sha1-primitive) 64) "food is good"))) + + (test "Long Key, Short Message" + "511387216297726a7947c6006f5be89711662b1f" + (string->hex ((hmac "hi my name is the big bad wolf" (sha1-primitive) 64) "hi"))) + + (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