Compare commits
4 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
| 4029fed7bf | |||
| 3b221a88ce | |||
| ce8e7b6d79 | |||
| a56eb5b277 |
@@ -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)
|
||||
|
||||
|
||||
@@ -4,3 +4,7 @@
|
||||
(release "1")
|
||||
(release "2")
|
||||
(release "3")
|
||||
(release "4")
|
||||
(release "5")
|
||||
(release "6")
|
||||
(release "7")
|
||||
7
hmac.scm
7
hmac.scm
@@ -6,16 +6,15 @@
|
||||
(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)))))
|
||||
(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))))
|
||||
|
||||
|
||||
@@ -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 1)
|
||||
'((version 7)
|
||||
(static "hmac.o"))) ;; for static linking
|
||||
Reference in New Issue
Block a user