rfc2104.el 3.84 KB
Newer Older
Gerd Moellmann's avatar
Gerd Moellmann committed
1
;;; rfc2104.el --- RFC2104 Hashed Message Authentication Codes
2
;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
Gerd Moellmann's avatar
Gerd Moellmann committed
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

;; Author: Simon Josefsson <jas@pdc.kth.se>
;; Keywords: mail

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;;; This is a quick'n'dirty, low performance, implementation of RFC2104.
;;;
;;; Example:
;;;
;;; (require 'md5)
;;; (rfc2104-hash 'md5 64 16 "Jefe" "what do ya want for nothing?")
;;; "750c783e6ab0b503eaa86e310a5db738"
;;;
34 35 36 37
;;; (require 'sha-1)
;;; (rfc2104-hash 'sha1-encode 64 20 "Jefe" "what do ya want for nothing?")
;;; "effcdf6ae5eb2fa2d27416d5f184df9c259a7c79"
;;;
Gerd Moellmann's avatar
Gerd Moellmann committed
38 39 40 41
;;; 64 is block length of hash function (64 for MD5 and SHA), 16 is
;;; resulting hash length (16 for MD5, 20 for SHA).
;;;
;;; Tested with Emacs 20.2 and XEmacs 20.3.
42 43
;;;
;;; Test case reference: RFC 2202.
Gerd Moellmann's avatar
Gerd Moellmann committed
44 45 46 47 48 49 50 51

;;; Release history:
;;;
;;; 1998-08-16  initial release posted to gnu.emacs.sources
;;; 1998-08-17  use append instead of char-list-to-string
;;; 1998-08-26  don't require hexl
;;; 1998-09-25  renamed from hmac.el to rfc2104.el, also renamed functions
;;; 1999-10-23  included in pgnus
52 53
;;; 2000-08-15  `rfc2104-hexstring-to-bitstring'
;;; 2000-05-12  added sha-1 example, added test case reference
Gerd Moellmann's avatar
Gerd Moellmann committed
54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86
 
(eval-when-compile (require 'cl))

;; Magic character for inner HMAC round. 0x36 == 54 == '6'
(defconst rfc2104-ipad ?\x36)

;; Magic character for outer HMAC round. 0x5C == 92 == '\'
(defconst rfc2104-opad ?\x5C)

;; Not so magic character for padding the key. 0x00
(defconst rfc2104-zero ?\x00)

;; Alist for converting hex to decimal.
(defconst rfc2104-hex-alist 
  '((?0 . 0)	      (?a . 10)	      (?A . 10)
    (?1 . 1)	      (?b . 11)	      (?B . 11)
    (?2 . 2)	      (?c . 12)	      (?C . 12)
    (?3 . 3)	      (?d . 13)	      (?D . 13)
    (?4 . 4)	      (?e . 14)	      (?E . 14)
    (?5 . 5)	      (?f . 15)	      (?F . 15)
    (?6 . 6)
    (?7 . 7)
    (?8 . 8)
    (?9 . 9)))

(defun rfc2104-hex-to-int (str)
  (if str
      (if (listp str)
	  (+ (* 16 (rfc2104-hex-to-int (cdr str)))
	     (cdr (assoc (car str) rfc2104-hex-alist)))
	(rfc2104-hex-to-int (reverse (append str nil))))
    0))

87 88 89 90 91 92 93
(defun rfc2104-hexstring-to-bitstring (str)
  (let (out)
    (while (< 0 (length str))
      (push (rfc2104-hex-to-int (substring str -2)) out)
      (setq str (substring str 0 -2)))
    (concat out)))

Gerd Moellmann's avatar
Gerd Moellmann committed
94 95 96 97 98 99 100 101 102 103 104 105 106 107
(defun rfc2104-hash (hash block-length hash-length key text)
  (let* (;; if key is longer than B, reset it to HASH(key)
	 (key (if (> (length key) block-length) 
		  (funcall hash key) key))
	 (k_ipad (append key nil))
	 (k_opad (append key nil)))
    ;; zero pad k_ipad/k_opad
    (while (< (length k_ipad) block-length)
      (setq k_ipad (append k_ipad (list rfc2104-zero))))
    (while (< (length k_opad) block-length)
      (setq k_opad (append k_opad (list rfc2104-zero))))
    ;; XOR key with ipad/opad into k_ipad/k_opad
    (setq k_ipad (mapcar (lambda (c) (logxor c rfc2104-ipad)) k_ipad))
    (setq k_opad (mapcar (lambda (c) (logxor c rfc2104-opad)) k_opad))
108 109 110 111
    ;; perform outer hash
    (funcall hash (concat k_opad (rfc2104-hexstring-to-bitstring
				  ;; perform inner hash
				  (funcall hash (concat k_ipad text)))))))
Gerd Moellmann's avatar
Gerd Moellmann committed
112 113 114 115

(provide 'rfc2104)

;;; rfc2104.el ends here