You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
49 lines
1.7 KiB
Scheme
49 lines
1.7 KiB
Scheme
; author: Thomas Hintz
|
|
; email: t@thintz.com
|
|
; license: bsd
|
|
|
|
(module hmac
|
|
(hmac hmac-primitive)
|
|
|
|
(import scheme)
|
|
|
|
(cond-expand
|
|
|
|
(chicken-4
|
|
(import chicken srfi-13)
|
|
(use message-digest-basic message-digest-item message-digest-update-item))
|
|
|
|
(chicken-5
|
|
(import (chicken base) (chicken bitwise) srfi-13)
|
|
(import message-digest-basic message-digest-item message-digest-update-item)))
|
|
|
|
|
|
(define (hmac-primitive key digest-primitive)
|
|
(let ((block-size (message-digest-primitive-block-length digest-primitive))
|
|
(key_ key))
|
|
(when (> (string-length key_) block-size)
|
|
(set! key_ (message-digest-string digest-primitive 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_)))
|
|
(make-message-digest-primitive
|
|
(lambda ()
|
|
(initialize-message-digest digest-primitive))
|
|
(message-digest-primitive-digest-length digest-primitive)
|
|
(lambda (inner)
|
|
(message-digest-update-string inner ipad))
|
|
(lambda (inner blob n)
|
|
(message-digest-update-object inner blob))
|
|
(lambda (inner x)
|
|
(finalize-message-digest!
|
|
(let ((outer (initialize-message-digest digest-primitive)))
|
|
(message-digest-update-string outer opad)
|
|
(message-digest-update-string outer (finalize-message-digest inner 'string))
|
|
outer)
|
|
x))))))
|
|
|
|
(define (hmac key digest-primitive #!optional (result-form 'string))
|
|
(lambda (message)
|
|
(message-digest-object (hmac-primitive key digest-primitive) message result-form)))
|
|
)
|