Commit | Line | Data |
---|---|---|
c113de23 | 1 | ;;; rfc2104.el --- RFC2104 Hashed Message Authentication Codes |
62e8183e | 2 | ;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. |
c113de23 GM |
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 | ;;; | |
62e8183e DL |
34 | ;;; (require 'sha-1) |
35 | ;;; (rfc2104-hash 'sha1-encode 64 20 "Jefe" "what do ya want for nothing?") | |
36 | ;;; "effcdf6ae5eb2fa2d27416d5f184df9c259a7c79" | |
37 | ;;; | |
c113de23 GM |
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. | |
62e8183e DL |
42 | ;;; |
43 | ;;; Test case reference: RFC 2202. | |
c113de23 GM |
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 | |
62e8183e DL |
52 | ;;; 2000-08-15 `rfc2104-hexstring-to-bitstring' |
53 | ;;; 2000-05-12 added sha-1 example, added test case reference | |
715a2ca2 PJ |
54 | |
55 | ;;; Code: | |
a1506d29 | 56 | |
c113de23 GM |
57 | (eval-when-compile (require 'cl)) |
58 | ||
59 | ;; Magic character for inner HMAC round. 0x36 == 54 == '6' | |
60 | (defconst rfc2104-ipad ?\x36) | |
61 | ||
62 | ;; Magic character for outer HMAC round. 0x5C == 92 == '\' | |
63 | (defconst rfc2104-opad ?\x5C) | |
64 | ||
65 | ;; Not so magic character for padding the key. 0x00 | |
66 | (defconst rfc2104-zero ?\x00) | |
67 | ||
68 | ;; Alist for converting hex to decimal. | |
a1506d29 | 69 | (defconst rfc2104-hex-alist |
c113de23 GM |
70 | '((?0 . 0) (?a . 10) (?A . 10) |
71 | (?1 . 1) (?b . 11) (?B . 11) | |
72 | (?2 . 2) (?c . 12) (?C . 12) | |
73 | (?3 . 3) (?d . 13) (?D . 13) | |
74 | (?4 . 4) (?e . 14) (?E . 14) | |
75 | (?5 . 5) (?f . 15) (?F . 15) | |
76 | (?6 . 6) | |
77 | (?7 . 7) | |
78 | (?8 . 8) | |
79 | (?9 . 9))) | |
80 | ||
81 | (defun rfc2104-hex-to-int (str) | |
82 | (if str | |
83 | (if (listp str) | |
84 | (+ (* 16 (rfc2104-hex-to-int (cdr str))) | |
85 | (cdr (assoc (car str) rfc2104-hex-alist))) | |
86 | (rfc2104-hex-to-int (reverse (append str nil)))) | |
87 | 0)) | |
88 | ||
62e8183e DL |
89 | (defun rfc2104-hexstring-to-bitstring (str) |
90 | (let (out) | |
91 | (while (< 0 (length str)) | |
92 | (push (rfc2104-hex-to-int (substring str -2)) out) | |
93 | (setq str (substring str 0 -2))) | |
94 | (concat out))) | |
95 | ||
c113de23 GM |
96 | (defun rfc2104-hash (hash block-length hash-length key text) |
97 | (let* (;; if key is longer than B, reset it to HASH(key) | |
a1506d29 | 98 | (key (if (> (length key) block-length) |
c113de23 GM |
99 | (funcall hash key) key)) |
100 | (k_ipad (append key nil)) | |
101 | (k_opad (append key nil))) | |
102 | ;; zero pad k_ipad/k_opad | |
103 | (while (< (length k_ipad) block-length) | |
104 | (setq k_ipad (append k_ipad (list rfc2104-zero)))) | |
105 | (while (< (length k_opad) block-length) | |
106 | (setq k_opad (append k_opad (list rfc2104-zero)))) | |
107 | ;; XOR key with ipad/opad into k_ipad/k_opad | |
108 | (setq k_ipad (mapcar (lambda (c) (logxor c rfc2104-ipad)) k_ipad)) | |
109 | (setq k_opad (mapcar (lambda (c) (logxor c rfc2104-opad)) k_opad)) | |
62e8183e DL |
110 | ;; perform outer hash |
111 | (funcall hash (concat k_opad (rfc2104-hexstring-to-bitstring | |
112 | ;; perform inner hash | |
113 | (funcall hash (concat k_ipad text))))))) | |
c113de23 GM |
114 | |
115 | (provide 'rfc2104) | |
116 | ||
ab5796a9 | 117 | ;;; arch-tag: cf671d5c-a45f-4a09-815e-704e59e43950 |
c113de23 | 118 | ;;; rfc2104.el ends here |