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