blob: 12ea672c7e653ce141033eb8504a9c7b092892cc (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
|
;;; md4.el --- MD4 Message Digest Algorithm. -*- lexical-binding: t -*-
;; Copyright (C) 2001, 2004, 2007-2023 Free Software Foundation, Inc.
;; Author: Taro Kawagishi <tarok@transpulse.org>
;; Keywords: MD4
;; Old-Version: 1.00
;; Created: February 2001
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; The MD4 Message-Digest Algorithm.
;;
;; The security of the MD4 hashing algorithm is very poor to
;; non-existent. It was declared obsolete by RFC 6150 in 2011:
;; https://tools.ietf.org/html/rfc6150
;;
;; You probably want to use `secure-hash' instead.
;;; Code:
;;;
;;; MD4 hash calculation
(defvar md4-buffer (make-vector 4 '(0 . 0))
"Work buffer of four 32-bit integers.")
(defun md4 (in n)
"Return the MD4 hash for a string IN of length N bytes.
The returned hash is 16 bytes long. N is required to handle
strings containing the character 0.
The security of the MD4 hashing algorithm is very poor to
non-existent. It was declared obsolete by RFC 6150 in 2011.
You probably want to use `secure-hash' instead."
(let (m
(b (cons 0 (* n 8)))
(i 0)
(buf (make-string 128 0)) c4)
;; initial values
(aset md4-buffer 0 '(26437 . 8961)) ;0x67452301
(aset md4-buffer 1 '(61389 . 43913)) ;0xefcdab89
(aset md4-buffer 2 '(39098 . 56574)) ;0x98badcfe
(aset md4-buffer 3 '(4146 . 21622)) ;0x10325476
;; process the string in 64 bits chunks
(while (> n 64)
(setq m (md4-copy64 (substring in 0 64)))
(md4-64 m)
(setq in (substring in 64))
(setq n (- n 64)))
;; process the rest of the string (length is now n <= 64)
(setq i 0)
(while (< i n)
(aset buf i (aref in i))
(setq i (1+ i)))
(aset buf n 128) ;0x80
(if (<= n 55)
(progn
(setq c4 (md4-pack-int32 b))
(aset buf 56 (aref c4 0))
(aset buf 57 (aref c4 1))
(aset buf 58 (aref c4 2))
(aset buf 59 (aref c4 3))
(setq m (md4-copy64 buf))
(md4-64 m))
;; else
(setq c4 (md4-pack-int32 b))
(aset buf 120 (aref c4 0))
(aset buf 121 (aref c4 1))
(aset buf 122 (aref c4 2))
(aset buf 123 (aref c4 3))
(setq m (md4-copy64 buf))
(md4-64 m)
(setq m (md4-copy64 (substring buf 64)))
(md4-64 m)))
(concat (md4-pack-int32 (aref md4-buffer 0))
(md4-pack-int32 (aref md4-buffer 1))
(md4-pack-int32 (aref md4-buffer 2))
(md4-pack-int32 (aref md4-buffer 3))))
(defsubst md4-F (x y z) (logior (logand x y) (logand (lognot x) z)))
(defsubst md4-G (x y z) (logior (logand x y) (logand x z) (logand y z)))
(defsubst md4-H (x y z) (logxor x y z))
(defmacro md4-make-step (name func)
`(defun ,name (a b c d xk s ac)
(let*
((h1 (+ (car a) (,func (car b) (car c) (car d)) (car xk) (car ac)))
(l1 (+ (cdr a) (,func (cdr b) (cdr c) (cdr d)) (cdr xk) (cdr ac)))
(h2 (logand 65535 (+ h1 (ash l1 -16))))
(l2 (logand 65535 l1))
;; cyclic shift of 32 bits integer
(h3 (logand 65535 (if (> s 15)
(+ (ash h2 (- s 32)) (ash l2 (- s 16)))
(+ (ash h2 s) (ash l2 (- s 16))))))
(l3 (logand 65535 (if (> s 15)
(+ (ash l2 (- s 32)) (ash h2 (- s 16)))
(+ (ash l2 s) (ash h2 (- s 16)))))))
(cons h3 l3))))
(md4-make-step md4-round1 md4-F)
(md4-make-step md4-round2 md4-G)
(md4-make-step md4-round3 md4-H)
(defsubst md4-add (x y)
"Return 32-bit sum of 32-bit integers X and Y."
(let ((h (+ (car x) (car y)))
(l (+ (cdr x) (cdr y))))
(cons (logand 65535 (+ h (ash l -16))) (logand 65535 l))))
(defsubst md4-and (x y)
(cons (logand (car x) (car y)) (logand (cdr x) (cdr y))))
(defun md4-64 (m)
"Calculate MD4 hash of M.
M is a 64-bytes chunk, represented as 16 pairs of 32-bit integers.
The resulting MD4 value is placed in `md4-buffer'."
(let ((a (aref md4-buffer 0))
(b (aref md4-buffer 1))
(c (aref md4-buffer 2))
(d (aref md4-buffer 3)))
(setq a (md4-round1 a b c d (aref m 0) 3 '(0 . 0))
d (md4-round1 d a b c (aref m 1) 7 '(0 . 0))
c (md4-round1 c d a b (aref m 2) 11 '(0 . 0))
b (md4-round1 b c d a (aref m 3) 19 '(0 . 0))
a (md4-round1 a b c d (aref m 4) 3 '(0 . 0))
d (md4-round1 d a b c (aref m 5) 7 '(0 . 0))
c (md4-round1 c d a b (aref m 6) 11 '(0 . 0))
b (md4-round1 b c d a (aref m 7) 19 '(0 . 0))
a (md4-round1 a b c d (aref m 8) 3 '(0 . 0))
d (md4-round1 d a b c (aref m 9) 7 '(0 . 0))
c (md4-round1 c d a b (aref m 10) 11 '(0 . 0))
b (md4-round1 b c d a (aref m 11) 19 '(0 . 0))
a (md4-round1 a b c d (aref m 12) 3 '(0 . 0))
d (md4-round1 d a b c (aref m 13) 7 '(0 . 0))
c (md4-round1 c d a b (aref m 14) 11 '(0 . 0))
b (md4-round1 b c d a (aref m 15) 19 '(0 . 0))
a (md4-round2 a b c d (aref m 0) 3 '(23170 . 31129)) ;0x5A827999
d (md4-round2 d a b c (aref m 4) 5 '(23170 . 31129))
c (md4-round2 c d a b (aref m 8) 9 '(23170 . 31129))
b (md4-round2 b c d a (aref m 12) 13 '(23170 . 31129))
a (md4-round2 a b c d (aref m 1) 3 '(23170 . 31129))
d (md4-round2 d a b c (aref m 5) 5 '(23170 . 31129))
c (md4-round2 c d a b (aref m 9) 9 '(23170 . 31129))
b (md4-round2 b c d a (aref m 13) 13 '(23170 . 31129))
a (md4-round2 a b c d (aref m 2) 3 '(23170 . 31129))
d (md4-round2 d a b c (aref m 6) 5 '(23170 . 31129))
c (md4-round2 c d a b (aref m 10) 9 '(23170 . 31129))
b (md4-round2 b c d a (aref m 14) 13 '(23170 . 31129))
a (md4-round2 a b c d (aref m 3) 3 '(23170 . 31129))
d (md4-round2 d a b c (aref m 7) 5 '(23170 . 31129))
c (md4-round2 c d a b (aref m 11) 9 '(23170 . 31129))
b (md4-round2 b c d a (aref m 15) 13 '(23170 . 31129))
a (md4-round3 a b c d (aref m 0) 3 '(28377 . 60321)) ;0x6ED9EBA1
d (md4-round3 d a b c (aref m 8) 9 '(28377 . 60321))
c (md4-round3 c d a b (aref m 4) 11 '(28377 . 60321))
b (md4-round3 b c d a (aref m 12) 15 '(28377 . 60321))
a (md4-round3 a b c d (aref m 2) 3 '(28377 . 60321))
d (md4-round3 d a b c (aref m 10) 9 '(28377 . 60321))
c (md4-round3 c d a b (aref m 6) 11 '(28377 . 60321))
b (md4-round3 b c d a (aref m 14) 15 '(28377 . 60321))
a (md4-round3 a b c d (aref m 1) 3 '(28377 . 60321))
d (md4-round3 d a b c (aref m 9) 9 '(28377 . 60321))
c (md4-round3 c d a b (aref m 5) 11 '(28377 . 60321))
b (md4-round3 b c d a (aref m 13) 15 '(28377 . 60321))
a (md4-round3 a b c d (aref m 3) 3 '(28377 . 60321))
d (md4-round3 d a b c (aref m 11) 9 '(28377 . 60321))
c (md4-round3 c d a b (aref m 7) 11 '(28377 . 60321))
b (md4-round3 b c d a (aref m 15) 15 '(28377 . 60321)))
(aset md4-buffer 0 (md4-add a (aref md4-buffer 0)))
(aset md4-buffer 1 (md4-add b (aref md4-buffer 1)))
(aset md4-buffer 2 (md4-add c (aref md4-buffer 2)))
(aset md4-buffer 3 (md4-add d (aref md4-buffer 3)))
))
(defun md4-copy64 (seq)
"Unpack a 64 bytes string into 16 pairs of 32 bits integers."
(let ((int32s (make-vector 16 0)) (i 0) j)
(while (< i 16)
(setq j (* i 4))
(aset int32s i (cons (+ (aref seq (+ j 2)) (ash (aref seq (+ j 3)) 8))
(+ (aref seq j) (ash (aref seq (1+ j)) 8))))
(setq i (1+ i)))
int32s))
;;;
;;; sub functions
(defun md4-pack-int16 (int16)
"Pack 16 bits integer in 2 bytes string as little endian."
(let ((str (make-string 2 0)))
(aset str 0 (logand int16 255))
(aset str 1 (ash int16 -8))
str))
(defun md4-pack-int32 (int32)
"Pack 32 bits integer in a 4 bytes string as little endian.
A 32 bits integer is represented as a pair of two 16 bits
integers (cons high low)."
(let ((str (make-string 4 0))
(h (car int32)) (l (cdr int32)))
(aset str 0 (logand l 255))
(aset str 1 (ash l -8))
(aset str 2 (logand h 255))
(aset str 3 (ash h -8))
str))
(defun md4-unpack-int16 (str)
(if (eq 2 (length str))
(+ (ash (aref str 1) 8) (aref str 0))
(error "%s is not 2 bytes long" str)))
(defun md4-unpack-int32 (str)
(if (eq 4 (length str))
(cons (+ (ash (aref str 3) 8) (aref str 2))
(+ (ash (aref str 1) 8) (aref str 0)))
(error "%s is not 4 bytes long" str)))
(provide 'md4)
;;; md4.el ends here
|
