cgit.sxemacs.org Git - packages/blob - xemacs-packages/ecrypto/md5-old.el

   1 ;;;  md5-old.el -- MD5 message digest algorithm
   2
   3 ;; Copyright (C) 1998 Ray Jones
   4
   5 ;; Author: Ray Jones, rjones@pobox.com
   6 ;; Keywords: MD5, message digest
   7 ;; Created: 1998-04-27
   8
   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)
  12 ;; any later version.
  13 ;;
  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.
  18 ;;
  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.
  23
  24 ;;; Commentary:
  25
  26 ;; this is a slower, more clear, version of md5.el.  it's based on md5-old.el
  27
  28 ;;; Code:
  29 (require 'cl)
  30
  31 (defun md5 (string)
  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
  46
  47     ;; fill in the single bit of the pad
  48     (aset pad-string 0 (ash 1 7))
  49
  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.
  54
  55     ;; LSB sucks.
  56
  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)
  60     (dotimes (idx 4)
  61       (aset len-string idx (logand ?\xff
  62                                    (ash length (- 3 (* idx 8))))))
  63
  64     (md5-vector
  65      (md5-string-to-32bit-vec
  66       (concat string pad-string len-string)))))
  67
  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
  71
  72   ;; 4 chars per 32 bit number, in LSB-first!
  73   (let* ((veclen (/ (length string) 4))
  74          (vec (make-vector veclen nil))
  75          (stridx 0))
  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)))))
  82       (incf stridx 4))
  83
  84     vec))
  85
  86 (defsubst md5-f2 (x y z)
  87   (logior (logand x y)
  88           (logand (lognot x)
  89                   z)))
  90
  91 (defsubst md5-g2 (x y z)
  92   (logior (logand x z)
  93           (logand y (lognot z))))
  94
  95 (defsubst md5-h2 (x y z)
  96   (logxor x y z))
  97
  98 (defsubst md5-i2 (x y z)
  99   (logxor y
 100           (logior x
 101                   ;; this is normally a lognot, but that would set
 102                   ;; high bits, and there's no logand to clear them.
 103                   (logxor z #xffff))))
 104
 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))))
 108
 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))))
 112
 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))))
 116
 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))))
 120
 121 (defsubst md5<<< (val shift)
 122   "circular shift md5 32 bit int VAL by SHIFT bits"
 123   (let ((a (car val))
 124         (b (cdr val)))
 125
 126     ;; shifts greater than 16 need to be handled by a swap, then a
 127     ;; smaller shift
 128     (when (> shift 16)
 129       (rotatef a b)
 130       (decf shift 16))
 131
 132     (cons (logand #xffff (logior (ash a shift) (ash b (- shift 16))))
 133           (logand #xffff (logior (ash b shift) (ash a (- shift 16)))))))
 134
 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))))
 141
 142 ;; array of values for i=[1..64] => floor(2^32 * abs(sin(i)))
 143 (defconst md5-t
 144
 145   [(#xd76a . #xa478)
 146    (#xe8c7 . #xb756)
 147    (#x2420 . #x70db)
 148    (#xc1bd . #xceee)
 149    (#xf57c . #x0faf)
 150    (#x4787 . #xc62a)
 151    (#xa830 . #x4613)
 152    (#xfd46 . #x9501)
 153    (#x6980 . #x98d8)
 154    (#x8b44 . #xf7af)
 155    (#xffff . #x5bb1)
 156    (#x895c . #xd7be)
 157    (#x6b90 . #x1122)
 158    (#xfd98 . #x7193)
 159    (#xa679 . #x438e)
 160    (#x49b4 . #x0821)
 161
 162    (#xf61e . #x2562)
 163    (#xc040 . #xb340)
 164    (#x265e . #x5a51)
 165    (#xe9b6 . #xc7aa)
 166    (#xd62f . #x105d)
 167    (#x0244 . #x1453)
 168    (#xd8a1 . #xe681)
 169    (#xe7d3 . #xfbc8)
 170    (#x21e1 . #xcde6)
 171    (#xc337 . #x07d6)
 172    (#xf4d5 . #x0d87)
 173    (#x455a . #x14ed)
 174    (#xa9e3 . #xe905)
 175    (#xfcef . #xa3f8)
 176    (#x676f . #x02d9)
 177    (#x8d2a . #x4c8a)
 178
 179    (#xfffa . #x3942)
 180    (#x8771 . #xf681)
 181    (#x6d9d . #x6122)
 182    (#xfde5 . #x380c)
 183    (#xa4be . #xea44)
 184    (#x4bde . #xcfa9)
 185    (#xf6bb . #x4b60)
 186    (#xbebf . #xbc70)
 187    (#x289b . #x7ec6)
 188    (#xeaa1 . #x27fa)
 189    (#xd4ef . #x3085)
 190    (#x0488 . #x1d05)
 191    (#xd9d4 . #xd039)
 192    (#xe6db . #x99e5)
 193    (#x1fa2 . #x7cf8)
 194    (#xc4ac . #x5665)
 195
 196    (#xf429 . #x2244)
 197    (#x432a . #xff97)
 198    (#xab94 . #x23a7)
 199    (#xfc93 . #xa039)
 200    (#x655b . #x59c3)
 201    (#x8f0c . #xcc92)
 202    (#xffef . #xf47d)
 203    (#x8584 . #x5dd1)
 204    (#x6fa8 . #x7e4f)
 205    (#xfe2c . #xe6e0)
 206    (#xa301 . #x4314)
 207    (#x4e08 . #x11a1)
 208    (#xf753 . #x7e82)
 209    (#xbd3a . #xf235)
 210    (#x2ad7 . #xd2bb)
 211    (#xeb86 . #xd391)])
 212
 213 (eval-and-compile
 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
 217 bit out of control.
 218 NB: vec, v-offset, and t-idx below must be defined where the macro is
 219 called!"
 220     `(setq ,w (md5+ ,x
 221                     (md5<<< (md5+ ,w
 222                                   ,(list fun x y z)
 223                                   (aref vec (+ v-offset ,vec-idx))
 224                                   (aref md5-t t-idx))
 225                             ,shift)))))
 226
 227
 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))
 234         (v-offset 0))
 235
 236     (dotimes (count (/ (length vec) 16))
 237       (let ((AA a) (BB b) (CC c) (DD d)
 238             (t-idx 0))
 239         (macrolet
 240             ((f (v1 v2 v3 v4 v-idx shift)
 241                 `(progn
 242                    ,(md5-rewrite 'md5-f v1 v2 v3 v4 v-idx shift)
 243                    (incf t-idx))))
 244
 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))
 249
 250         (macrolet
 251             ((g (v1 v2 v3 v4 v-idx shift)
 252                 `(progn
 253                    ,(md5-rewrite 'md5-g v1 v2 v3 v4 v-idx shift)
 254                    (incf t-idx))))
 255
 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))
 260
 261         (macrolet
 262             ((h (v1 v2 v3 v4 v-idx shift)
 263                 `(progn
 264                    ,(md5-rewrite 'md5-h v1 v2 v3 v4 v-idx shift)
 265                    (incf t-idx))))
 266
 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))
 271
 272         (macrolet
 273             ((i (v1 v2 v3 v4 v-idx shift)
 274                 `(progn
 275                    ,(md5-rewrite `md5-i v1 v2 v3 v4 v-idx shift)
 276                    (incf t-idx))))
 277
 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))
 282
 283         (setq a (md5+ AA a)
 284               b (md5+ BB b)
 285               c (md5+ CC c)
 286               d (md5+ DD d)))
 287
 288       (incf v-offset 16))
 289
 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)
 293                      (cdr b) (car b)
 294                      (cdr c) (car c)
 295                      (cdr d) (car d))
 296                "")))
 297
 298 (provide 'md5)