Commit | Line | Data |
---|---|---|
eec82323 LMI |
1 | ;;; md5.el -- MD5 Message Digest Algorithm |
2 | ;;; Gareth Rees <gdr11@cl.cam.ac.uk> | |
3 | ||
4 | ;; LCD Archive Entry: | |
5 | ;; md5|Gareth Rees|gdr11@cl.cam.ac.uk| | |
6 | ;; MD5 cryptographic message digest algorithm| | |
7 | ;; 13-Nov-95|1.0|~/misc/md5.el.Z| | |
8 | ||
9 | ;;; Details: ------------------------------------------------------------------ | |
10 | ||
11 | ;; This is a direct translation into Emacs LISP of the reference C | |
12 | ;; implementation of the MD5 Message-Digest Algorithm written by RSA | |
13 | ;; Data Security, Inc. | |
14 | ;; | |
15 | ;; The algorithm takes a message (that is, a string of bytes) and | |
16 | ;; computes a 16-byte checksum or "digest" for the message. This digest | |
17 | ;; is supposed to be cryptographically strong in the sense that if you | |
18 | ;; are given a 16-byte digest D, then there is no easier way to | |
19 | ;; construct a message whose digest is D than to exhaustively search the | |
20 | ;; space of messages. However, the robustness of the algorithm has not | |
21 | ;; been proven, and a similar algorithm (MD4) was shown to be unsound, | |
22 | ;; so treat with caution! | |
23 | ;; | |
24 | ;; The C algorithm uses 32-bit integers; because GNU Emacs | |
25 | ;; implementations provide 28-bit integers (with 24-bit integers on | |
26 | ;; versions prior to 19.29), the code represents a 32-bit integer as the | |
27 | ;; cons of two 16-bit integers. The most significant word is stored in | |
28 | ;; the car and the least significant in the cdr. The algorithm requires | |
29 | ;; at least 17 bits of integer representation in order to represent the | |
30 | ;; carry from a 16-bit addition. | |
31 | ||
32 | ;;; Usage: -------------------------------------------------------------------- | |
33 | ||
34 | ;; To compute the MD5 Message Digest for a message M (represented as a | |
35 | ;; string or as a vector of bytes), call | |
36 | ;; | |
37 | ;; (md5-encode M) | |
38 | ;; | |
39 | ;; which returns the message digest as a vector of 16 bytes. If you | |
40 | ;; need to supply the message in pieces M1, M2, ... Mn, then call | |
41 | ;; | |
42 | ;; (md5-init) | |
43 | ;; (md5-update M1) | |
44 | ;; (md5-update M2) | |
45 | ;; ... | |
46 | ;; (md5-update Mn) | |
47 | ;; (md5-final) | |
48 | ||
49 | ;;; Copyright and licence: ---------------------------------------------------- | |
50 | ||
51 | ;; Copyright (C) 1995 by Gareth Rees | |
52 | ;; Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm | |
53 | ;; | |
54 | ;; md5.el is free software; you can redistribute it and/or modify it | |
55 | ;; under the terms of the GNU General Public License as published by the | |
56 | ;; Free Software Foundation; either version 2, or (at your option) any | |
57 | ;; later version. | |
58 | ;; | |
59 | ;; md5.el is distributed in the hope that it will be useful, but WITHOUT | |
60 | ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
61 | ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
62 | ;; for more details. | |
63 | ;; | |
64 | ;; The original copyright notice is given below, as required by the | |
65 | ;; licence for the original code. This code is distributed under *both* | |
66 | ;; RSA's original licence and the GNU General Public Licence. (There | |
67 | ;; should be no problems, as the former is more liberal than the | |
68 | ;; latter). | |
69 | ||
70 | ;;; Original copyright notice: ------------------------------------------------ | |
71 | ||
72 | ;; Copyright (C) 1990, RSA Data Security, Inc. All rights reserved. | |
73 | ;; | |
74 | ;; License to copy and use this software is granted provided that it is | |
75 | ;; identified as the "RSA Data Security, Inc. MD5 Message- Digest | |
76 | ;; Algorithm" in all material mentioning or referencing this software or | |
77 | ;; this function. | |
78 | ;; | |
79 | ;; License is also granted to make and use derivative works provided | |
80 | ;; that such works are identified as "derived from the RSA Data | |
81 | ;; Security, Inc. MD5 Message-Digest Algorithm" in all material | |
82 | ;; mentioning or referencing the derived work. | |
83 | ;; | |
84 | ;; RSA Data Security, Inc. makes no representations concerning either | |
85 | ;; the merchantability of this software or the suitability of this | |
86 | ;; software for any particular purpose. It is provided "as is" without | |
87 | ;; express or implied warranty of any kind. | |
88 | ;; | |
89 | ;; These notices must be retained in any copies of any part of this | |
90 | ;; documentation and/or software. | |
91 | ||
92 | ;;; Code: --------------------------------------------------------------------- | |
93 | ||
94 | (defvar md5-program "md5" | |
95 | "*Program that reads a message on its standard input and writes an | |
96 | MD5 digest on its output.") | |
97 | ||
98 | (defvar md5-maximum-internal-length 4096 | |
99 | "*The maximum size of a piece of data that should use the MD5 routines | |
100 | written in lisp. If a message exceeds this, it will be run through an | |
101 | external filter for processing. Also see the `md5-program' variable. | |
102 | This variable has no effect if you call the md5-init|update|final | |
103 | functions - only used by the `md5' function's simpler interface.") | |
104 | ||
105 | (defvar md5-bits (make-vector 4 0) | |
106 | "Number of bits handled, modulo 2^64. | |
107 | Represented as four 16-bit numbers, least significant first.") | |
108 | (defvar md5-buffer (make-vector 4 '(0 . 0)) | |
109 | "Scratch buffer (four 32-bit integers).") | |
110 | (defvar md5-input (make-vector 64 0) | |
111 | "Input buffer (64 bytes).") | |
112 | ||
113 | (defun md5-unhex (x) | |
114 | (if (> x ?9) | |
115 | (if (>= x ?a) | |
116 | (+ 10 (- x ?a)) | |
117 | (+ 10 (- x ?A))) | |
118 | (- x ?0))) | |
119 | ||
120 | (defun md5-encode (message) | |
121 | "Encodes MESSAGE using the MD5 message digest algorithm. | |
122 | MESSAGE must be a string or an array of bytes. | |
123 | Returns a vector of 16 bytes containing the message digest." | |
124 | (if (<= (length message) md5-maximum-internal-length) | |
125 | (progn | |
126 | (md5-init) | |
127 | (md5-update message) | |
128 | (md5-final)) | |
129 | (save-excursion | |
130 | (set-buffer (get-buffer-create " *md5-work*")) | |
131 | (erase-buffer) | |
132 | (insert message) | |
133 | (call-process-region (point-min) (point-max) | |
134 | (or shell-file-name "/bin/sh") | |
135 | t (current-buffer) nil | |
136 | "-c" md5-program) | |
137 | ;; MD5 digest is 32 chars long | |
138 | ;; mddriver adds a newline to make neaten output for tty | |
139 | ;; viewing, make sure we leave it behind. | |
140 | (let ((data (buffer-substring (point-min) (+ (point-min) 32))) | |
141 | (vec (make-vector 16 0)) | |
142 | (ctr 0)) | |
143 | (while (< ctr 16) | |
144 | (aset vec ctr (+ (* 16 (md5-unhex (aref data (* ctr 2)))) | |
145 | (md5-unhex (aref data (1+ (* ctr 2)))))) | |
146 | (setq ctr (1+ ctr))))))) | |
147 | ||
148 | (defsubst md5-add (x y) | |
149 | "Return 32-bit sum of 32-bit integers X and Y." | |
150 | (let ((m (+ (car x) (car y))) | |
151 | (l (+ (cdr x) (cdr y)))) | |
152 | (cons (logand 65535 (+ m (lsh l -16))) (logand l 65535)))) | |
153 | ||
154 | ;; FF, GG, HH and II are basic MD5 functions, providing transformations | |
155 | ;; for rounds 1, 2, 3 and 4 respectively. Each function follows this | |
156 | ;; pattern of computation (where ROTATE(x,y) means rotate 32-bit value x | |
157 | ;; by y bits to the left): | |
158 | ;; | |
159 | ;; FF(a,b,c,d,x,s,ac) = ROTATE(a + F(b,c,d) + x + ac,s) + b | |
160 | ;; | |
161 | ;; so we use the macro `md5-make-step' to construct each one. The | |
162 | ;; helper functions F, G, H and I operate on 16-bit numbers; the full | |
163 | ;; operation splits its inputs, operates on the halves separately and | |
164 | ;; then puts the results together. | |
165 | ||
166 | (defsubst md5-F (x y z) (logior (logand x y) (logand (lognot x) z))) | |
167 | (defsubst md5-G (x y z) (logior (logand x z) (logand y (lognot z)))) | |
168 | (defsubst md5-H (x y z) (logxor x y z)) | |
169 | (defsubst md5-I (x y z) (logxor y (logior x (logand 65535 (lognot z))))) | |
170 | ||
171 | (defmacro md5-make-step (name func) | |
172 | (` | |
173 | (defun (, name) (a b c d x s ac) | |
174 | (let* | |
175 | ((m1 (+ (car a) ((, func) (car b) (car c) (car d)) (car x) (car ac))) | |
176 | (l1 (+ (cdr a) ((, func) (cdr b) (cdr c) (cdr d)) (cdr x) (cdr ac))) | |
177 | (m2 (logand 65535 (+ m1 (lsh l1 -16)))) | |
178 | (l2 (logand 65535 l1)) | |
179 | (m3 (logand 65535 (if (> s 15) | |
180 | (+ (lsh m2 (- s 32)) (lsh l2 (- s 16))) | |
181 | (+ (lsh m2 s) (lsh l2 (- s 16)))))) | |
182 | (l3 (logand 65535 (if (> s 15) | |
183 | (+ (lsh l2 (- s 32)) (lsh m2 (- s 16))) | |
184 | (+ (lsh l2 s) (lsh m2 (- s 16))))))) | |
185 | (md5-add (cons m3 l3) b))))) | |
186 | ||
187 | (md5-make-step md5-FF md5-F) | |
188 | (md5-make-step md5-GG md5-G) | |
189 | (md5-make-step md5-HH md5-H) | |
190 | (md5-make-step md5-II md5-I) | |
191 | ||
192 | (defun md5-init () | |
193 | "Initialise the state of the message-digest routines." | |
194 | (aset md5-bits 0 0) | |
195 | (aset md5-bits 1 0) | |
196 | (aset md5-bits 2 0) | |
197 | (aset md5-bits 3 0) | |
198 | (aset md5-buffer 0 '(26437 . 8961)) | |
199 | (aset md5-buffer 1 '(61389 . 43913)) | |
200 | (aset md5-buffer 2 '(39098 . 56574)) | |
201 | (aset md5-buffer 3 '( 4146 . 21622))) | |
202 | ||
203 | (defun md5-update (string) | |
204 | "Update the current MD5 state with STRING (an array of bytes)." | |
205 | (let ((len (length string)) | |
206 | (i 0) | |
207 | (j 0)) | |
208 | (while (< i len) | |
209 | ;; Compute number of bytes modulo 64 | |
210 | (setq j (% (/ (aref md5-bits 0) 8) 64)) | |
211 | ||
212 | ;; Store this byte (truncating to 8 bits to be sure) | |
213 | (aset md5-input j (logand 255 (aref string i))) | |
214 | ||
215 | ;; Update number of bits by 8 (modulo 2^64) | |
216 | (let ((c 8) (k 0)) | |
217 | (while (and (> c 0) (< k 4)) | |
218 | (let ((b (aref md5-bits k))) | |
219 | (aset md5-bits k (logand 65535 (+ b c))) | |
220 | (setq c (if (> b (- 65535 c)) 1 0) | |
221 | k (1+ k))))) | |
222 | ||
223 | ;; Increment number of bytes processed | |
224 | (setq i (1+ i)) | |
225 | ||
226 | ;; When 64 bytes accumulated, pack them into sixteen 32-bit | |
227 | ;; integers in the array `in' and then tranform them. | |
228 | (if (= j 63) | |
229 | (let ((in (make-vector 16 (cons 0 0))) | |
230 | (k 0) | |
231 | (kk 0)) | |
232 | (while (< k 16) | |
233 | (aset in k (md5-pack md5-input kk)) | |
234 | (setq k (+ k 1) kk (+ kk 4))) | |
235 | (md5-transform in)))))) | |
236 | ||
237 | (defun md5-pack (array i) | |
238 | "Pack the four bytes at ARRAY reference I to I+3 into a 32-bit integer." | |
239 | (cons (+ (lsh (aref array (+ i 3)) 8) (aref array (+ i 2))) | |
240 | (+ (lsh (aref array (+ i 1)) 8) (aref array (+ i 0))))) | |
241 | ||
242 | (defun md5-byte (array n b) | |
243 | "Unpack byte B (0 to 3) from Nth member of ARRAY of 32-bit integers." | |
244 | (let ((e (aref array n))) | |
245 | (cond ((eq b 0) (logand 255 (cdr e))) | |
246 | ((eq b 1) (lsh (cdr e) -8)) | |
247 | ((eq b 2) (logand 255 (car e))) | |
248 | ((eq b 3) (lsh (car e) -8))))) | |
249 | ||
250 | (defun md5-final () | |
251 | (let ((in (make-vector 16 (cons 0 0))) | |
252 | (j 0) | |
253 | (digest (make-vector 16 0)) | |
254 | (padding)) | |
255 | ||
256 | ;; Save the number of bits in the message | |
257 | (aset in 14 (cons (aref md5-bits 1) (aref md5-bits 0))) | |
258 | (aset in 15 (cons (aref md5-bits 3) (aref md5-bits 2))) | |
259 | ||
260 | ;; Compute number of bytes modulo 64 | |
261 | (setq j (% (/ (aref md5-bits 0) 8) 64)) | |
262 | ||
263 | ;; Pad out computation to 56 bytes modulo 64 | |
264 | (setq padding (make-vector (if (< j 56) (- 56 j) (- 120 j)) 0)) | |
265 | (aset padding 0 128) | |
266 | (md5-update padding) | |
267 | ||
268 | ;; Append length in bits and transform | |
269 | (let ((k 0) (kk 0)) | |
270 | (while (< k 14) | |
271 | (aset in k (md5-pack md5-input kk)) | |
272 | (setq k (+ k 1) kk (+ kk 4)))) | |
273 | (md5-transform in) | |
274 | ||
275 | ;; Store the results in the digest | |
276 | (let ((k 0) (kk 0)) | |
277 | (while (< k 4) | |
278 | (aset digest (+ kk 0) (md5-byte md5-buffer k 0)) | |
279 | (aset digest (+ kk 1) (md5-byte md5-buffer k 1)) | |
280 | (aset digest (+ kk 2) (md5-byte md5-buffer k 2)) | |
281 | (aset digest (+ kk 3) (md5-byte md5-buffer k 3)) | |
282 | (setq k (+ k 1) kk (+ kk 4)))) | |
283 | ||
284 | ;; Return digest | |
285 | digest)) | |
286 | ||
287 | ;; It says in the RSA source, "Note that if the Mysterious Constants are | |
288 | ;; arranged backwards in little-endian order and decrypted with the DES | |
289 | ;; they produce OCCULT MESSAGES!" Security through obscurity? | |
290 | ||
291 | (defun md5-transform (in) | |
292 | "Basic MD5 step. Transform md5-buffer based on array IN." | |
293 | (let ((a (aref md5-buffer 0)) | |
294 | (b (aref md5-buffer 1)) | |
295 | (c (aref md5-buffer 2)) | |
296 | (d (aref md5-buffer 3))) | |
297 | (setq | |
298 | a (md5-FF a b c d (aref in 0) 7 '(55146 . 42104)) | |
299 | d (md5-FF d a b c (aref in 1) 12 '(59591 . 46934)) | |
300 | c (md5-FF c d a b (aref in 2) 17 '( 9248 . 28891)) | |
301 | b (md5-FF b c d a (aref in 3) 22 '(49597 . 52974)) | |
302 | a (md5-FF a b c d (aref in 4) 7 '(62844 . 4015)) | |
303 | d (md5-FF d a b c (aref in 5) 12 '(18311 . 50730)) | |
304 | c (md5-FF c d a b (aref in 6) 17 '(43056 . 17939)) | |
305 | b (md5-FF b c d a (aref in 7) 22 '(64838 . 38145)) | |
306 | a (md5-FF a b c d (aref in 8) 7 '(27008 . 39128)) | |
307 | d (md5-FF d a b c (aref in 9) 12 '(35652 . 63407)) | |
308 | c (md5-FF c d a b (aref in 10) 17 '(65535 . 23473)) | |
309 | b (md5-FF b c d a (aref in 11) 22 '(35164 . 55230)) | |
310 | a (md5-FF a b c d (aref in 12) 7 '(27536 . 4386)) | |
311 | d (md5-FF d a b c (aref in 13) 12 '(64920 . 29075)) | |
312 | c (md5-FF c d a b (aref in 14) 17 '(42617 . 17294)) | |
313 | b (md5-FF b c d a (aref in 15) 22 '(18868 . 2081)) | |
314 | a (md5-GG a b c d (aref in 1) 5 '(63006 . 9570)) | |
315 | d (md5-GG d a b c (aref in 6) 9 '(49216 . 45888)) | |
316 | c (md5-GG c d a b (aref in 11) 14 '( 9822 . 23121)) | |
317 | b (md5-GG b c d a (aref in 0) 20 '(59830 . 51114)) | |
318 | a (md5-GG a b c d (aref in 5) 5 '(54831 . 4189)) | |
319 | d (md5-GG d a b c (aref in 10) 9 '( 580 . 5203)) | |
320 | c (md5-GG c d a b (aref in 15) 14 '(55457 . 59009)) | |
321 | b (md5-GG b c d a (aref in 4) 20 '(59347 . 64456)) | |
322 | a (md5-GG a b c d (aref in 9) 5 '( 8673 . 52710)) | |
323 | d (md5-GG d a b c (aref in 14) 9 '(49975 . 2006)) | |
324 | c (md5-GG c d a b (aref in 3) 14 '(62677 . 3463)) | |
325 | b (md5-GG b c d a (aref in 8) 20 '(17754 . 5357)) | |
326 | a (md5-GG a b c d (aref in 13) 5 '(43491 . 59653)) | |
327 | d (md5-GG d a b c (aref in 2) 9 '(64751 . 41976)) | |
328 | c (md5-GG c d a b (aref in 7) 14 '(26479 . 729)) | |
329 | b (md5-GG b c d a (aref in 12) 20 '(36138 . 19594)) | |
330 | a (md5-HH a b c d (aref in 5) 4 '(65530 . 14658)) | |
331 | d (md5-HH d a b c (aref in 8) 11 '(34673 . 63105)) | |
332 | c (md5-HH c d a b (aref in 11) 16 '(28061 . 24866)) | |
333 | b (md5-HH b c d a (aref in 14) 23 '(64997 . 14348)) | |
334 | a (md5-HH a b c d (aref in 1) 4 '(42174 . 59972)) | |
335 | d (md5-HH d a b c (aref in 4) 11 '(19422 . 53161)) | |
336 | c (md5-HH c d a b (aref in 7) 16 '(63163 . 19296)) | |
337 | b (md5-HH b c d a (aref in 10) 23 '(48831 . 48240)) | |
338 | a (md5-HH a b c d (aref in 13) 4 '(10395 . 32454)) | |
339 | d (md5-HH d a b c (aref in 0) 11 '(60065 . 10234)) | |
340 | c (md5-HH c d a b (aref in 3) 16 '(54511 . 12421)) | |
341 | b (md5-HH b c d a (aref in 6) 23 '( 1160 . 7429)) | |
342 | a (md5-HH a b c d (aref in 9) 4 '(55764 . 53305)) | |
343 | d (md5-HH d a b c (aref in 12) 11 '(59099 . 39397)) | |
344 | c (md5-HH c d a b (aref in 15) 16 '( 8098 . 31992)) | |
345 | b (md5-HH b c d a (aref in 2) 23 '(50348 . 22117)) | |
346 | a (md5-II a b c d (aref in 0) 6 '(62505 . 8772)) | |
347 | d (md5-II d a b c (aref in 7) 10 '(17194 . 65431)) | |
348 | c (md5-II c d a b (aref in 14) 15 '(43924 . 9127)) | |
349 | b (md5-II b c d a (aref in 5) 21 '(64659 . 41017)) | |
350 | a (md5-II a b c d (aref in 12) 6 '(25947 . 22979)) | |
351 | d (md5-II d a b c (aref in 3) 10 '(36620 . 52370)) | |
352 | c (md5-II c d a b (aref in 10) 15 '(65519 . 62589)) | |
353 | b (md5-II b c d a (aref in 1) 21 '(34180 . 24017)) | |
354 | a (md5-II a b c d (aref in 8) 6 '(28584 . 32335)) | |
355 | d (md5-II d a b c (aref in 15) 10 '(65068 . 59104)) | |
356 | c (md5-II c d a b (aref in 6) 15 '(41729 . 17172)) | |
357 | b (md5-II b c d a (aref in 13) 21 '(19976 . 4513)) | |
358 | a (md5-II a b c d (aref in 4) 6 '(63315 . 32386)) | |
359 | d (md5-II d a b c (aref in 11) 10 '(48442 . 62005)) | |
360 | c (md5-II c d a b (aref in 2) 15 '(10967 . 53947)) | |
361 | b (md5-II b c d a (aref in 9) 21 '(60294 . 54161))) | |
362 | ||
363 | (aset md5-buffer 0 (md5-add (aref md5-buffer 0) a)) | |
364 | (aset md5-buffer 1 (md5-add (aref md5-buffer 1) b)) | |
365 | (aset md5-buffer 2 (md5-add (aref md5-buffer 2) c)) | |
366 | (aset md5-buffer 3 (md5-add (aref md5-buffer 3) d)))) | |
367 | ||
368 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
369 | ;;; Here begins the merger with the XEmacs API and the md5.el from the URL | |
370 | ;;; package. Courtesy wmperry@spry.com | |
371 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
372 | (defun md5 (object &optional start end) | |
373 | "Return the MD5 (a secure message digest algorithm) of an object. | |
374 | OBJECT is either a string or a buffer. | |
375 | Optional arguments START and END denote buffer positions for computing the | |
376 | hash of a portion of OBJECT." | |
377 | (let ((buffer nil)) | |
378 | (unwind-protect | |
379 | (save-excursion | |
380 | (setq buffer (generate-new-buffer " *md5-work*")) | |
381 | (set-buffer buffer) | |
382 | (cond | |
383 | ((bufferp object) | |
384 | (insert-buffer-substring object start end)) | |
385 | ((stringp object) | |
386 | (insert (if (or start end) | |
387 | (substring object start end) | |
388 | object))) | |
389 | (t nil)) | |
390 | (prog1 | |
391 | (if (<= (point-max) md5-maximum-internal-length) | |
392 | (mapconcat | |
393 | (function (lambda (node) (format "%02x" node))) | |
394 | (md5-encode (buffer-string)) | |
395 | "") | |
396 | (call-process-region (point-min) (point-max) | |
397 | (or shell-file-name "/bin/sh") | |
398 | t buffer nil | |
399 | "-c" md5-program) | |
400 | ;; MD5 digest is 32 chars long | |
401 | ;; mddriver adds a newline to make neaten output for tty | |
402 | ;; viewing, make sure we leave it behind. | |
403 | (buffer-substring (point-min) (+ (point-min) 32))) | |
404 | (kill-buffer buffer))) | |
405 | (and buffer (kill-buffer buffer) nil)))) | |
406 | ||
407 | (provide 'md5) | |
408 | ||
409 | ;;; md5.el ends here ---------------------------------------------------------- |