+++ /dev/null
-;;; md4.el --- MD4 Message Digest Algorithm.
-
-;; Copyright (C) 2001, 2004, 2007 Free Software Foundation, Inc.
-
-;; Author: Taro Kawagishi <tarok@transpulse.org>
-;; Keywords: MD4
-;; Version: 1.00
-;; Created: February 2001
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs 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 3, or (at your option)
-;; any later version.
-
-;; GNU Emacs 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 GNU Emacs; 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)
-
-;;; arch-tag: 99d706fe-089b-42ea-9507-67ae41091e6e
-;;; md4.el ends here
projects / emacs.git / commitdiff