| 1 | ;;; rfc2104.el --- RFC2104 Hashed Message Authentication Codes |
| 2 | ;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. |
| 3 | |
| 4 | ;; Author: Simon Josefsson <jas@pdc.kth.se> |
| 5 | ;; Keywords: mail |
| 6 | |
| 7 | ;; This file is part of GNU Emacs. |
| 8 | |
| 9 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 10 | ;; it under the terms of the GNU General Public License as published by |
| 11 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 12 | ;; any later version. |
| 13 | |
| 14 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 17 | ;; GNU General Public License for more details. |
| 18 | |
| 19 | ;; You should have received a copy of the GNU General Public License |
| 20 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 21 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 22 | ;; Boston, MA 02111-1307, USA. |
| 23 | |
| 24 | ;;; Commentary: |
| 25 | |
| 26 | ;;; This is a quick'n'dirty, low performance, implementation of RFC2104. |
| 27 | ;;; |
| 28 | ;;; Example: |
| 29 | ;;; |
| 30 | ;;; (require 'md5) |
| 31 | ;;; (rfc2104-hash 'md5 64 16 "Jefe" "what do ya want for nothing?") |
| 32 | ;;; "750c783e6ab0b503eaa86e310a5db738" |
| 33 | ;;; |
| 34 | ;;; (require 'sha-1) |
| 35 | ;;; (rfc2104-hash 'sha1-encode 64 20 "Jefe" "what do ya want for nothing?") |
| 36 | ;;; "effcdf6ae5eb2fa2d27416d5f184df9c259a7c79" |
| 37 | ;;; |
| 38 | ;;; 64 is block length of hash function (64 for MD5 and SHA), 16 is |
| 39 | ;;; resulting hash length (16 for MD5, 20 for SHA). |
| 40 | ;;; |
| 41 | ;;; Tested with Emacs 20.2 and XEmacs 20.3. |
| 42 | ;;; |
| 43 | ;;; Test case reference: RFC 2202. |
| 44 | |
| 45 | ;;; Release history: |
| 46 | ;;; |
| 47 | ;;; 1998-08-16 initial release posted to gnu.emacs.sources |
| 48 | ;;; 1998-08-17 use append instead of char-list-to-string |
| 49 | ;;; 1998-08-26 don't require hexl |
| 50 | ;;; 1998-09-25 renamed from hmac.el to rfc2104.el, also renamed functions |
| 51 | ;;; 1999-10-23 included in pgnus |
| 52 | ;;; 2000-08-15 `rfc2104-hexstring-to-bitstring' |
| 53 | ;;; 2000-05-12 added sha-1 example, added test case reference |
| 54 | |
| 55 | (eval-when-compile (require 'cl)) |
| 56 | |
| 57 | ;; Magic character for inner HMAC round. 0x36 == 54 == '6' |
| 58 | (defconst rfc2104-ipad ?\x36) |
| 59 | |
| 60 | ;; Magic character for outer HMAC round. 0x5C == 92 == '\' |
| 61 | (defconst rfc2104-opad ?\x5C) |
| 62 | |
| 63 | ;; Not so magic character for padding the key. 0x00 |
| 64 | (defconst rfc2104-zero ?\x00) |
| 65 | |
| 66 | ;; Alist for converting hex to decimal. |
| 67 | (defconst rfc2104-hex-alist |
| 68 | '((?0 . 0) (?a . 10) (?A . 10) |
| 69 | (?1 . 1) (?b . 11) (?B . 11) |
| 70 | (?2 . 2) (?c . 12) (?C . 12) |
| 71 | (?3 . 3) (?d . 13) (?D . 13) |
| 72 | (?4 . 4) (?e . 14) (?E . 14) |
| 73 | (?5 . 5) (?f . 15) (?F . 15) |
| 74 | (?6 . 6) |
| 75 | (?7 . 7) |
| 76 | (?8 . 8) |
| 77 | (?9 . 9))) |
| 78 | |
| 79 | (defun rfc2104-hex-to-int (str) |
| 80 | (if str |
| 81 | (if (listp str) |
| 82 | (+ (* 16 (rfc2104-hex-to-int (cdr str))) |
| 83 | (cdr (assoc (car str) rfc2104-hex-alist))) |
| 84 | (rfc2104-hex-to-int (reverse (append str nil)))) |
| 85 | 0)) |
| 86 | |
| 87 | (defun rfc2104-hexstring-to-bitstring (str) |
| 88 | (let (out) |
| 89 | (while (< 0 (length str)) |
| 90 | (push (rfc2104-hex-to-int (substring str -2)) out) |
| 91 | (setq str (substring str 0 -2))) |
| 92 | (concat out))) |
| 93 | |
| 94 | (defun rfc2104-hash (hash block-length hash-length key text) |
| 95 | (let* (;; if key is longer than B, reset it to HASH(key) |
| 96 | (key (if (> (length key) block-length) |
| 97 | (funcall hash key) key)) |
| 98 | (k_ipad (append key nil)) |
| 99 | (k_opad (append key nil))) |
| 100 | ;; zero pad k_ipad/k_opad |
| 101 | (while (< (length k_ipad) block-length) |
| 102 | (setq k_ipad (append k_ipad (list rfc2104-zero)))) |
| 103 | (while (< (length k_opad) block-length) |
| 104 | (setq k_opad (append k_opad (list rfc2104-zero)))) |
| 105 | ;; XOR key with ipad/opad into k_ipad/k_opad |
| 106 | (setq k_ipad (mapcar (lambda (c) (logxor c rfc2104-ipad)) k_ipad)) |
| 107 | (setq k_opad (mapcar (lambda (c) (logxor c rfc2104-opad)) k_opad)) |
| 108 | ;; perform outer hash |
| 109 | (funcall hash (concat k_opad (rfc2104-hexstring-to-bitstring |
| 110 | ;; perform inner hash |
| 111 | (funcall hash (concat k_ipad text))))))) |
| 112 | |
| 113 | (provide 'rfc2104) |
| 114 | |
| 115 | ;;; rfc2104.el ends here |