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