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

   1 ;;; md5.el -- MD5 Message Digest Algorithm
   2 ;;; Gareth Rees <gdr11@cl.cam.ac.uk>
   3
   4 ;; LCD Archive Entry:
   5 ;; md5|Gareth Rees|gdr11@cl.cam.ac.uk|
   6 ;; MD5 cryptographic message digest algorithm|
   7 ;; 13-Nov-95|1.0|~/misc/md5.el.Z|
   8
   9 ;;; Details: ------------------------------------------------------------------
  10
  11 ;; This is a direct translation into Emacs LISP of the reference C
  12 ;; implementation of the MD5 Message-Digest Algorithm written by RSA
  13 ;; Data Security, Inc.
  14 ;;
  15 ;; The algorithm takes a message (that is, a string of bytes) and
  16 ;; computes a 16-byte checksum or "digest" for the message.  This digest
  17 ;; is supposed to be cryptographically strong in the sense that if you
  18 ;; are given a 16-byte digest D, then there is no easier way to
  19 ;; construct a message whose digest is D than to exhaustively search the
  20 ;; space of messages.  However, the robustness of the algorithm has not
  21 ;; been proven, and a similar algorithm (MD4) was shown to be unsound,
  22 ;; so treat with caution!
  23 ;;
  24 ;; The C algorithm uses 32-bit integers; because GNU Emacs
  25 ;; implementations provide 28-bit integers (with 24-bit integers on
  26 ;; versions prior to 19.29), the code represents a 32-bit integer as the
  27 ;; cons of two 16-bit integers.  The most significant word is stored in
  28 ;; the car and the least significant in the cdr.  The algorithm requires
  29 ;; at least 17 bits of integer representation in order to represent the
  30 ;; carry from a 16-bit addition.
  31
  32 ;;; Usage: --------------------------------------------------------------------
  33
  34 ;; To compute the MD5 Message Digest for a message M (represented as a
  35 ;; string or as a vector of bytes), call
  36 ;;
  37 ;;   (md5-encode M)
  38 ;;
  39 ;; which returns the message digest as a vector of 16 bytes.  If you
  40 ;; need to supply the message in pieces M1, M2, ... Mn, then call
  41 ;;
  42 ;;   (md5-init)
  43 ;;   (md5-update M1)
  44 ;;   (md5-update M2)
  45 ;;   ...
  46 ;;   (md5-update Mn)
  47 ;;   (md5-final)
  48
  49 ;;; Copyright and licence: ----------------------------------------------------
  50
  51 ;; Copyright (C) 1995, 1996, 1997 by Gareth Rees
  52 ;; Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm
  53 ;;
  54 ;; md5.el is free software; you can redistribute it and/or modify it
  55 ;; under the terms of the GNU General Public License as published by the
  56 ;; Free Software Foundation; either version 2, or (at your option) any
  57 ;; later version.
  58 ;;
  59 ;; md5.el is distributed in the hope that it will be useful, but WITHOUT
  60 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  61 ;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  62 ;; for more details.
  63 ;;
  64 ;; The original copyright notice is given below, as required by the
  65 ;; licence for the original code.  This code is distributed under *both*
  66 ;; RSA's original licence and the GNU General Public Licence.  (There
  67 ;; should be no problems, as the former is more liberal than the
  68 ;; latter).
  69
  70 ;;; Original copyright notice: ------------------------------------------------
  71
  72 ;; Copyright (C) 1990, RSA Data Security, Inc. All rights reserved.
  73 ;;
  74 ;; License to copy and use this software is granted provided that it is
  75 ;; identified as the "RSA Data Security, Inc. MD5 Message- Digest
  76 ;; Algorithm" in all material mentioning or referencing this software or
  77 ;; this function.
  78 ;;
  79 ;; License is also granted to make and use derivative works provided
  80 ;; that such works are identified as "derived from the RSA Data
  81 ;; Security, Inc. MD5 Message-Digest Algorithm" in all material
  82 ;; mentioning or referencing the derived work.
  83 ;;
  84 ;; RSA Data Security, Inc. makes no representations concerning either
  85 ;; the merchantability of this software or the suitability of this
  86 ;; software for any particular purpose.  It is provided "as is" without
  87 ;; express or implied warranty of any kind.
  88 ;;
  89 ;; These notices must be retained in any copies of any part of this
  90 ;; documentation and/or software.
  91
  92 ;;; Code: ---------------------------------------------------------------------
  93
  94 (defcustom md5-program "md5"
  95   "*Program that reads a message on its standard input and writes an
  96 MD5 digest on its output."
  97   :type 'string)
  98
  99 (defcustom md5-maximum-internal-length 4096
 100   "*The maximum size of a piece of data that should use the MD5 routines
 101 written in lisp.  If a message exceeds this, it will be run through an
 102 external filter for processing.  Also see the `md5-program' variable.
 103 This variable has no effect if you call the md5-init|update|final
 104 functions - only used by the `md5' function's simpler interface."
 105   :type 'integer)
 106
 107 (defvar md5-bits (make-vector 4 0)
 108   "Number of bits handled, modulo 2^64.
 109 Represented as four 16-bit numbers, least significant first.")
 110 (defvar md5-buffer (make-vector 4 '(0 . 0))
 111   "Scratch buffer (four 32-bit integers).")
 112 (defvar md5-input (make-vector 64 0)
 113   "Input buffer (64 bytes).")
 114
 115 (defun md5-unhex (x)
 116   (if (> x ?9)
 117       (if (>= x ?a)
 118           (+ 10 (- x ?a))
 119         (+ 10 (- x ?A)))
 120     (- x ?0)))
 121
 122 (defun md5-encode (message)
 123   "Encodes MESSAGE using the MD5 message digest algorithm.
 124 MESSAGE must be a string or an array of bytes.
 125 Returns a vector of 16 bytes containing the message digest."
 126   (if (or (null md5-maximum-internal-length)
 127            (<= (length message) md5-maximum-internal-length))
 128       (progn
 129         (md5-init)
 130         (md5-update message)
 131         (md5-final))
 132     (save-excursion
 133       (set-buffer (get-buffer-create " *md5-work*"))
 134       (erase-buffer)
 135       (insert message)
 136       (call-process-region (point-min) (point-max)
 137                            md5-program
 138                            t (current-buffer))
 139       ;; MD5 digest is 32 chars long
 140       ;; mddriver adds a newline to make neaten output for tty
 141       ;; viewing, make sure we leave it behind.
 142       (let ((data (buffer-substring (point-min) (+ (point-min) 32)))
 143             (vec (make-vector 16 0))
 144             (ctr 0))
 145         (while (< ctr 16)
 146           (aset vec ctr (+ (* 16 (md5-unhex (aref data (* ctr 2))))
 147                            (md5-unhex (aref data (1+ (* ctr 2))))))
 148           (setq ctr (1+ ctr)))))))
 149
 150 (defsubst md5-add (x y)
 151   "Return 32-bit sum of 32-bit integers X and Y."
 152   (let ((m (+ (car x) (car y)))
 153         (l (+ (cdr x) (cdr y))))
 154     (cons (logand 65535 (+ m (lsh l -16))) (logand l 65535))))
 155
 156 ;; FF, GG, HH and II are basic MD5 functions, providing transformations
 157 ;; for rounds 1, 2, 3 and 4 respectively.  Each function follows this
 158 ;; pattern of computation (where ROTATE(x,y) means rotate 32-bit value x
 159 ;; by y bits to the left):
 160 ;;
 161 ;;   FF(a,b,c,d,x,s,ac) = ROTATE(a + F(b,c,d) + x + ac,s) + b
 162 ;;
 163 ;; so we use the macro `md5-make-step' to construct each one.  The
 164 ;; helper functions F, G, H and I operate on 16-bit numbers; the full
 165 ;; operation splits its inputs, operates on the halves separately and
 166 ;; then puts the results together.
 167
 168 (defsubst md5-F (x y z) (logior (logand x y) (logand (lognot x) z)))
 169 (defsubst md5-G (x y z) (logior (logand x z) (logand y (lognot z))))
 170 (defsubst md5-H (x y z) (logxor x y z))
 171 (defsubst md5-I (x y z) (logxor y (logior x (logand 65535 (lognot z)))))
 172
 173 (defmacro md5-make-step (name func)
 174   (`
 175    (defun (, name) (a b c d x s ac)
 176      (let*
 177          ((m1 (+ (car a) ((, func) (car b) (car c) (car d)) (car x) (car ac)))
 178           (l1 (+ (cdr a) ((, func) (cdr b) (cdr c) (cdr d)) (cdr x) (cdr ac)))
 179           (m2 (logand 65535 (+ m1 (lsh l1 -16))))
 180           (l2 (logand 65535 l1))
 181           (m3 (logand 65535 (if (> s 15)
 182                                 (+ (lsh m2 (- s 32)) (lsh l2 (- s 16)))
 183                               (+ (lsh m2 s) (lsh l2 (- s 16))))))
 184           (l3 (logand 65535 (if (> s 15)
 185                                 (+ (lsh l2 (- s 32)) (lsh m2 (- s 16)))
 186                               (+ (lsh l2 s) (lsh m2 (- s 16)))))))
 187        (md5-add (cons m3 l3) b)))))
 188
 189 (md5-make-step md5-FF md5-F)
 190 (md5-make-step md5-GG md5-G)
 191 (md5-make-step md5-HH md5-H)
 192 (md5-make-step md5-II md5-I)
 193
 194 (defun md5-init ()
 195   "Initialise the state of the message-digest routines."
 196   (aset md5-bits 0 0)
 197   (aset md5-bits 1 0)
 198   (aset md5-bits 2 0)
 199   (aset md5-bits 3 0)
 200   (aset md5-buffer 0 '(26437 .  8961))
 201   (aset md5-buffer 1 '(61389 . 43913))
 202   (aset md5-buffer 2 '(39098 . 56574))
 203   (aset md5-buffer 3 '( 4146 . 21622)))
 204
 205 (defun md5-update (string)
 206   "Update the current MD5 state with STRING (an array of bytes)."
 207   (let ((len (length string))
 208         (i 0)
 209         (j 0))
 210     (while (< i len)
 211       ;; Compute number of bytes modulo 64
 212       (setq j (% (/ (aref md5-bits 0) 8) 64))
 213
 214       ;; Store this byte (truncating to 8 bits to be sure)
 215       (aset md5-input j (logand 255 (aref string i)))
 216
 217       ;; Update number of bits by 8 (modulo 2^64)
 218       (let ((c 8) (k 0))
 219         (while (and (> c 0) (< k 4))
 220           (let ((b (aref md5-bits k)))
 221             (aset md5-bits k (logand 65535 (+ b c)))
 222             (setq c (if (> b (- 65535 c)) 1 0)
 223                   k (1+ k)))))
 224
 225       ;; Increment number of bytes processed
 226       (setq i (1+ i))
 227
 228       ;; When 64 bytes accumulated, pack them into sixteen 32-bit
 229       ;; integers in the array `in' and then transform them.
 230       (if (= j 63)
 231           (let ((in (make-vector 16 (cons 0 0)))
 232                 (k 0)
 233                 (kk 0))
 234             (while (< k 16)
 235               (aset in k (md5-pack md5-input kk))
 236               (setq k (+ k 1) kk (+ kk 4)))
 237             (md5-transform in))))))
 238
 239 (defun md5-pack (array i)
 240   "Pack the four bytes at ARRAY reference I to I+3 into a 32-bit integer."
 241   (cons (+ (lsh (aref array (+ i 3)) 8) (aref array (+ i 2)))
 242         (+ (lsh (aref array (+ i 1)) 8) (aref array (+ i 0)))))
 243
 244 (defun md5-byte (array n b)
 245   "Unpack byte B (0 to 3) from Nth member of ARRAY of 32-bit integers."
 246   (let ((e (aref array n)))
 247     (cond ((eq b 0) (logand 255 (cdr e)))
 248           ((eq b 1) (lsh (cdr e) -8))
 249           ((eq b 2) (logand 255 (car e)))
 250           ((eq b 3) (lsh (car e) -8)))))
 251
 252 (defun md5-final ()
 253   (let ((in (make-vector 16 (cons 0 0)))
 254         (j 0)
 255         (digest (make-vector 16 0))
 256         (padding))
 257
 258     ;; Save the number of bits in the message
 259     (aset in 14 (cons (aref md5-bits 1) (aref md5-bits 0)))
 260     (aset in 15 (cons (aref md5-bits 3) (aref md5-bits 2)))
 261
 262     ;; Compute number of bytes modulo 64
 263     (setq j (% (/ (aref md5-bits 0) 8) 64))
 264
 265     ;; Pad out computation to 56 bytes modulo 64
 266     (setq padding (make-vector (if (< j 56) (- 56 j) (- 120 j)) 0))
 267     (aset padding 0 128)
 268     (md5-update padding)
 269
 270     ;; Append length in bits and transform
 271     (let ((k 0) (kk 0))
 272       (while (< k 14)
 273         (aset in k (md5-pack md5-input kk))
 274         (setq k (+ k 1) kk (+ kk 4))))
 275     (md5-transform in)
 276
 277     ;; Store the results in the digest
 278     (let ((k 0) (kk 0))
 279       (while (< k 4)
 280         (aset digest (+ kk 0) (md5-byte md5-buffer k 0))
 281         (aset digest (+ kk 1) (md5-byte md5-buffer k 1))
 282         (aset digest (+ kk 2) (md5-byte md5-buffer k 2))
 283         (aset digest (+ kk 3) (md5-byte md5-buffer k 3))
 284         (setq k (+ k 1) kk (+ kk 4))))
 285
 286     ;; Return digest
 287     digest))
 288
 289 ;; It says in the RSA source, "Note that if the Mysterious Constants are
 290 ;; arranged backwards in little-endian order and decrypted with the DES
 291 ;; they produce OCCULT MESSAGES!"  Security through obscurity?
 292
 293 (defun md5-transform (in)
 294   "Basic MD5 step. Transform md5-buffer based on array IN."
 295   (let ((a (aref md5-buffer 0))
 296         (b (aref md5-buffer 1))
 297         (c (aref md5-buffer 2))
 298         (d (aref md5-buffer 3)))
 299     (setq
 300      a (md5-FF a b c d (aref in  0)  7 '(55146 . 42104))
 301      d (md5-FF d a b c (aref in  1) 12 '(59591 . 46934))
 302      c (md5-FF c d a b (aref in  2) 17 '( 9248 . 28891))
 303      b (md5-FF b c d a (aref in  3) 22 '(49597 . 52974))
 304      a (md5-FF a b c d (aref in  4)  7 '(62844 .  4015))
 305      d (md5-FF d a b c (aref in  5) 12 '(18311 . 50730))
 306      c (md5-FF c d a b (aref in  6) 17 '(43056 . 17939))
 307      b (md5-FF b c d a (aref in  7) 22 '(64838 . 38145))
 308      a (md5-FF a b c d (aref in  8)  7 '(27008 . 39128))
 309      d (md5-FF d a b c (aref in  9) 12 '(35652 . 63407))
 310      c (md5-FF c d a b (aref in 10) 17 '(65535 . 23473))
 311      b (md5-FF b c d a (aref in 11) 22 '(35164 . 55230))
 312      a (md5-FF a b c d (aref in 12)  7 '(27536 .  4386))
 313      d (md5-FF d a b c (aref in 13) 12 '(64920 . 29075))
 314      c (md5-FF c d a b (aref in 14) 17 '(42617 . 17294))
 315      b (md5-FF b c d a (aref in 15) 22 '(18868 .  2081))
 316      a (md5-GG a b c d (aref in  1)  5 '(63006 .  9570))
 317      d (md5-GG d a b c (aref in  6)  9 '(49216 . 45888))
 318      c (md5-GG c d a b (aref in 11) 14 '( 9822 . 23121))
 319      b (md5-GG b c d a (aref in  0) 20 '(59830 . 51114))
 320      a (md5-GG a b c d (aref in  5)  5 '(54831 .  4189))
 321      d (md5-GG d a b c (aref in 10)  9 '(  580 .  5203))
 322      c (md5-GG c d a b (aref in 15) 14 '(55457 . 59009))
 323      b (md5-GG b c d a (aref in  4) 20 '(59347 . 64456))
 324      a (md5-GG a b c d (aref in  9)  5 '( 8673 . 52710))
 325      d (md5-GG d a b c (aref in 14)  9 '(49975 .  2006))
 326      c (md5-GG c d a b (aref in  3) 14 '(62677 .  3463))
 327      b (md5-GG b c d a (aref in  8) 20 '(17754 .  5357))
 328      a (md5-GG a b c d (aref in 13)  5 '(43491 . 59653))
 329      d (md5-GG d a b c (aref in  2)  9 '(64751 . 41976))
 330      c (md5-GG c d a b (aref in  7) 14 '(26479 .   729))
 331      b (md5-GG b c d a (aref in 12) 20 '(36138 . 19594))
 332      a (md5-HH a b c d (aref in  5)  4 '(65530 . 14658))
 333      d (md5-HH d a b c (aref in  8) 11 '(34673 . 63105))
 334      c (md5-HH c d a b (aref in 11) 16 '(28061 . 24866))
 335      b (md5-HH b c d a (aref in 14) 23 '(64997 . 14348))
 336      a (md5-HH a b c d (aref in  1)  4 '(42174 . 59972))
 337      d (md5-HH d a b c (aref in  4) 11 '(19422 . 53161))
 338      c (md5-HH c d a b (aref in  7) 16 '(63163 . 19296))
 339      b (md5-HH b c d a (aref in 10) 23 '(48831 . 48240))
 340      a (md5-HH a b c d (aref in 13)  4 '(10395 . 32454))
 341      d (md5-HH d a b c (aref in  0) 11 '(60065 . 10234))
 342      c (md5-HH c d a b (aref in  3) 16 '(54511 . 12421))
 343      b (md5-HH b c d a (aref in  6) 23 '( 1160 .  7429))
 344      a (md5-HH a b c d (aref in  9)  4 '(55764 . 53305))
 345      d (md5-HH d a b c (aref in 12) 11 '(59099 . 39397))
 346      c (md5-HH c d a b (aref in 15) 16 '( 8098 . 31992))
 347      b (md5-HH b c d a (aref in  2) 23 '(50348 . 22117))
 348      a (md5-II a b c d (aref in  0)  6 '(62505 .  8772))
 349      d (md5-II d a b c (aref in  7) 10 '(17194 . 65431))
 350      c (md5-II c d a b (aref in 14) 15 '(43924 .  9127))
 351      b (md5-II b c d a (aref in  5) 21 '(64659 . 41017))
 352      a (md5-II a b c d (aref in 12)  6 '(25947 . 22979))
 353      d (md5-II d a b c (aref in  3) 10 '(36620 . 52370))
 354      c (md5-II c d a b (aref in 10) 15 '(65519 . 62589))
 355      b (md5-II b c d a (aref in  1) 21 '(34180 . 24017))
 356      a (md5-II a b c d (aref in  8)  6 '(28584 . 32335))
 357      d (md5-II d a b c (aref in 15) 10 '(65068 . 59104))
 358      c (md5-II c d a b (aref in  6) 15 '(41729 . 17172))
 359      b (md5-II b c d a (aref in 13) 21 '(19976 .  4513))
 360      a (md5-II a b c d (aref in  4)  6 '(63315 . 32386))
 361      d (md5-II d a b c (aref in 11) 10 '(48442 . 62005))
 362      c (md5-II c d a b (aref in  2) 15 '(10967 . 53947))
 363      b (md5-II b c d a (aref in  9) 21 '(60294 . 54161)))
 364
 365      (aset md5-buffer 0 (md5-add (aref md5-buffer 0) a))
 366      (aset md5-buffer 1 (md5-add (aref md5-buffer 1) b))
 367      (aset md5-buffer 2 (md5-add (aref md5-buffer 2) c))
 368      (aset md5-buffer 3 (md5-add (aref md5-buffer 3) d))))
 369
 370 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 371 ;;; Here begins the merger with the XEmacs API and the md5.el from the URL
 372 ;;; package.  Courtesy wmperry@cs.indiana.edu
 373 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 374 ;;;###autoload
 375 (defun md5 (object &optional start end)
 376   "Return the MD5 (a secure message digest algorithm) of an object.
 377 OBJECT is either a string or a buffer.
 378 Optional arguments START and END denote buffer positions for computing the
 379 hash of a portion of OBJECT."
 380  (let ((buffer nil))
 381     (unwind-protect
 382         (save-excursion
 383           (setq buffer (generate-new-buffer " *md5-work*"))
 384           (set-buffer buffer)
 385           (cond
 386            ((bufferp object)
 387             (insert-buffer-substring object start end))
 388            ((stringp object)
 389             (insert (if (or start end)
 390                         (substring object start end)
 391                       object)))
 392            (t nil))
 393           (prog1
 394               (if (or (null md5-maximum-internal-length)
 395                       (<= (point-max) md5-maximum-internal-length))
 396                   (mapconcat
 397                    (function (lambda (node) (format "%02x" node)))
 398                    (md5-encode (buffer-string))
 399                    "")
 400                 (call-process-region (point-min) (point-max)
 401                                      shell-file-name
 402                                      t buffer nil
 403                                      shell-command-switch md5-program)
 404                 ;; MD5 digest is 32 chars long
 405                 ;; mddriver adds a newline to make neaten output for tty
 406                 ;; viewing, make sure we leave it behind.
 407                 (buffer-substring (point-min) (+ (point-min) 32)))
 408             (kill-buffer buffer)))
 409       (and buffer (buffer-name buffer) (kill-buffer buffer) nil))))
 410
 411 (provide 'md5-el)