Commit | Line | Data |
---|---|---|
c113de23 | 1 | ;;; rfc2104.el --- RFC2104 Hashed Message Authentication Codes |
e84b4b86 | 2 | |
61e1e4e8 | 3 | ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
114f9c96 | 4 | ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
c113de23 GM |
5 | |
6 | ;; Author: Simon Josefsson <jas@pdc.kth.se> | |
7 | ;; Keywords: mail | |
8 | ||
9 | ;; This file is part of GNU Emacs. | |
10 | ||
5e809f55 | 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
c113de23 | 12 | ;; it under the terms of the GNU General Public License as published by |
5e809f55 GM |
13 | ;; the Free Software Foundation, either version 3 of the License, or |
14 | ;; (at your option) any later version. | |
c113de23 GM |
15 | |
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
5e809f55 | 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
c113de23 GM |
19 | ;; GNU General Public License for more details. |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
5e809f55 | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
c113de23 GM |
23 | |
24 | ;;; Commentary: | |
25 | ||
b737c3d9 | 26 | ;; This is a high performance implementation of RFC2104. |
4fedcc00 SM |
27 | ;; |
28 | ;; Example: | |
29 | ;; | |
30 | ;; (require 'md5) | |
31 | ;; (rfc2104-hash 'md5 64 16 "Jefe" "what do ya want for nothing?") | |
32 | ;; "750c783e6ab0b503eaa86e310a5db738" | |
33 | ;; | |
b737c3d9 TTN |
34 | ;; (require 'sha1) |
35 | ;; (rfc2104-hash 'sha1 64 20 "Jefe" "what do ya want for nothing?") | |
4fedcc00 SM |
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 | ;;; 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 | ;; 2003-11-13 change rfc2104-hexstring-to-bitstring to ...-byte-list | |
b737c3d9 | 55 | ;; 2008-04-25 rewrite rfc2104-hash for speed |
715a2ca2 PJ |
56 | |
57 | ;;; Code: | |
a1506d29 | 58 | |
c113de23 GM |
59 | (eval-when-compile (require 'cl)) |
60 | ||
61 | ;; Magic character for inner HMAC round. 0x36 == 54 == '6' | |
62 | (defconst rfc2104-ipad ?\x36) | |
63 | ||
64 | ;; Magic character for outer HMAC round. 0x5C == 92 == '\' | |
65 | (defconst rfc2104-opad ?\x5C) | |
66 | ||
b737c3d9 TTN |
67 | (defconst rfc2104-nybbles |
68 | (let ((v (make-vector | |
69 | ;; Find upper bound to save some space. | |
70 | (1+ (max ?0 ?9 ?a ?f ?A ?F)) | |
71 | ;; Use non-numeric default to catch bogus hex strings. | |
72 | nil)) | |
73 | (ls '((?0 . 0) (?a . 10) (?A . 10) | |
74 | (?1 . 1) (?b . 11) (?B . 11) | |
75 | (?2 . 2) (?c . 12) (?C . 12) | |
76 | (?3 . 3) (?d . 13) (?D . 13) | |
77 | (?4 . 4) (?e . 14) (?E . 14) | |
78 | (?5 . 5) (?f . 15) (?F . 15) | |
79 | (?6 . 6) | |
80 | (?7 . 7) | |
81 | (?8 . 8) | |
82 | (?9 . 9)))) | |
83 | (while ls | |
84 | (aset v (caar ls) (cdar ls)) | |
85 | (setq ls (cdr ls))) | |
86 | v)) | |
62e8183e | 87 | |
6ecfe5c2 MB |
88 | (eval-when-compile |
89 | (defmacro rfc2104-string-make-unibyte (string) | |
90 | "Return the unibyte equivalent of STRING. | |
91 | In XEmacs return just STRING." | |
92 | (if (featurep 'xemacs) | |
93 | string | |
94 | `(string-make-unibyte ,string)))) | |
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 | 99 | (funcall hash key) key)) |
b737c3d9 TTN |
100 | (len (length key)) |
101 | (ipad (make-string block-length rfc2104-ipad)) | |
102 | (opad (make-string (+ block-length hash-length) rfc2104-opad)) | |
103 | c partial) | |
104 | ;; Prefix *pad with key, appropriately XORed. | |
105 | (do ((i 0 (1+ i))) | |
106 | ((= len i)) | |
107 | (setq c (aref key i)) | |
108 | (aset ipad i (logxor rfc2104-ipad c)) | |
109 | (aset opad i (logxor rfc2104-opad c))) | |
110 | ;; Perform inner hash. | |
6ecfe5c2 MB |
111 | (setq partial (rfc2104-string-make-unibyte |
112 | (funcall hash (concat ipad text)))) | |
b737c3d9 TTN |
113 | ;; Pack latter part of opad. |
114 | (do ((r 0 (+ 2 r)) | |
115 | (w block-length (1+ w))) | |
116 | ((= (* 2 hash-length) r)) | |
117 | (aset opad w | |
118 | (+ (* 16 (aref rfc2104-nybbles (aref partial r))) | |
119 | ( aref rfc2104-nybbles (aref partial (1+ r)))))) | |
120 | ;; Perform outer hash. | |
6ecfe5c2 | 121 | (rfc2104-string-make-unibyte (funcall hash opad)))) |
c113de23 GM |
122 | |
123 | (provide 'rfc2104) | |
124 | ||
125 | ;;; rfc2104.el ends here |