Mercurial > emacs
annotate lisp/gnus/rfc2104.el @ 100233:6b0f142e0e58
Fix breakage by #870.
author | Juanma Barranquero <lekktu@gmail.com> |
---|---|
date | Fri, 05 Dec 2008 00:02:10 +0000 |
parents | f0689cd563e3 |
children | a9dc0e7c3f2b |
rev | line source |
---|---|
31717 | 1 ;;; rfc2104.el --- RFC2104 Hashed Message Authentication Codes |
64754
fafd692d1e40
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64085
diff
changeset
|
2 |
74548 | 3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
79708 | 4 ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
31717 | 5 |
6 ;; Author: Simon Josefsson <jas@pdc.kth.se> | |
7 ;; Keywords: mail | |
8 | |
9 ;; This file is part of GNU Emacs. | |
10 | |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
11 ;; GNU Emacs is free software: you can redistribute it and/or modify |
31717 | 12 ;; it under the terms of the GNU General Public License as published by |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
13 ;; the Free Software Foundation, either version 3 of the License, or |
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
14 ;; (at your option) any later version. |
31717 | 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 | |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
31717 | 19 ;; GNU General Public License for more details. |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
31717 | 23 |
24 ;;; Commentary: | |
25 | |
96853
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
26 ;; This is a high performance implementation of RFC2104. |
94761
c8f2d1ecfcc5
(rfc2104-hexstring-to-bitstring): Rename it back from
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94662
diff
changeset
|
27 ;; |
c8f2d1ecfcc5
(rfc2104-hexstring-to-bitstring): Rename it back from
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94662
diff
changeset
|
28 ;; Example: |
c8f2d1ecfcc5
(rfc2104-hexstring-to-bitstring): Rename it back from
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94662
diff
changeset
|
29 ;; |
c8f2d1ecfcc5
(rfc2104-hexstring-to-bitstring): Rename it back from
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94662
diff
changeset
|
30 ;; (require 'md5) |
c8f2d1ecfcc5
(rfc2104-hexstring-to-bitstring): Rename it back from
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94662
diff
changeset
|
31 ;; (rfc2104-hash 'md5 64 16 "Jefe" "what do ya want for nothing?") |
c8f2d1ecfcc5
(rfc2104-hexstring-to-bitstring): Rename it back from
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94662
diff
changeset
|
32 ;; "750c783e6ab0b503eaa86e310a5db738" |
c8f2d1ecfcc5
(rfc2104-hexstring-to-bitstring): Rename it back from
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94662
diff
changeset
|
33 ;; |
96853
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
34 ;; (require 'sha1) |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
35 ;; (rfc2104-hash 'sha1 64 20 "Jefe" "what do ya want for nothing?") |
94761
c8f2d1ecfcc5
(rfc2104-hexstring-to-bitstring): Rename it back from
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94662
diff
changeset
|
36 ;; "effcdf6ae5eb2fa2d27416d5f184df9c259a7c79" |
c8f2d1ecfcc5
(rfc2104-hexstring-to-bitstring): Rename it back from
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94662
diff
changeset
|
37 ;; |
c8f2d1ecfcc5
(rfc2104-hexstring-to-bitstring): Rename it back from
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94662
diff
changeset
|
38 ;; 64 is block length of hash function (64 for MD5 and SHA), 16 is |
c8f2d1ecfcc5
(rfc2104-hexstring-to-bitstring): Rename it back from
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94662
diff
changeset
|
39 ;; resulting hash length (16 for MD5, 20 for SHA). |
c8f2d1ecfcc5
(rfc2104-hexstring-to-bitstring): Rename it back from
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94662
diff
changeset
|
40 ;; |
c8f2d1ecfcc5
(rfc2104-hexstring-to-bitstring): Rename it back from
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94662
diff
changeset
|
41 ;; Tested with Emacs 20.2 and XEmacs 20.3. |
c8f2d1ecfcc5
(rfc2104-hexstring-to-bitstring): Rename it back from
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94662
diff
changeset
|
42 ;; |
c8f2d1ecfcc5
(rfc2104-hexstring-to-bitstring): Rename it back from
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94662
diff
changeset
|
43 ;; Test case reference: RFC 2202. |
31717 | 44 |
94761
c8f2d1ecfcc5
(rfc2104-hexstring-to-bitstring): Rename it back from
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94662
diff
changeset
|
45 ;;; History: |
c8f2d1ecfcc5
(rfc2104-hexstring-to-bitstring): Rename it back from
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94662
diff
changeset
|
46 |
c8f2d1ecfcc5
(rfc2104-hexstring-to-bitstring): Rename it back from
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94662
diff
changeset
|
47 ;; 1998-08-16 initial release posted to gnu.emacs.sources |
c8f2d1ecfcc5
(rfc2104-hexstring-to-bitstring): Rename it back from
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94662
diff
changeset
|
48 ;; 1998-08-17 use append instead of char-list-to-string |
c8f2d1ecfcc5
(rfc2104-hexstring-to-bitstring): Rename it back from
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94662
diff
changeset
|
49 ;; 1998-08-26 don't require hexl |
c8f2d1ecfcc5
(rfc2104-hexstring-to-bitstring): Rename it back from
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94662
diff
changeset
|
50 ;; 1998-09-25 renamed from hmac.el to rfc2104.el, also renamed functions |
c8f2d1ecfcc5
(rfc2104-hexstring-to-bitstring): Rename it back from
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94662
diff
changeset
|
51 ;; 1999-10-23 included in pgnus |
c8f2d1ecfcc5
(rfc2104-hexstring-to-bitstring): Rename it back from
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94662
diff
changeset
|
52 ;; 2000-08-15 `rfc2104-hexstring-to-bitstring' |
c8f2d1ecfcc5
(rfc2104-hexstring-to-bitstring): Rename it back from
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94662
diff
changeset
|
53 ;; 2000-05-12 added sha-1 example, added test case reference |
c8f2d1ecfcc5
(rfc2104-hexstring-to-bitstring): Rename it back from
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94662
diff
changeset
|
54 ;; 2003-11-13 change rfc2104-hexstring-to-bitstring to ...-byte-list |
96853
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
55 ;; 2008-04-25 rewrite rfc2104-hash for speed |
38413
a26d9b55abb6
Some fixes to follow coding conventions in files from Gnus.
Pavel Janík <Pavel@Janik.cz>
parents:
33321
diff
changeset
|
56 |
a26d9b55abb6
Some fixes to follow coding conventions in files from Gnus.
Pavel Janík <Pavel@Janik.cz>
parents:
33321
diff
changeset
|
57 ;;; Code: |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38413
diff
changeset
|
58 |
31717 | 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 | |
96853
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
67 (defconst rfc2104-nybbles |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
68 (let ((v (make-vector |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
69 ;; Find upper bound to save some space. |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
70 (1+ (max ?0 ?9 ?a ?f ?A ?F)) |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
71 ;; Use non-numeric default to catch bogus hex strings. |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
72 nil)) |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
73 (ls '((?0 . 0) (?a . 10) (?A . 10) |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
74 (?1 . 1) (?b . 11) (?B . 11) |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
75 (?2 . 2) (?c . 12) (?C . 12) |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
76 (?3 . 3) (?d . 13) (?D . 13) |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
77 (?4 . 4) (?e . 14) (?E . 14) |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
78 (?5 . 5) (?f . 15) (?F . 15) |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
79 (?6 . 6) |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
80 (?7 . 7) |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
81 (?8 . 8) |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
82 (?9 . 9)))) |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
83 (while ls |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
84 (aset v (caar ls) (cdar ls)) |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
85 (setq ls (cdr ls))) |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
86 v)) |
33321
2f030bbc6aa8
2000-11-09 Simon Josefsson <simon@josefsson.org>
Dave Love <fx@gnu.org>
parents:
31717
diff
changeset
|
87 |
97350 | 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 | |
31717 | 96 (defun rfc2104-hash (hash block-length hash-length key text) |
97 (let* (;; if key is longer than B, reset it to HASH(key) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38413
diff
changeset
|
98 (key (if (> (length key) block-length) |
31717 | 99 (funcall hash key) key)) |
96853
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
100 (len (length key)) |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
101 (ipad (make-string block-length rfc2104-ipad)) |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
102 (opad (make-string (+ block-length hash-length) rfc2104-opad)) |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
103 c partial) |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
104 ;; Prefix *pad with key, appropriately XORed. |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
105 (do ((i 0 (1+ i))) |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
106 ((= len i)) |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
107 (setq c (aref key i)) |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
108 (aset ipad i (logxor rfc2104-ipad c)) |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
109 (aset opad i (logxor rfc2104-opad c))) |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
110 ;; Perform inner hash. |
97350 | 111 (setq partial (rfc2104-string-make-unibyte |
112 (funcall hash (concat ipad text)))) | |
96853
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
113 ;; Pack latter part of opad. |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
114 (do ((r 0 (+ 2 r)) |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
115 (w block-length (1+ w))) |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
116 ((= (* 2 hash-length) r)) |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
117 (aset opad w |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
118 (+ (* 16 (aref rfc2104-nybbles (aref partial r))) |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
119 ( aref rfc2104-nybbles (aref partial (1+ r)))))) |
89f46e95065e
Rewrite rfc2104-hash for speed.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
94761
diff
changeset
|
120 ;; Perform outer hash. |
97350 | 121 (rfc2104-string-make-unibyte (funcall hash opad)))) |
31717 | 122 |
123 (provide 'rfc2104) | |
124 | |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91327
diff
changeset
|
125 ;; arch-tag: cf671d5c-a45f-4a09-815e-704e59e43950 |
31717 | 126 ;;; rfc2104.el ends here |