Source

ecrypto / md5-old.el

;;;  md5-old.el -- MD5 message digest algorithm

;; Copyright (C) 1998 Ray Jones

;; Author: Ray Jones, rjones@pobox.com
;; Keywords: MD5, message digest
;; Created: 1998-04-27

;; 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; if not, you can either send email to this
;; program's maintainer or write to: The Free Software Foundation,
;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.

;;; Commentary:

;; this is a slower, more clear, version of md5.el.  it's based on md5-old.el

;;; Code:
(require 'cl)

(defun md5 (string)
  "return the md5 hash of a string, as a 128 bit string"
  (let* ((length (length string))
	 ;; md5 requires the message be padded to a length of 512*k +
	 ;; 64 (bits).  confusion source: we're working with bytes.
	 ;; padding is always done.
	 ;; 512 bits = 64 bytes, 64 bits = 8 bytes
	 (next-512 (+ 64 (logand (+ length 8) (lognot 63))))
	 (pad-bytes (- next-512 length 8))
	 (pad-string (make-string pad-bytes 0))
	 (len-string (make-string 8 0)))
    ;; message is constructed as:
    ;; original-message | pad | length-in-bits
    ;; pad is 10000... (bitwise)
    ;; length-in-bits is length before padding, and is 64 bits long

    ;; fill in the single bit of the pad
    (aset pad-string 0 (ash 1 7))

    ;; there's a slim chance of overflow when multiplying the length
    ;; by 8 to get the length in bits.  to avoid this, do some
    ;; slightly hairier math when writing the length into len-string.
    ;; also, it has to be LSB-first.  be still my aching brain.

    ;; LSB sucks.

    ;; only do the first 4 bytes, even though supposedly there are 8.
    ;; 32 bit emacsen think that (ash 40 -37) => 1
    ;; (supposed to be fixed in future releases)
    (dotimes (idx 4)
      (aset len-string idx (logand ?\xff
				   (ash length (- 3 (* idx 8))))))
    
    (md5-vector
     (md5-string-to-32bit-vec
      (concat string pad-string len-string)))))

(defun md5-string-to-32bit-vec (string)
  ;; emacs doesn't actually have 32 bits, in most implementations.
  ;; 32 bit numbers are represented as a pair of 16 bit numbers

  ;; 4 chars per 32 bit number, in LSB-first!
  (let* ((veclen (/ (length string) 4))
	 (vec (make-vector veclen nil))
	 (stridx 0))
    (dotimes (vecidx veclen)
      ;; MD5 integers are (hi . lo) 16 bit words
      (aset vec vecidx (cons (+ (ash (aref string (+ stridx 3)) 8)
				(aref string (+ stridx 2)))
			     (+ (ash (aref string (+ stridx 1)) 8)
				(aref string (+ stridx 0)))))
      (incf stridx 4))

    vec))

(defsubst md5-f2 (x y z)
  (logior (logand x y)
	  (logand (lognot x)
		  z)))

(defsubst md5-g2 (x y z)
  (logior (logand x z)
	  (logand y (lognot z))))

(defsubst md5-h2 (x y z)
  (logxor x y z))

(defsubst md5-i2 (x y z)
  (logxor y
	  (logior x
		  ;; this is normally a lognot, but that would set
		  ;; high bits, and there's no logand to clear them.
		  (logxor z ?\xffff))))

(defsubst md5-f (x y z)
  (cons (md5-f2 (car x) (car y) (car z))
	(md5-f2 (cdr x) (cdr y) (cdr z))))

(defsubst md5-g (x y z)
  (cons (md5-g2 (car x) (car y) (car z))
	(md5-g2 (cdr x) (cdr y) (cdr z))))

(defsubst md5-h (x y z)
  (cons (md5-h2 (car x) (car y) (car z))
	(md5-h2 (cdr x) (cdr y) (cdr z))))

(defsubst md5-i (x y z)
  (cons (md5-i2 (car x) (car y) (car z))
	(md5-i2 (cdr x) (cdr y) (cdr z))))

(defsubst md5<<< (val shift)
  "circular shift md5 32 bit int VAL by SHIFT bits"
  (let ((a (car val))
	(b (cdr val)))

    ;; shifts greater than 16 need to be handled by a swap, then a
    ;; smaller shift
    (when (> shift 16)
      (rotatef a b)
      (decf shift 16))

    (cons (logand ?\xffff (logior (ash a shift) (ash b (- shift 16))))
	  (logand ?\xffff (logior (ash b shift) (ash a (- shift 16)))))))

(defsubst md5+ (&rest args)
  ;; enough room to just add without carry checks
  (let* ((lo (apply #'+ (mapcar #'cdr args)))
	 (hi (+ (ash lo -16) (apply #'+ (mapcar #'car args)))))
    (cons (logand ?\xffff hi)
	  (logand ?\xffff lo))))

;; array of values for i=[1..64] => floor(2^32 * abs(sin(i)))
(defconst md5-t

  [(?\xd76a . ?\xa478)
   (?\xe8c7 . ?\xb756)
   (?\x2420 . ?\x70db)
   (?\xc1bd . ?\xceee)
   (?\xf57c . ?\x0faf)
   (?\x4787 . ?\xc62a)
   (?\xa830 . ?\x4613)
   (?\xfd46 . ?\x9501)
   (?\x6980 . ?\x98d8)
   (?\x8b44 . ?\xf7af)
   (?\xffff . ?\x5bb1)
   (?\x895c . ?\xd7be)
   (?\x6b90 . ?\x1122)
   (?\xfd98 . ?\x7193)
   (?\xa679 . ?\x438e)
   (?\x49b4 . ?\x0821)

   (?\xf61e . ?\x2562)
   (?\xc040 . ?\xb340)
   (?\x265e . ?\x5a51)
   (?\xe9b6 . ?\xc7aa)
   (?\xd62f . ?\x105d)
   (?\x0244 . ?\x1453)
   (?\xd8a1 . ?\xe681)
   (?\xe7d3 . ?\xfbc8)
   (?\x21e1 . ?\xcde6)
   (?\xc337 . ?\x07d6)
   (?\xf4d5 . ?\x0d87)
   (?\x455a . ?\x14ed)
   (?\xa9e3 . ?\xe905)
   (?\xfcef . ?\xa3f8)
   (?\x676f . ?\x02d9)
   (?\x8d2a . ?\x4c8a)

   (?\xfffa . ?\x3942)
   (?\x8771 . ?\xf681)
   (?\x6d9d . ?\x6122)
   (?\xfde5 . ?\x380c)
   (?\xa4be . ?\xea44)
   (?\x4bde . ?\xcfa9)
   (?\xf6bb . ?\x4b60)
   (?\xbebf . ?\xbc70)
   (?\x289b . ?\x7ec6)
   (?\xeaa1 . ?\x27fa)
   (?\xd4ef . ?\x3085)
   (?\x0488 . ?\x1d05)
   (?\xd9d4 . ?\xd039)
   (?\xe6db . ?\x99e5)
   (?\x1fa2 . ?\x7cf8)
   (?\xc4ac . ?\x5665)

   (?\xf429 . ?\x2244)
   (?\x432a . ?\xff97)
   (?\xab94 . ?\x23a7)
   (?\xfc93 . ?\xa039)
   (?\x655b . ?\x59c3)
   (?\x8f0c . ?\xcc92)
   (?\xffef . ?\xf47d)
   (?\x8584 . ?\x5dd1)
   (?\x6fa8 . ?\x7e4f)
   (?\xfe2c . ?\xe6e0)
   (?\xa301 . ?\x4314)
   (?\x4e08 . ?\x11a1)
   (?\xf753 . ?\x7e82)
   (?\xbd3a . ?\xf235)
   (?\x2ad7 . ?\xd2bb)
   (?\xeb86 . ?\xd391)])

(eval-and-compile
  (defun md5-rewrite (fun w x y z vec-idx shift)
    "helper function for md5-vector, below.  ugly coding practice,
having a macro-rewriter elsewhere, but the indentation was getting a
bit out of control.
NB: vec, v-offset, and t-idx below must be defined where the macro is
called!" 
    `(setq ,w (md5+ ,x
		    (md5<<< (md5+ ,w
				  ,(list fun x y z)
				  (aref vec (+ v-offset ,vec-idx))
				  (aref md5-t t-idx))
			    ,shift)))))


(defun md5-vector (vec)
  ;; initialize the chaining variables
  (let ((a (cons ?\x6745 ?\x2301))
	(b (cons ?\xefcd ?\xab89))
	(c (cons ?\x98ba ?\xdcfe))
	(d (cons ?\x1032 ?\x5476))
	(v-offset 0))

    (dotimes (count (/ (length vec) 16))
      (let ((AA a) (BB b) (CC c) (DD d)
	    (t-idx 0))
	(macrolet
	    ((f (v1 v2 v3 v4 v-idx shift)
		`(progn
		   ,(md5-rewrite 'md5-f v1 v2 v3 v4 v-idx shift)
		   (incf t-idx))))

	  (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)
	  (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)
	  (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)
	  (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))

	(macrolet
	    ((g (v1 v2 v3 v4 v-idx shift)
		`(progn
		   ,(md5-rewrite 'md5-g v1 v2 v3 v4 v-idx shift)
		   (incf t-idx))))

	  (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)
	  (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)
	  (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)
	  (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))

	(macrolet
	    ((h (v1 v2 v3 v4 v-idx shift)
		`(progn
		   ,(md5-rewrite 'md5-h v1 v2 v3 v4 v-idx shift)
		   (incf t-idx))))

	  (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)
	  (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)
	  (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)
	  (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))

	(macrolet
	    ((i (v1 v2 v3 v4 v-idx shift)
		`(progn
		   ,(md5-rewrite `md5-i v1 v2 v3 v4 v-idx shift)
		   (incf t-idx))))

	  (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)
	  (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)
	  (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)
	  (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))

	(setq a (md5+ AA a)
	      b (md5+ BB b)
	      c (md5+ CC c)
	      d (md5+ DD d)))

      (incf v-offset 16))

    ;; swap back from LSB-first.  i feel ill.
    (mapconcat #'(lambda (x) (format "%02x%02x" (logand ?\xff x) (ash x -8)))
	       (list (cdr a) (car a)
		     (cdr b) (car b)
		     (cdr c) (car c)
		     (cdr d) (car d))
	       "")))

(provide 'md5)
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.