1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
|
;; -*- mode: scheme; coding: utf-8 -*-
;; Copyright © 2009, 2012 Göran Weinholt <goran@weinholt.se>
;; Permission is hereby granted, free of charge, to any person obtaining a
;; copy of this software and associated documentation files (the "Software"),
;; to deal in the Software without restriction, including without limitation
;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
;; and/or sell copies of the Software, and to permit persons to whom the
;; Software is furnished to do so, subject to the following conditions:
;; The above copyright notice and this permission notice shall be included in
;; all copies or substantial portions of the Software.
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
;; THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;; DEALINGS IN THE SOFTWARE.
#!r6rs
;; RFC 2104, FIPS-198-1.
(library (hmac)
(export make-hmac)
(import (rnrs))
;; Returns a procedure that calculates the HMAC given a secret and
;; data (both of which are bytevectors).
(define (make-hmac block-length hash ->bytevector make-hash update! finish! clear!)
(lambda (secret . data)
(let lp ((secret secret))
(if (> (bytevector-length secret) block-length)
(lp (->bytevector (hash secret)))
(let ((k-ipad (make-bytevector block-length 0))
(k-opad (make-bytevector block-length 0)))
(bytevector-copy! secret 0 k-ipad 0 (bytevector-length secret))
(bytevector-copy! secret 0 k-opad 0 (bytevector-length secret))
(do ((i 0 (fx+ i 1)))
((fx=? i block-length))
(bytevector-u8-set! k-ipad i (fxxor #x36 (bytevector-u8-ref k-ipad i)))
(bytevector-u8-set! k-opad i (fxxor #x5c (bytevector-u8-ref k-opad i))))
(let ((state (make-hash)))
(update! state k-ipad)
(for-each (lambda (d) (update! state d)) data)
(finish! state)
(let ((digest (->bytevector state)))
(clear! state)
(update! state k-opad)
(update! state digest)
(finish! state)
state)))))))
)
|
