| ;;;; hmac.lisp -- RFC 2104 keyed hashing for message authentication (in-package :crypto) ;;; FIXME: this actually should be dependent upon the blocksize of the ;;; chosen hash function. This only works because all the hash functions ;;; we support have a 64-byte block size. (defconstant +hmac-blocksize+ 64) (defclass hmac () ((inner-digest :reader inner-digest :initarg :inner-digest) (outer-digest :reader outer-digest :initarg :outer-digest))) (defun make-hmac (key digest-name) (declare (type (simple-array (unsigned-byte 8) (*)) key)) (let ((inner (make-digest digest-name)) (outer (make-digest digest-name)) (inner-padding (make-array +hmac-blocksize+ :element-type '(unsigned-byte 8) :initial-element #x36)) (outer-padding (make-array +hmac-blocksize+ :element-type '(unsigned-byte 8) :initial-element #x5c)) (padded-key (make-array +hmac-blocksize+ :element-type '(unsigned-byte 8) :initial-element 0))) (declare (type (simple-array (unsigned-byte 8) (64)) inner-padding outer-padding padded-key)) (when (> (length key) +hmac-blocksize+) (setf key (digest-sequence digest-name key))) (replace padded-key key) (xor-block +hmac-blocksize+ padded-key inner-padding 0 inner-padding 0) (update-digest inner inner-padding) (xor-block +hmac-blocksize+ padded-key outer-padding 0 outer-padding 0) (update-digest outer outer-padding) (make-instance 'hmac :inner-digest inner :outer-digest outer))) (defun update-hmac (hmac sequence &key (start 0) end) (declare (type (simple-array (unsigned-byte 8) (*)) sequence)) (update-digest (inner-digest hmac) sequence :start start :end end) hmac) (defun hmac-digest (hmac) (let ((x (copy-digest (outer-digest hmac)))) (update-digest x (produce-digest (inner-digest hmac))) (produce-digest x))) |