1 ;;; md5-old.el -- MD5 message digest algorithm
3 ;; Copyright (C) 1998 Ray Jones
5 ;; Author: Ray Jones, rjones@pobox.com
6 ;; Keywords: MD5, message digest
9 ;; This program 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)
14 ;; This program 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.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with this program; if not, you can either send email to this
21 ;; program's maintainer or write to: The Free Software Foundation,
22 ;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
26 ;; this is a slower, more clear, version of md5.el. it's based on md5-old.el
32 "return the md5 hash of a string, as a 128 bit string"
33 (let* ((length (length string))
34 ;; md5 requires the message be padded to a length of 512*k +
35 ;; 64 (bits). confusion source: we're working with bytes.
36 ;; padding is always done.
37 ;; 512 bits = 64 bytes, 64 bits = 8 bytes
38 (next-512 (+ 64 (logand (+ length 8) (lognot 63))))
39 (pad-bytes (- next-512 length 8))
40 (pad-string (make-string pad-bytes 0))
41 (len-string (make-string 8 0)))
42 ;; message is constructed as:
43 ;; original-message | pad | length-in-bits
44 ;; pad is 10000... (bitwise)
45 ;; length-in-bits is length before padding, and is 64 bits long
47 ;; fill in the single bit of the pad
48 (aset pad-string 0 (ash 1 7))
50 ;; there's a slim chance of overflow when multiplying the length
51 ;; by 8 to get the length in bits. to avoid this, do some
52 ;; slightly hairier math when writing the length into len-string.
53 ;; also, it has to be LSB-first. be still my aching brain.
57 ;; only do the first 4 bytes, even though supposedly there are 8.
58 ;; 32 bit emacsen think that (ash 40 -37) => 1
59 ;; (supposed to be fixed in future releases)
61 (aset len-string idx (logand ?\xff
62 (ash length (- 3 (* idx 8))))))
65 (md5-string-to-32bit-vec
66 (concat string pad-string len-string)))))
68 (defun md5-string-to-32bit-vec (string)
69 ;; emacs doesn't actually have 32 bits, in most implementations.
70 ;; 32 bit numbers are represented as a pair of 16 bit numbers
72 ;; 4 chars per 32 bit number, in LSB-first!
73 (let* ((veclen (/ (length string) 4))
74 (vec (make-vector veclen nil))
76 (dotimes (vecidx veclen)
77 ;; MD5 integers are (hi . lo) 16 bit words
78 (aset vec vecidx (cons (+ (ash (aref string (+ stridx 3)) 8)
79 (aref string (+ stridx 2)))
80 (+ (ash (aref string (+ stridx 1)) 8)
81 (aref string (+ stridx 0)))))
86 (defsubst md5-f2 (x y z)
91 (defsubst md5-g2 (x y z)
93 (logand y (lognot z))))
95 (defsubst md5-h2 (x y z)
98 (defsubst md5-i2 (x y z)
101 ;; this is normally a lognot, but that would set
102 ;; high bits, and there's no logand to clear them.
105 (defsubst md5-f (x y z)
106 (cons (md5-f2 (car x) (car y) (car z))
107 (md5-f2 (cdr x) (cdr y) (cdr z))))
109 (defsubst md5-g (x y z)
110 (cons (md5-g2 (car x) (car y) (car z))
111 (md5-g2 (cdr x) (cdr y) (cdr z))))
113 (defsubst md5-h (x y z)
114 (cons (md5-h2 (car x) (car y) (car z))
115 (md5-h2 (cdr x) (cdr y) (cdr z))))
117 (defsubst md5-i (x y z)
118 (cons (md5-i2 (car x) (car y) (car z))
119 (md5-i2 (cdr x) (cdr y) (cdr z))))
121 (defsubst md5<<< (val shift)
122 "circular shift md5 32 bit int VAL by SHIFT bits"
126 ;; shifts greater than 16 need to be handled by a swap, then a
132 (cons (logand #xffff (logior (ash a shift) (ash b (- shift 16))))
133 (logand #xffff (logior (ash b shift) (ash a (- shift 16)))))))
135 (defsubst md5+ (&rest args)
136 ;; enough room to just add without carry checks
137 (let* ((lo (apply #'+ (mapcar #'cdr args)))
138 (hi (+ (ash lo -16) (apply #'+ (mapcar #'car args)))))
139 (cons (logand #xffff hi)
140 (logand #xffff lo))))
142 ;; array of values for i=[1..64] => floor(2^32 * abs(sin(i)))
214 (defun md5-rewrite (fun w x y z vec-idx shift)
215 "helper function for md5-vector, below. ugly coding practice,
216 having a macro-rewriter elsewhere, but the indentation was getting a
218 NB: vec, v-offset, and t-idx below must be defined where the macro is
223 (aref vec (+ v-offset ,vec-idx))
228 (defun md5-vector (vec)
229 ;; initialize the chaining variables
230 (let ((a (cons #x6745 #x2301))
231 (b (cons #xefcd #xab89))
232 (c (cons #x98ba #xdcfe))
233 (d (cons #x1032 #x5476))
236 (dotimes (count (/ (length vec) 16))
237 (let ((AA a) (BB b) (CC c) (DD d)
240 ((f (v1 v2 v3 v4 v-idx shift)
242 ,(md5-rewrite 'md5-f v1 v2 v3 v4 v-idx shift)
245 (f a b c d 0 7) (f d a b c 1 12) (f c d a b 2 17) (f b c d a 3 22)
246 (f a b c d 4 7) (f d a b c 5 12) (f c d a b 6 17) (f b c d a 7 22)
247 (f a b c d 8 7) (f d a b c 9 12) (f c d a b 10 17) (f b c d a 11 22)
248 (f a b c d 12 7) (f d a b c 13 12) (f c d a b 14 17) (f b c d a 15 22))
251 ((g (v1 v2 v3 v4 v-idx shift)
253 ,(md5-rewrite 'md5-g v1 v2 v3 v4 v-idx shift)
256 (g a b c d 1 5) (g d a b c 6 9) (g c d a b 11 14) (g b c d a 0 20)
257 (g a b c d 5 5) (g d a b c 10 9) (g c d a b 15 14) (g b c d a 4 20)
258 (g a b c d 9 5) (g d a b c 14 9) (g c d a b 3 14) (g b c d a 8 20)
259 (g a b c d 13 5) (g d a b c 2 9) (g c d a b 7 14) (g b c d a 12 20))
262 ((h (v1 v2 v3 v4 v-idx shift)
264 ,(md5-rewrite 'md5-h v1 v2 v3 v4 v-idx shift)
267 (h a b c d 5 4) (h d a b c 8 11) (h c d a b 11 16) (h b c d a 14 23)
268 (h a b c d 1 4) (h d a b c 4 11) (h c d a b 7 16) (h b c d a 10 23)
269 (h a b c d 13 4) (h d a b c 0 11) (h c d a b 3 16) (h b c d a 6 23)
270 (h a b c d 9 4) (h d a b c 12 11) (h c d a b 15 16) (h b c d a 2 23))
273 ((i (v1 v2 v3 v4 v-idx shift)
275 ,(md5-rewrite `md5-i v1 v2 v3 v4 v-idx shift)
278 (i a b c d 0 6) (i d a b c 7 10) (i c d a b 14 15) (i b c d a 5 21)
279 (i a b c d 12 6) (i d a b c 3 10) (i c d a b 10 15) (i b c d a 1 21)
280 (i a b c d 8 6) (i d a b c 15 10) (i c d a b 6 15) (i b c d a 13 21)
281 (i a b c d 4 6) (i d a b c 11 10) (i c d a b 2 15) (i b c d a 9 21))
290 ;; swap back from LSB-first. i feel ill.
291 (mapconcat #'(lambda (x) (format "%02x%02x" (logand #xff x) (ash x -8)))
292 (list (cdr a) (car a)