Commit | Line | Data |
---|---|---|
c113de23 GM |
1 | ;;; rfc2104.el --- RFC2104 Hashed Message Authentication Codes |
2 | ;; Copyright (C) 1998,1999 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 | ;;; 64 is block length of hash function (64 for MD5 and SHA), 16 is | |
35 | ;;; resulting hash length (16 for MD5, 20 for SHA). | |
36 | ;;; | |
37 | ;;; Tested with Emacs 20.2 and XEmacs 20.3. | |
38 | ||
39 | ;;; Release history: | |
40 | ;;; | |
41 | ;;; 1998-08-16 initial release posted to gnu.emacs.sources | |
42 | ;;; 1998-08-17 use append instead of char-list-to-string | |
43 | ;;; 1998-08-26 don't require hexl | |
44 | ;;; 1998-09-25 renamed from hmac.el to rfc2104.el, also renamed functions | |
45 | ;;; 1999-10-23 included in pgnus | |
46 | ||
47 | (eval-when-compile (require 'cl)) | |
48 | ||
49 | ;; Magic character for inner HMAC round. 0x36 == 54 == '6' | |
50 | (defconst rfc2104-ipad ?\x36) | |
51 | ||
52 | ;; Magic character for outer HMAC round. 0x5C == 92 == '\' | |
53 | (defconst rfc2104-opad ?\x5C) | |
54 | ||
55 | ;; Not so magic character for padding the key. 0x00 | |
56 | (defconst rfc2104-zero ?\x00) | |
57 | ||
58 | ;; Alist for converting hex to decimal. | |
59 | (defconst rfc2104-hex-alist | |
60 | '((?0 . 0) (?a . 10) (?A . 10) | |
61 | (?1 . 1) (?b . 11) (?B . 11) | |
62 | (?2 . 2) (?c . 12) (?C . 12) | |
63 | (?3 . 3) (?d . 13) (?D . 13) | |
64 | (?4 . 4) (?e . 14) (?E . 14) | |
65 | (?5 . 5) (?f . 15) (?F . 15) | |
66 | (?6 . 6) | |
67 | (?7 . 7) | |
68 | (?8 . 8) | |
69 | (?9 . 9))) | |
70 | ||
71 | (defun rfc2104-hex-to-int (str) | |
72 | (if str | |
73 | (if (listp str) | |
74 | (+ (* 16 (rfc2104-hex-to-int (cdr str))) | |
75 | (cdr (assoc (car str) rfc2104-hex-alist))) | |
76 | (rfc2104-hex-to-int (reverse (append str nil)))) | |
77 | 0)) | |
78 | ||
79 | (defun rfc2104-hash (hash block-length hash-length key text) | |
80 | (let* (;; if key is longer than B, reset it to HASH(key) | |
81 | (key (if (> (length key) block-length) | |
82 | (funcall hash key) key)) | |
83 | (k_ipad (append key nil)) | |
84 | (k_opad (append key nil))) | |
85 | ;; zero pad k_ipad/k_opad | |
86 | (while (< (length k_ipad) block-length) | |
87 | (setq k_ipad (append k_ipad (list rfc2104-zero)))) | |
88 | (while (< (length k_opad) block-length) | |
89 | (setq k_opad (append k_opad (list rfc2104-zero)))) | |
90 | ;; XOR key with ipad/opad into k_ipad/k_opad | |
91 | (setq k_ipad (mapcar (lambda (c) (logxor c rfc2104-ipad)) k_ipad)) | |
92 | (setq k_opad (mapcar (lambda (c) (logxor c rfc2104-opad)) k_opad)) | |
93 | ;; perform inner hash | |
94 | (let ((first-round (funcall hash (concat k_ipad text))) | |
95 | de-hexed) | |
96 | (while (< 0 (length first-round)) | |
97 | (push (rfc2104-hex-to-int (substring first-round -2)) de-hexed) | |
98 | (setq first-round (substring first-round 0 -2))) | |
99 | ;; perform outer hash | |
100 | (funcall hash (concat k_opad de-hexed))))) | |
101 | ||
102 | (provide 'rfc2104) | |
103 | ||
104 | ;;; rfc2104.el ends here |