/usr/share/emacs/site-lisp/flim/md4.el is in flim 1:1.14.9+0.20110516-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 | ;;; md4.el --- MD4 Message Digest Algorithm.
;; Copyright (C) 2004 Free Software Foundation, Inc.
;; Copyright (C) 2001 Taro Kawagishi
;; Author: Taro Kawagishi <tarok@transpulse.org>
;; Keywords: MD4
;; Version: 1.00
;; Created: February 2001
;; This file is part of FLIM (Faithful Library about Internet Message).
;; This program 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 2, or (at your option)
;; any later version.
;;
;; This program 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 this program; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Code:
;;;
;;; MD4 hash calculation
(defvar md4-buffer (make-vector 4 '(0 . 0))
"work buffer of four 32-bit integers")
(defun md4 (in n)
"Returns the MD4 hash string of 16 bytes long for a string IN of N
bytes long. N is required to handle strings containing character 0."
(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 (lsh l1 -16))))
(l2 (logand 65535 l1))
;; cyclic shift of 32 bits integer
(h3 (logand 65535 (if (> s 15)
(+ (lsh h2 (- s 32)) (lsh l2 (- s 16)))
(+ (lsh h2 s) (lsh l2 (- s 16))))))
(l3 (logand 65535 (if (> s 15)
(+ (lsh l2 (- s 32)) (lsh h2 (- s 16)))
(+ (lsh l2 s) (lsh 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 (lsh 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 of 64 bytes chunk M which is represented as 16 pairs of
32 bits 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)) (lsh (aref seq (+ j 3)) 8))
(+ (aref seq j) (lsh (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 (lsh 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 (lsh l -8))
(aset str 2 (logand h 255))
(aset str 3 (lsh h -8))
str))
(defun md4-unpack-int16 (str)
(if (eq 2 (length str))
(+ (lsh (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 (+ (lsh (aref str 3) 8) (aref str 2))
(+ (lsh (aref str 1) 8) (aref str 0)))
(error "%s is not 4 bytes long" str)))
(provide 'md4)
;;; md4.el ends here
|