6 Commits
6 ... 7.0.1

Author SHA1 Message Date
Thomas Hintz
679dd41240 Release version 7.0.1. 2013-09-24 18:29:16 -07:00
Thomas Hintz
a0a1bab4c1 Don't destructively modifiy args. 2013-09-24 18:27:48 -07:00
Thomas Hintz
d759083e9d Fix invalid arg type bug introduced in b52b480. 2013-09-24 18:25:31 -07:00
b52b480a81 Cleanup formatting. 2013-09-24 15:38:33 -07:00
ffe7b3bfe3 remove release 5 because it doesnt exist 2012-02-01 21:19:59 -08:00
4029fed7bf correct version number 2012-01-15 03:14:02 -08:00
3 changed files with 22 additions and 12 deletions

View File

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

View File

@@ -8,14 +8,23 @@
(import scheme chicken srfi-4 srfi-13)
(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)))
(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)))
(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))))
(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)))))
)

View File

@@ -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 6)
'((version 7.0.1)
(static "hmac.o"))) ;; for static linking