Compare commits
5 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
679dd41240 | ||
|
|
a0a1bab4c1 | ||
|
|
d759083e9d | ||
| b52b480a81 | |||
| ffe7b3bfe3 |
@@ -5,6 +5,6 @@
|
|||||||
(release "2")
|
(release "2")
|
||||||
(release "3")
|
(release "3")
|
||||||
(release "4")
|
(release "4")
|
||||||
(release "5")
|
|
||||||
(release "6")
|
(release "6")
|
||||||
(release "7")
|
(release "7")
|
||||||
|
(release "7.0.1")
|
||||||
25
hmac.scm
25
hmac.scm
@@ -8,14 +8,23 @@
|
|||||||
(import scheme chicken srfi-4 srfi-13)
|
(import scheme chicken srfi-4 srfi-13)
|
||||||
(use 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))
|
(define (hmac key digest-primitive #!optional (block-size 64))
|
||||||
(when (> (string-length key) block-size)
|
(let ((key_ key))
|
||||||
(set! key (call-with-output-digest digest-primitive (cut display key <>) 'string)))
|
(when (> (string-length key_) block-size)
|
||||||
(set! key (string-pad-right key block-size (integer->char 0)))
|
(set! key_ (call-with-output-digest digest-primitive (cut display key_ <>) 'string)))
|
||||||
(let ((ipad (string-map (lambda (c) (integer->char (bitwise-xor (char->integer c) #x36))) key))
|
(set! key_ (string-pad-right key_ block-size (integer->char 0)))
|
||||||
(opad (string-map (lambda (c) (integer->char (bitwise-xor (char->integer c) #x5c))) key)))
|
(let ((ipad (string-map (lambda (c) (integer->char (bitwise-xor (char->integer c) #x36))) key_))
|
||||||
(lambda (message)
|
(opad (string-map (lambda (c) (integer->char (bitwise-xor (char->integer c) #x5c))) key_)))
|
||||||
(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))))
|
(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:
|
; Files to install for your extension:
|
||||||
'("hmac.o" "hmac.so" "hmac.import.so")
|
'("hmac.o" "hmac.so" "hmac.import.so")
|
||||||
; Assoc list with properties for your extension:
|
; Assoc list with properties for your extension:
|
||||||
'((version 7)
|
'((version 7.0.1)
|
||||||
(static "hmac.o"))) ;; for static linking
|
(static "hmac.o"))) ;; for static linking
|
||||||
Reference in New Issue
Block a user