md4.el

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