Release version 7.0.1.

hmac.meta

@@ -5,9 +5,9 @@
 (
 (license "BSD")
 
-(category cryptography)
+(category crypt)
 
-(needs message-digest srfi-4-utils)
+(needs message-digest)
 
 (test-depends test sha1 string-utils)
 

hmac.release-info

@@ -4,4 +4,7 @@
 (release "1")
 (release "2")
 (release "3")
-(release "4")
+(release "4")
+(release "6")
+(release "7")
+(release "7.0.1")

hmac.scm

@@ -6,17 +6,25 @@
   (hmac)
 
 (import scheme chicken srfi-4 srfi-13)
-(use srfi-4-utils message-digest-port)
+(use message-digest-port)
 
-; taken from example at http://wiki.call-cc.org/drupal-xml-rpc
 (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)
-      (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))))
+  (let ((key_ key))
+    (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)))
+    (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)))))
 
-)
+)

hmac.setup

@@ -11,5 +11,5 @@
   ; Files to install for your extension:
   '("hmac.o" "hmac.so" "hmac.import.so")
   ; Assoc list with properties for your extension:
-  '((version 4)
+  '((version 7.0.1)
     (static "hmac.o"))) ;; for static linking