Commits

Anonymous committed 3abf951

2002-08-02 Simon Josefsson <jas@extundo.com>

* hex-util.el: New file.

* package-info.in: Fix package name, fix provides.

* sha1-el.el (sha1): autoload.

* md5-el.el (md5): autoload.
(md5-program, md5-maximum-internal-length): defcustom.

* md4.el (md4): autoload.

* sha1.el, sha1-el.el, sha1-dl.el, md5.el, md5-el.el, md5-dl.el:
Replace with versions from FLIM. Supports emacsen that can load
dynamic libraries, otherwise should be equal.

* Makefile (PACKAGE): Fix package name.
(ELCS): Add md4.elc md5.elc md5-el.elc md5-dl.elc sha1.elc
sha1-el.elc sha1-dl.elc hex-util.elc.

  • Participants
  • Parent commits 0ef33fe

Comments (0)

Files changed (11)

+2002-08-02  Simon Josefsson  <jas@extundo.com>
+
+	* hex-util.el: New file.
+
+	* package-info.in: Fix package name, fix provides.
+
+	* sha1-el.el (sha1): autoload.
+
+	* md5-el.el (md5): autoload.
+	(md5-program, md5-maximum-internal-length): defcustom.
+
+	* md4.el (md4): autoload.
+
+	* sha1.el, sha1-el.el, sha1-dl.el, md5.el, md5-el.el, md5-dl.el:
+	Replace with versions from FLIM. Supports emacsen that can load
+	dynamic libraries, otherwise should be equal.
+
+	* Makefile (PACKAGE): Fix package name.
+	(ELCS): Add md4.elc md5.elc md5-el.elc md5-dl.elc sha1.elc
+	sha1-el.elc sha1-dl.elc hex-util.elc.
+
 2002-08-01  Ville Skyttä  <ville.skytta@xemacs.org>
 
 	* .cvsignore: New.
 VERSION = 0.1
 AUTHOR_VERSION = 2.0
 MAINTAINER = Simon Josefsson <simon@josefsson.org>
-PACKAGE = crypto
+PACKAGE = ecrypto
 PKG_TYPE = regular
 REQUIRES = 
 CATEGORY = unsupported
 
 ELCS = ascii-armor.elc blowfish.elc des.elc idea.elc paranoid.elc rander.elc \
-	rc16.elc sha1.elc
+	rc16.elc sha1.elc sha1-el.elc sha1-dl.elc md4.elc md5.elc md5-el.elc \
+	md5-dl.elc hex-util.elc
 
 include ../../XEmacs.rules
 
+;;; hex-util.el --- Functions to encode/decode hexadecimal string.
+
+;; Copyright (C) 1999, 2001  Free Software Foundation, Inc.
+
+;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+;; Keywords: data
+
+;; This file is part of FLIM (Faithful Library about Internet Message).
+
+;; 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; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile
+  (defmacro hex-char-to-num (chr)
+    (` (let ((chr (, chr)))
+	 (cond
+	  ((and (<= ?a chr)(<= chr ?f)) (+ (- chr ?a) 10))
+	  ((and (<= ?A chr)(<= chr ?F)) (+ (- chr ?A) 10))
+	  ((and (<= ?0 chr)(<= chr ?9)) (- chr ?0))
+	  (t (error "Invalid hexadecimal digit `%c'" chr))))))
+  (defmacro num-to-hex-char (num)
+    (` (aref "0123456789abcdef" (, num)))))
+
+(defun decode-hex-string (string)
+  "Decode hexadecimal STRING to octet string."
+  (let* ((len (length string))
+	 (dst (make-string (/ len 2) 0))
+	 (idx 0)(pos 0))
+    (while (< pos len)
+;;; logior and lsh are not byte-coded.
+;;;  (aset dst idx (logior (lsh (hex-char-to-num (aref string pos)) 4)
+;;; 			    (hex-char-to-num (aref string (1+ pos)))))
+      (aset dst idx (+ (* (hex-char-to-num (aref string pos)) 16)
+		       (hex-char-to-num (aref string (1+ pos)))))
+      (setq idx (1+ idx)
+            pos (+ 2 pos)))
+    dst))
+
+(defun encode-hex-string (string)
+  "Encode octet STRING to hexadecimal string."
+  (let* ((len (length string))
+	 (dst (make-string (* len 2) 0))
+	 (idx 0)(pos 0))
+    (while (< pos len)
+;;; logand and lsh are not byte-coded.
+;;;  (aset dst idx (num-to-hex-char (logand (lsh (aref string pos) -4) 15)))
+      (aset dst idx (num-to-hex-char (/ (aref string pos) 16)))
+      (setq idx (1+ idx))
+;;;  (aset dst idx (num-to-hex-char (logand (aref string pos) 15)))
+      (aset dst idx (num-to-hex-char (% (aref string pos) 16)))
+      (setq idx (1+ idx)
+            pos (1+ pos)))
+    dst))
+
+(provide 'hex-util)
+
+;;; hex-util.el ends here
+;;; md4.el --- MD4 Message Digest Algorithm.
+
+;; Copyright (C) 2001 Taro Kawagishi
+;; Author: Taro Kawagishi <tarok@transpulse.org>
+;; Keywords: MD4
+;; Version: 1.00
+;; Created: February 2001
+
+;; This file is part of FLIM (Faithful Library about Internet Message).
+
+;; 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; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+;;;
+;;; MD4 hash calculation
+
+(defun print-int32 (int32)
+  "print 32 bits integer in 4 bytes string as little endian"
+  (let ((h (car int32)) (l (cdr int32)))
+    (list (logand l 255) (lsh l -8) (logand h 255) (lsh h -8))))
+
+(defun print-string-hexa (str)
+  "print a string in hexadecimal"
+  (let (out)
+    (mapcar (function (lambda (x) (concat out (format "%x" x)))) str)))
+
+(defvar md4-buffer (make-vector 4 '(0 . 0))
+  "work buffer of four 32-bit integers")
+
+;;;###autoload
+(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)
+
+;;; md4.el ends here
+;;; md5-dl.el --- MD5 Message Digest Algorithm using DL module.
+
+;; Copyright (C) 1999, 2001  Free Software Foundation, Inc.
+
+;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+;; Keywords: MD5, RFC 1321
+
+;; This file is part of FLIM (Faithful Library about Internet Message).
+
+;; 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; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(provide 'md5-dl)			; beware of circular dependency.
+(eval-when-compile (require 'md5))	; md5-dl-module.
+
+;;; This file is loaded (from "md5.el") only when md5-dl-module is exists.
+(defvar md5-dl-handle (dynamic-link md5-dl-module))
+
+;;; md5-dl-module provides `md5-string'.
+(dynamic-call "emacs_md5_init" md5-dl-handle)
+
+(defun md5-region (beg end)
+  (md5-string (buffer-substring-no-properties beg end)))
+
+;;; Note that v21 `md5' takes two more args: CODING and NOERROR.
+(defun md5 (object &optional beg end)
+  "Return the MD5 (a secure message digest algorithm) of an object.
+OBJECT is either a string or a buffer.
+Optional arguments BEG and END denote buffer positions for computing the
+hash of a portion of OBJECT."
+  (if (stringp object)
+      (md5-string object)
+    (save-excursion
+      (set-buffer object)
+      (md5-region (or beg (point-min)) (or end (point-max))))))
+
+(provide 'md5-dl)
+
+;;; md5-dl.el ends here
+;;; md5.el -- MD5 Message Digest Algorithm
+;;; Gareth Rees <gdr11@cl.cam.ac.uk>
+
+;; LCD Archive Entry:
+;; md5|Gareth Rees|gdr11@cl.cam.ac.uk|
+;; MD5 cryptographic message digest algorithm|
+;; 13-Nov-95|1.0|~/misc/md5.el.Z|
+
+;;; Details: ------------------------------------------------------------------
+
+;; This is a direct translation into Emacs LISP of the reference C
+;; implementation of the MD5 Message-Digest Algorithm written by RSA
+;; Data Security, Inc.
+;; 
+;; The algorithm takes a message (that is, a string of bytes) and
+;; computes a 16-byte checksum or "digest" for the message.  This digest
+;; is supposed to be cryptographically strong in the sense that if you
+;; are given a 16-byte digest D, then there is no easier way to
+;; construct a message whose digest is D than to exhaustively search the
+;; space of messages.  However, the robustness of the algorithm has not
+;; been proven, and a similar algorithm (MD4) was shown to be unsound,
+;; so treat with caution!
+;; 
+;; The C algorithm uses 32-bit integers; because GNU Emacs
+;; implementations provide 28-bit integers (with 24-bit integers on
+;; versions prior to 19.29), the code represents a 32-bit integer as the
+;; cons of two 16-bit integers.  The most significant word is stored in
+;; the car and the least significant in the cdr.  The algorithm requires
+;; at least 17 bits of integer representation in order to represent the
+;; carry from a 16-bit addition.
+
+;;; Usage: --------------------------------------------------------------------
+
+;; To compute the MD5 Message Digest for a message M (represented as a
+;; string or as a vector of bytes), call
+;; 
+;;   (md5-encode M)
+;; 
+;; which returns the message digest as a vector of 16 bytes.  If you
+;; need to supply the message in pieces M1, M2, ... Mn, then call
+;; 
+;;   (md5-init)
+;;   (md5-update M1)
+;;   (md5-update M2)
+;;   ...
+;;   (md5-update Mn)
+;;   (md5-final)
+
+;;; Copyright and licence: ----------------------------------------------------
+
+;; Copyright (C) 1995, 1996, 1997 by Gareth Rees
+;; Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm
+;; 
+;; md5.el 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.
+;; 
+;; md5.el 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.
+;; 
+;; The original copyright notice is given below, as required by the
+;; licence for the original code.  This code is distributed under *both*
+;; RSA's original licence and the GNU General Public Licence.  (There
+;; should be no problems, as the former is more liberal than the
+;; latter).
+
+;;; Original copyright notice: ------------------------------------------------
+
+;; Copyright (C) 1990, RSA Data Security, Inc. All rights reserved.
+;;
+;; License to copy and use this software is granted provided that it is
+;; identified as the "RSA Data Security, Inc. MD5 Message- Digest
+;; Algorithm" in all material mentioning or referencing this software or
+;; this function.
+;;
+;; License is also granted to make and use derivative works provided
+;; that such works are identified as "derived from the RSA Data
+;; Security, Inc. MD5 Message-Digest Algorithm" in all material
+;; mentioning or referencing the derived work.
+;;
+;; RSA Data Security, Inc. makes no representations concerning either
+;; the merchantability of this software or the suitability of this
+;; software for any particular purpose.  It is provided "as is" without
+;; express or implied warranty of any kind.
+;;
+;; These notices must be retained in any copies of any part of this
+;; documentation and/or software.
+
+;;; Code: ---------------------------------------------------------------------
+
+(defcustom md5-program "md5"
+  "*Program that reads a message on its standard input and writes an
+MD5 digest on its output."
+  :type 'string)
+
+(defcustom md5-maximum-internal-length 4096
+  "*The maximum size of a piece of data that should use the MD5 routines
+written in lisp.  If a message exceeds this, it will be run through an
+external filter for processing.  Also see the `md5-program' variable.
+This variable has no effect if you call the md5-init|update|final
+functions - only used by the `md5' function's simpler interface."
+  :type 'integer)
+
+(defvar md5-bits (make-vector 4 0)
+  "Number of bits handled, modulo 2^64.
+Represented as four 16-bit numbers, least significant first.")
+(defvar md5-buffer (make-vector 4 '(0 . 0))
+  "Scratch buffer (four 32-bit integers).")
+(defvar md5-input (make-vector 64 0)
+  "Input buffer (64 bytes).")
+
+(defun md5-unhex (x)
+  (if (> x ?9)
+      (if (>= x ?a)
+	  (+ 10 (- x ?a))
+	(+ 10 (- x ?A)))
+    (- x ?0)))
+
+(defun md5-encode (message)
+  "Encodes MESSAGE using the MD5 message digest algorithm.
+MESSAGE must be a string or an array of bytes.
+Returns a vector of 16 bytes containing the message digest."
+  (if (or (null md5-maximum-internal-length)
+	   (<= (length message) md5-maximum-internal-length))
+      (progn
+	(md5-init)
+	(md5-update message)
+	(md5-final))
+    (save-excursion
+      (set-buffer (get-buffer-create " *md5-work*"))
+      (erase-buffer)
+      (insert message)
+      (call-process-region (point-min) (point-max)
+			   md5-program
+			   t (current-buffer))
+      ;; MD5 digest is 32 chars long
+      ;; mddriver adds a newline to make neaten output for tty
+      ;; viewing, make sure we leave it behind.
+      (let ((data (buffer-substring (point-min) (+ (point-min) 32)))
+	    (vec (make-vector 16 0))
+	    (ctr 0))
+	(while (< ctr 16)
+	  (aset vec ctr (+ (* 16 (md5-unhex (aref data (* ctr 2))))
+			   (md5-unhex (aref data (1+ (* ctr 2))))))
+	  (setq ctr (1+ ctr)))))))
+
+(defsubst md5-add (x y)
+  "Return 32-bit sum of 32-bit integers X and Y."
+  (let ((m (+ (car x) (car y)))
+        (l (+ (cdr x) (cdr y))))
+    (cons (logand 65535 (+ m (lsh l -16))) (logand l 65535))))
+
+;; FF, GG, HH and II are basic MD5 functions, providing transformations
+;; for rounds 1, 2, 3 and 4 respectively.  Each function follows this
+;; pattern of computation (where ROTATE(x,y) means rotate 32-bit value x
+;; by y bits to the left):
+;; 
+;;   FF(a,b,c,d,x,s,ac) = ROTATE(a + F(b,c,d) + x + ac,s) + b
+;; 
+;; so we use the macro `md5-make-step' to construct each one.  The
+;; helper functions F, G, H and I operate on 16-bit numbers; the full
+;; operation splits its inputs, operates on the halves separately and
+;; then puts the results together.
+
+(defsubst md5-F (x y z) (logior (logand x y) (logand (lognot x) z)))
+(defsubst md5-G (x y z) (logior (logand x z) (logand y (lognot z))))
+(defsubst md5-H (x y z) (logxor x y z))
+(defsubst md5-I (x y z) (logxor y (logior x (logand 65535 (lognot z)))))
+
+(defmacro md5-make-step (name func)
+  (`
+   (defun (, name) (a b c d x s ac)
+     (let*
+         ((m1 (+ (car a) ((, func) (car b) (car c) (car d)) (car x) (car ac)))
+          (l1 (+ (cdr a) ((, func) (cdr b) (cdr c) (cdr d)) (cdr x) (cdr ac)))
+          (m2 (logand 65535 (+ m1 (lsh l1 -16))))
+          (l2 (logand 65535 l1))
+          (m3 (logand 65535 (if (> s 15)
+                                (+ (lsh m2 (- s 32)) (lsh l2 (- s 16)))
+                              (+ (lsh m2 s) (lsh l2 (- s 16))))))
+          (l3 (logand 65535 (if (> s 15)
+                                (+ (lsh l2 (- s 32)) (lsh m2 (- s 16)))
+                              (+ (lsh l2 s) (lsh m2 (- s 16)))))))
+       (md5-add (cons m3 l3) b)))))
+
+(md5-make-step md5-FF md5-F)
+(md5-make-step md5-GG md5-G)
+(md5-make-step md5-HH md5-H)
+(md5-make-step md5-II md5-I)
+
+(defun md5-init ()
+  "Initialise the state of the message-digest routines."
+  (aset md5-bits 0 0)
+  (aset md5-bits 1 0)
+  (aset md5-bits 2 0)
+  (aset md5-bits 3 0)
+  (aset md5-buffer 0 '(26437 .  8961))
+  (aset md5-buffer 1 '(61389 . 43913))
+  (aset md5-buffer 2 '(39098 . 56574))
+  (aset md5-buffer 3 '( 4146 . 21622)))
+
+(defun md5-update (string)
+  "Update the current MD5 state with STRING (an array of bytes)."
+  (let ((len (length string))
+        (i 0)
+        (j 0))
+    (while (< i len)
+      ;; Compute number of bytes modulo 64
+      (setq j (% (/ (aref md5-bits 0) 8) 64))
+
+      ;; Store this byte (truncating to 8 bits to be sure)
+      (aset md5-input j (logand 255 (aref string i)))
+
+      ;; Update number of bits by 8 (modulo 2^64)
+      (let ((c 8) (k 0))
+        (while (and (> c 0) (< k 4))
+          (let ((b (aref md5-bits k)))
+            (aset md5-bits k (logand 65535 (+ b c)))
+            (setq c (if (> b (- 65535 c)) 1 0)
+                  k (1+ k)))))
+
+      ;; Increment number of bytes processed
+      (setq i (1+ i))
+
+      ;; When 64 bytes accumulated, pack them into sixteen 32-bit
+      ;; integers in the array `in' and then tranform them.
+      (if (= j 63)
+          (let ((in (make-vector 16 (cons 0 0)))
+                (k 0)
+                (kk 0))
+            (while (< k 16)
+              (aset in k (md5-pack md5-input kk))
+              (setq k (+ k 1) kk (+ kk 4)))
+            (md5-transform in))))))
+
+(defun md5-pack (array i)
+  "Pack the four bytes at ARRAY reference I to I+3 into a 32-bit integer."
+  (cons (+ (lsh (aref array (+ i 3)) 8) (aref array (+ i 2)))
+        (+ (lsh (aref array (+ i 1)) 8) (aref array (+ i 0)))))
+
+(defun md5-byte (array n b)
+  "Unpack byte B (0 to 3) from Nth member of ARRAY of 32-bit integers."
+  (let ((e (aref array n)))
+    (cond ((eq b 0) (logand 255 (cdr e)))
+          ((eq b 1) (lsh (cdr e) -8))
+          ((eq b 2) (logand 255 (car e)))
+          ((eq b 3) (lsh (car e) -8)))))
+
+(defun md5-final ()
+  (let ((in (make-vector 16 (cons 0 0)))
+        (j 0)
+        (digest (make-vector 16 0))
+        (padding))
+
+    ;; Save the number of bits in the message
+    (aset in 14 (cons (aref md5-bits 1) (aref md5-bits 0)))
+    (aset in 15 (cons (aref md5-bits 3) (aref md5-bits 2)))
+
+    ;; Compute number of bytes modulo 64
+    (setq j (% (/ (aref md5-bits 0) 8) 64))
+
+    ;; Pad out computation to 56 bytes modulo 64
+    (setq padding (make-vector (if (< j 56) (- 56 j) (- 120 j)) 0))
+    (aset padding 0 128)
+    (md5-update padding)
+
+    ;; Append length in bits and transform
+    (let ((k 0) (kk 0))
+      (while (< k 14)
+        (aset in k (md5-pack md5-input kk))
+        (setq k (+ k 1) kk (+ kk 4))))
+    (md5-transform in)
+
+    ;; Store the results in the digest
+    (let ((k 0) (kk 0))
+      (while (< k 4)
+        (aset digest (+ kk 0) (md5-byte md5-buffer k 0))
+        (aset digest (+ kk 1) (md5-byte md5-buffer k 1))
+        (aset digest (+ kk 2) (md5-byte md5-buffer k 2))
+        (aset digest (+ kk 3) (md5-byte md5-buffer k 3))
+        (setq k (+ k 1) kk (+ kk 4))))
+
+    ;; Return digest
+    digest))
+
+;; It says in the RSA source, "Note that if the Mysterious Constants are
+;; arranged backwards in little-endian order and decrypted with the DES
+;; they produce OCCULT MESSAGES!"  Security through obscurity?
+
+(defun md5-transform (in)
+  "Basic MD5 step. Transform md5-buffer based on array IN."
+  (let ((a (aref md5-buffer 0))
+        (b (aref md5-buffer 1))
+        (c (aref md5-buffer 2))
+        (d (aref md5-buffer 3)))
+    (setq
+     a (md5-FF a b c d (aref in  0)  7 '(55146 . 42104))
+     d (md5-FF d a b c (aref in  1) 12 '(59591 . 46934))
+     c (md5-FF c d a b (aref in  2) 17 '( 9248 . 28891))
+     b (md5-FF b c d a (aref in  3) 22 '(49597 . 52974))
+     a (md5-FF a b c d (aref in  4)  7 '(62844 .  4015))
+     d (md5-FF d a b c (aref in  5) 12 '(18311 . 50730))
+     c (md5-FF c d a b (aref in  6) 17 '(43056 . 17939))
+     b (md5-FF b c d a (aref in  7) 22 '(64838 . 38145))
+     a (md5-FF a b c d (aref in  8)  7 '(27008 . 39128))
+     d (md5-FF d a b c (aref in  9) 12 '(35652 . 63407))
+     c (md5-FF c d a b (aref in 10) 17 '(65535 . 23473))
+     b (md5-FF b c d a (aref in 11) 22 '(35164 . 55230))
+     a (md5-FF a b c d (aref in 12)  7 '(27536 .  4386))
+     d (md5-FF d a b c (aref in 13) 12 '(64920 . 29075))
+     c (md5-FF c d a b (aref in 14) 17 '(42617 . 17294))
+     b (md5-FF b c d a (aref in 15) 22 '(18868 .  2081))
+     a (md5-GG a b c d (aref in  1)  5 '(63006 .  9570))
+     d (md5-GG d a b c (aref in  6)  9 '(49216 . 45888))
+     c (md5-GG c d a b (aref in 11) 14 '( 9822 . 23121))
+     b (md5-GG b c d a (aref in  0) 20 '(59830 . 51114))
+     a (md5-GG a b c d (aref in  5)  5 '(54831 .  4189))
+     d (md5-GG d a b c (aref in 10)  9 '(  580 .  5203))
+     c (md5-GG c d a b (aref in 15) 14 '(55457 . 59009))
+     b (md5-GG b c d a (aref in  4) 20 '(59347 . 64456))
+     a (md5-GG a b c d (aref in  9)  5 '( 8673 . 52710))
+     d (md5-GG d a b c (aref in 14)  9 '(49975 .  2006))
+     c (md5-GG c d a b (aref in  3) 14 '(62677 .  3463))
+     b (md5-GG b c d a (aref in  8) 20 '(17754 .  5357))
+     a (md5-GG a b c d (aref in 13)  5 '(43491 . 59653))
+     d (md5-GG d a b c (aref in  2)  9 '(64751 . 41976))
+     c (md5-GG c d a b (aref in  7) 14 '(26479 .   729))
+     b (md5-GG b c d a (aref in 12) 20 '(36138 . 19594))
+     a (md5-HH a b c d (aref in  5)  4 '(65530 . 14658))
+     d (md5-HH d a b c (aref in  8) 11 '(34673 . 63105))
+     c (md5-HH c d a b (aref in 11) 16 '(28061 . 24866))
+     b (md5-HH b c d a (aref in 14) 23 '(64997 . 14348))
+     a (md5-HH a b c d (aref in  1)  4 '(42174 . 59972))
+     d (md5-HH d a b c (aref in  4) 11 '(19422 . 53161))
+     c (md5-HH c d a b (aref in  7) 16 '(63163 . 19296))
+     b (md5-HH b c d a (aref in 10) 23 '(48831 . 48240))
+     a (md5-HH a b c d (aref in 13)  4 '(10395 . 32454))
+     d (md5-HH d a b c (aref in  0) 11 '(60065 . 10234))
+     c (md5-HH c d a b (aref in  3) 16 '(54511 . 12421))
+     b (md5-HH b c d a (aref in  6) 23 '( 1160 .  7429))
+     a (md5-HH a b c d (aref in  9)  4 '(55764 . 53305))
+     d (md5-HH d a b c (aref in 12) 11 '(59099 . 39397))
+     c (md5-HH c d a b (aref in 15) 16 '( 8098 . 31992))
+     b (md5-HH b c d a (aref in  2) 23 '(50348 . 22117))
+     a (md5-II a b c d (aref in  0)  6 '(62505 .  8772))
+     d (md5-II d a b c (aref in  7) 10 '(17194 . 65431))
+     c (md5-II c d a b (aref in 14) 15 '(43924 .  9127))
+     b (md5-II b c d a (aref in  5) 21 '(64659 . 41017))
+     a (md5-II a b c d (aref in 12)  6 '(25947 . 22979))
+     d (md5-II d a b c (aref in  3) 10 '(36620 . 52370))
+     c (md5-II c d a b (aref in 10) 15 '(65519 . 62589))
+     b (md5-II b c d a (aref in  1) 21 '(34180 . 24017))
+     a (md5-II a b c d (aref in  8)  6 '(28584 . 32335))
+     d (md5-II d a b c (aref in 15) 10 '(65068 . 59104))
+     c (md5-II c d a b (aref in  6) 15 '(41729 . 17172))
+     b (md5-II b c d a (aref in 13) 21 '(19976 .  4513))
+     a (md5-II a b c d (aref in  4)  6 '(63315 . 32386))
+     d (md5-II d a b c (aref in 11) 10 '(48442 . 62005))
+     c (md5-II c d a b (aref in  2) 15 '(10967 . 53947))
+     b (md5-II b c d a (aref in  9) 21 '(60294 . 54161)))
+
+     (aset md5-buffer 0 (md5-add (aref md5-buffer 0) a))
+     (aset md5-buffer 1 (md5-add (aref md5-buffer 1) b))
+     (aset md5-buffer 2 (md5-add (aref md5-buffer 2) c))
+     (aset md5-buffer 3 (md5-add (aref md5-buffer 3) d))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Here begins the merger with the XEmacs API and the md5.el from the URL
+;;; package.  Courtesy wmperry@cs.indiana.edu
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;###autoload
+(defun md5 (object &optional start end)
+  "Return the MD5 (a secure message digest algorithm) of an object.
+OBJECT is either a string or a buffer.
+Optional arguments START and END denote buffer positions for computing the
+hash of a portion of OBJECT."
+ (let ((buffer nil))
+    (unwind-protect
+	(save-excursion
+	  (setq buffer (generate-new-buffer " *md5-work*"))
+	  (set-buffer buffer)
+	  (cond
+	   ((bufferp object)
+	    (insert-buffer-substring object start end))
+	   ((stringp object)
+	    (insert (if (or start end)
+			(substring object start end)
+		      object)))
+	   (t nil))
+	  (prog1
+	      (if (or (null md5-maximum-internal-length)
+		      (<= (point-max) md5-maximum-internal-length))
+		  (mapconcat
+		   (function (lambda (node) (format "%02x" node)))
+		   (md5-encode (buffer-string))
+		   "")
+		(call-process-region (point-min) (point-max)
+				     shell-file-name
+				     t buffer nil
+				     shell-command-switch md5-program)
+		;; MD5 digest is 32 chars long
+		;; mddriver adds a newline to make neaten output for tty
+		;; viewing, make sure we leave it behind.
+		(buffer-substring (point-min) (+ (point-min) 32)))
+	    (kill-buffer buffer)))
+      (and buffer (buffer-name buffer) (kill-buffer buffer) nil))))
+
+(provide 'md5-el)
-;;;  md5.el -- MD5 message digest algorithm
+;;; md5.el --- MD5 Message Digest Algorithm.
 
-;; Copyright (C) 1998 Ray Jones
+;; Copyright (C) 1999, 2001  Free Software Foundation, Inc.
 
-;; Author: Ray Jones, rjones@pobox.com
-;; Keywords: MD5, message digest
-;; Created: 1998-04-27
+;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+;; Keywords: MD5, RFC 1321
 
-;; 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 file is part of FLIM (Faithful Library about Internet Message).
+
+;; 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.
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
 
 ;;; Commentary:
 
-;; this is an implementation of the MD5 hashing algorithm as described
-;; in RFC 1321.  Applied Cryptography, by Bruce Schneier, was used as
-;; a reference, but it should be noted that the initialization values
-;; for the chaining vectors in that book are in byte-reversed order,
-;; as of the 4th printing.  the mixin constants are correct, though.
+;; Test cases from RFC 1321.
 ;;
-;; this code might be somewhat confusing at first (or second).  two
-;; sources of confusion are likely: the fact that MD5 works in least
-;; significant byte order on the data, and that this code represents
-;; 32 bit numbers as two 16 bit numbers (most emacsen not being able
-;; to go past 27 bits).
+;; (md5 "")
+;; => d41d8cd98f00b204e9800998ecf8427e
 ;;
-;; this code was first written to appear as close to the format in the
-;; RFC, then adjusted to take advantage of the patterns in the message
-;; index (v-idx, below, in md5-vectors).  originally, numbers were
-;; passed around and operated on as pairs, but the algorithm can be
-;; (and has been) made to operate independently on the two 16-bit
-;; halves of the numbers, combining both halves only when doing adds
-;; and circular shifts.  this keeps consing to a minimum (almost
-;; none), and roughly doubles the speed compared to the equivalent
-;; algorithm operating on numbers as pairs.
+;; (md5 "a")
+;; => 0cc175b9c0f1b6a831c399e269772661
 ;;
-;; it also provides for greater security when hashing sensistive
-;; strings, since less data is created and left for the GC to clean
-;; up.
+;; (md5 "abc")
+;; => 900150983cd24fb0d6963f7d28e17f72
 ;;
-;; there should be a file called md5-old.el accompanying this file.
-;; it is the original, slow, consful version of this code, and is
-;; (hopefully) easier to understand.
+;; (md5 "message digest")
+;; => f96b697d7cb7938d525a2f31aaf161d0
+;;
+;; (md5 "abcdefghijklmnopqrstuvwxyz")
+;; => c3fcd3d76192e4007dfb496cca67e13b
+;;
+;; (md5 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789")
+;; => d174ab98d277d9f5a5611c2c9f419d9f
+;;
+;; (md5 "12345678901234567890123456789012345678901234567890123456789012345678901234567890")
+;; => 57edf4a22be3c955ac49da2e2107b67a
 
-(require 'cl)
+;;; Code:
 
-(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
+(defvar md5-dl-module
+  (cond
+   ((and (fboundp 'md5)
+	 (subrp (symbol-function 'md5)))
+    nil)
+   ((fboundp 'dynamic-link)
+    ;; Should we take care of `dynamic-link-path'?
+    (let ((path (expand-file-name "md5.so" exec-directory)))
+      (if (file-exists-p path)
+	  path
+	nil)))
+   (t
+    nil)))
 
-    ;; 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))))))
-    
-
-    (let* ((concat-string (concat string pad-string len-string))
-           (vecs (md5-string-to-32bit-vecs concat-string))) 
-      (prog1
-          (md5-vectors (car vecs) (cdr vecs))
-        ;; clear out the concat-string and vectors, in case they are
-        ;; sensitive
-        (fillarray concat-string ?0)
-	(fillarray (car vecs) 0)
-	(fillarray (cdr vecs) 0)))))
-
-(defun md5-string-to-32bit-vecs (string)
-  "turn a string into 32 bit numbers, with high and low 16bit halves
-in different vectors.
-returned as \(cons vec-hi vec-lo\)."
-  ;; 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-hi (make-vector veclen 0))
-	 (vec-lo (make-vector veclen 0))
-	 (stridx 0))
-    (dotimes (vecidx veclen)
-      ;; MD5 integers are kept as two 16 bit words
-      ;; note the LSB magic/annoyance
-      (aset vec-hi vecidx (+ (ash (aref string (+ stridx 3)) 8)
-			     (aref string (+ stridx 2))))
-      (aset vec-lo vecidx (+ (ash (aref string (+ stridx 1)) 8)
-			     (aref string (+ stridx 0))))
-      (incf stridx 4))
-
-    (cons vec-hi vec-lo)))
-
-;; array of values for i=[1..64] => floor(2^32 * abs(sin(i)))
-;; broken into two arrays, hi values and low
-(defconst md5-t-hi
-  [?\xd76a ?\xe8c7 ?\x2420 ?\xc1bd 
-           ?\xf57c ?\x4787 ?\xa830 ?\xfd46
-           ?\x6980 ?\x8b44 ?\xffff ?\x895c 
-           ?\x6b90 ?\xfd98 ?\xa679 ?\x49b4
-           ?\xf61e ?\xc040 ?\x265e ?\xe9b6 
-           ?\xd62f ?\x0244 ?\xd8a1 ?\xe7d3
-           ?\x21e1 ?\xc337 ?\xf4d5 ?\x455a 
-           ?\xa9e3 ?\xfcef ?\x676f ?\x8d2a
-           ?\xfffa ?\x8771 ?\x6d9d ?\xfde5 
-           ?\xa4be ?\x4bde ?\xf6bb ?\xbebf
-           ?\x289b ?\xeaa1 ?\xd4ef ?\x0488 
-           ?\xd9d4 ?\xe6db ?\x1fa2 ?\xc4ac
-           ?\xf429 ?\x432a ?\xab94 ?\xfc93 
-           ?\x655b ?\x8f0c ?\xffef ?\x8584
-           ?\x6fa8 ?\xfe2c ?\xa301 ?\x4e08 
-           ?\xf753 ?\xbd3a ?\x2ad7 ?\xeb86])
-
-(defconst md5-t-lo
-  [?\xa478 ?\xb756 ?\x70db ?\xceee
-           ?\x0faf ?\xc62a ?\x4613 ?\x9501
-           ?\x98d8 ?\xf7af ?\x5bb1 ?\xd7be
-           ?\x1122 ?\x7193 ?\x438e ?\x0821
-           ?\x2562 ?\xb340 ?\x5a51 ?\xc7aa
-           ?\x105d ?\x1453 ?\xe681 ?\xfbc8
-           ?\xcde6 ?\x07d6 ?\x0d87 ?\x14ed
-           ?\xe905 ?\xa3f8 ?\x02d9 ?\x4c8a
-           ?\x3942 ?\xf681 ?\x6122 ?\x380c 
-           ?\xea44 ?\xcfa9 ?\x4b60 ?\xbc70
-           ?\x7ec6 ?\x27fa ?\x3085 ?\x1d05 
-           ?\xd039 ?\x99e5 ?\x7cf8 ?\x5665
-           ?\x2244 ?\xff97 ?\x23a7 ?\xa039
-           ?\x59c3 ?\xcc92 ?\xf47d ?\x5dd1
-           ?\x7e4f ?\xe6e0 ?\x4314 ?\x11a1
-           ?\x7e82 ?\xf235 ?\xd2bb ?\xd391])
-
-
-(eval-when-compile
-  (defun md5<<< (val-hi val-lo shift)
-    "macro to circular shift val-(hi,lo)  by SHIFT bits"
-    ;; shifts greater than 16 need to be handled by a swap, then a
-    ;; smaller shift
-    (if (>= shift 16)
-	(progn
-	  (decf shift 16)
-	  (if (= shift 0)
-	      `(rotatef ,val-hi ,val-lo)
-	    ;; swapped shift
-	    `(let ((a (logand ?\xffff (logior (ash ,val-lo ,shift) (ash ,val-hi ,(- shift 16)))))
-		   (b (logand ?\xffff (logior (ash ,val-hi ,shift) (ash ,val-lo ,(- shift 16))))))
-	       (setq ,val-hi a
-		     ,val-lo b))))
-      `(let ((a (logand ?\xffff (logior (ash ,val-hi ,shift) (ash ,val-lo ,(- shift 16)))))
-	     (b (logand ?\xffff (logior (ash ,val-lo ,shift) (ash ,val-hi ,(- shift 16))))))
-	 (setq ,val-hi a
-	       ,val-lo b)))))
-
-
-(eval-when-compile
-  (defun md5-f (x y z)
-    `(logior (logand ,x ,y)
-             (logand (lognot ,x)
-                     ,z))))
-
-(eval-when-compile
-  (defun md5-g (x y z)
-    `(logior (logand ,x ,z)
-             (logand ,y (lognot ,z)))))
-
-(eval-when-compile
-  (defun md5-h (x y z)
-    `(logxor ,x ,y ,z)))
-
-(eval-when-compile
-  (defun md5-i (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)))))
-
-  
-(eval-when-compile
-  (defun md5-rewrite (fun w x y z shift)
-    "consing reduced form of md5 common step.
-requires v-offset, v-idx, vec-hi, vec-lo, t-idx to be defined at
-calling point." 
-    (flet ((add-lo (x)
-		   (intern (concat (symbol-name x) "-lo")))
-	   (add-hi (x)
-		   (intern (concat (symbol-name x) "-hi"))))
-      
-      (let ((w-hi (add-hi w)) (w-lo (add-lo w))
-	    (x-hi (add-hi x)) (x-lo (add-lo x))
-	    (y-hi (add-hi y)) (y-lo (add-lo y))
-	    (z-hi (add-hi z)) (z-lo (add-lo z)))
-
-	`(progn
-	   (setq ,w-hi (+ ,w-hi
-			  ,(funcall fun x-hi y-hi z-hi)
-			  (aref vec-hi (+ v-offset v-idx))
-			  (aref md5-t-hi t-idx))
-		 ,w-lo (+ ,w-lo
-			  ,(funcall fun x-lo y-lo z-lo)
-			  (aref vec-lo (+ v-offset v-idx))
-			  (aref md5-t-lo t-idx)))
-
-	   (setq ,w-hi (logand ?\xffff 
-			       (+ ,w-hi 
-				  (ash ,w-lo -16))))
-	   (setq ,w-lo (logand ?\xffff ,w-lo))
-
-	   ,(md5<<< w-hi w-lo shift)
-
-	   (incf ,w-lo ,x-lo)
-
-	   (setq ,w-hi (logand ?\xffff 
-			       (+ ,w-hi
-				  ,x-hi
-				  (ash ,w-lo -16))))
-	   (setq ,w-lo (logand ?\xffff ,w-lo))
-
-	   (incf t-idx))))))
-
-(defun md5-vectors (vec-hi vec-lo)
-  ;; initialize the chaining variables
-  (let ((a-hi ?\x6745) (a-lo ?\x2301)
-	(b-hi ?\xefcd) (b-lo ?\xab89)
-	(c-hi ?\x98ba) (c-lo ?\xdcfe)
-	(d-hi ?\x1032) (d-lo ?\x5476)
-	(v-offset 0))
-    
-    (dotimes (count (/ (length vec-hi) 16))
-      (let ((AA-hi a-hi) (BB-hi b-hi) (CC-hi c-hi) (DD-hi d-hi)
-	    (AA-lo a-lo) (BB-lo b-lo) (CC-lo c-lo) (DD-lo d-lo)
-	    (t-idx 0)
-	    v-idx)
-	(macrolet
-	    ((f (v1 v2 v3 v4 shift)
-		`(prog1
-		     ,(md5-rewrite 'md5-f v1 v2 v3 v4 shift)
-		   (incf v-idx))))
-                
-	  (setq v-idx 0)
-	  (dotimes (count 4)
-	    (f a b c d 7)
-	    (f d a b c 12)
-	    (f c d a b 17)
-	    (f b c d a 22)))
-
-	(macrolet
-	    ((g (v1 v2 v3 v4 shift)
-		`(prog1
-		     ,(md5-rewrite 'md5-g v1 v2 v3 v4 shift)
-		   (setq v-idx (logand ?\xf (+ v-idx 5))))))
-
-	  (setq v-idx 1)
-	  (dotimes (count 4)
-	    (g a b c d 5)
-	    (g d a b c 9)
-	    (g c d a b 14)
-	    (g b c d a 20)))
-
-	(macrolet
-	    ((h (v1 v2 v3 v4 shift)
-		`(prog1
-		     ,(md5-rewrite 'md5-h v1 v2 v3 v4 shift)
-		   (setq v-idx (logand ?\xf (+ v-idx 3))))))
-	
-	  (setq v-idx 5)
-	  (dotimes (count 4)
-	    (h a b c d 4)
-	    (h d a b c 11)
-	    (h c d a b 16)
-	    (h b c d a 23)))
-
-	(macrolet
-	    ((i (v1 v2 v3 v4 shift)
-		`(prog1
-		     ,(md5-rewrite 'md5-i v1 v2 v3 v4 shift)
-		   (setq v-idx (logand ?\xf (+ v-idx 7))))))
-	
-	  (setq v-idx 0)
-	  (dotimes (count 4)
-	    (i a b c d 6)
-	    (i d a b c 10)
-	    (i c d a b 15)
-	    (i b c d a 21)))
-
-
-	(setq a-lo (+ AA-lo a-lo)
-	      b-lo (+ BB-lo b-lo)
-	      c-lo (+ CC-lo c-lo)
-	      d-lo (+ DD-lo d-lo))
-	
-	(setq a-hi (logand ?\xffff
-			   (+ AA-hi a-hi
-			      (ash a-lo -16)))
-	      b-hi (logand ?\xffff
-			   (+ BB-hi b-hi
-			      (ash b-lo -16)))
-	      c-hi (logand ?\xffff
-			   (+ CC-hi c-hi
-			      (ash c-lo -16)))
-	      d-hi (logand ?\xffff
-			   (+ DD-hi d-hi
-			      (ash d-lo -16))))
-
-	(setq a-lo (logand ?\xffff a-lo)
-	      b-lo (logand ?\xffff b-lo)
-	      c-lo (logand ?\xffff c-lo)
-	      d-lo (logand ?\xffff d-lo))
-	
-
-	(incf v-offset 16)))
-    
-    
-    ;; write out LSB-first.  i feel ill.
-    (mapconcat #'(lambda (x) (format "%02x%02x" (logand ?\xff x) (ash x -8)))
-               (list 
-                a-lo a-hi
-                b-lo b-hi
-                c-lo c-hi
-                d-lo d-hi)
-               "")))
-
-;; clean up the namespace
-(eval-when-compile
-  (fmakunbound 'md5-rewrite)
-  (fmakunbound 'md5<<<)
-  (fmakunbound 'md5-f)
-  (fmakunbound 'md5-g)
-  (fmakunbound 'md5-h)
-  (fmakunbound 'md5-i))
+(cond
+ ((and (fboundp 'md5)
+       (subrp (symbol-function 'md5)))
+  ;; do nothing.
+  )
+ ((and (stringp md5-dl-module)
+       (file-exists-p md5-dl-module))
+  (require 'md5-dl))
+ (t
+  (require 'md5-el)))
 
 (provide 'md5)
+
+;;; md5.el ends here

File package-info.in

-(crypto
+(ecrypto
   (standards-version 0.1
    version VERSION
    author-version AUTHOR_VERSION
    filename FILENAME
    md5sum MD5SUM
    size SIZE
-   provides (ascii-armor blowfish des idea rander rc16 sha1)
+   provides (ascii-armor blowfish des hex-util idea md4 md5-dl md5-el md5 paranoid rander rc16 sha1-dl sha1-el sha1)
    requires (REQUIRES)
    type regular
 ))
+;;; sha1-dl.el --- SHA1 Secure Hash Algorithm using DL module.
+
+;; Copyright (C) 1999, 2001  Free Software Foundation, Inc.
+
+;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+;; Keywords: SHA1, FIPS 180-1
+
+;; This file is part of FLIM (Faithful Library about Internet Message).
+
+;; 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; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(provide 'sha1-dl)			; beware of circular dependency.
+(eval-when-compile (require 'sha1))	; sha1-dl-module.
+
+;;; This file is loaded (from "sha1.el") only when sha1-dl-module exists.
+(defvar sha1-dl-handle (dynamic-link sha1-dl-module))
+
+;;; sha1-dl-module provides `sha1-string' and `sha1-binary'.
+(dynamic-call "emacs_sha1_init" sha1-dl-handle)
+
+(defun sha1-region (beg end)
+  (sha1-string (buffer-substring-no-properties beg end)))
+
+(defun sha1 (object &optional beg end)
+  "Return the SHA1 (Secure Hash Algorithm) of an object.
+OBJECT is either a string or a buffer.
+Optional arguments BEG and END denote buffer positions for computing the
+hash of a portion of OBJECT."
+  (if (stringp object)
+      (sha1-string object)
+    (save-excursion
+      (set-buffer object)
+      (sha1-region (or beg (point-min)) (or end (point-max))))))
+
+(provide 'sha1-dl)
+
+;;; sha1-dl.el ends here
+;;; sha1-el.el --- SHA1 Secure Hash Algorithm in Emacs-Lisp.
+
+;; Copyright (C) 1999, 2001  Free Software Foundation, Inc.
+
+;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+;; Keywords: SHA1, FIPS 180-1
+
+;; This file is part of FLIM (Faithful Library about Internet Message).
+
+;; 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; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This program is implemented from the definition of SHA-1 in FIPS PUB
+;; 180-1 (Federal Information Processing Standards Publication 180-1),
+;; "Announcing the Standard for SECURE HASH STANDARD".
+;; <URL:http://www.itl.nist.gov/div897/pubs/fip180-1.htm>
+;; (EXCEPTION; two optimizations taken from GnuPG/cipher/sha1.c)
+;;
+;; Test cases from FIPS PUB 180-1.
+;;
+;; (sha1 "abc")
+;; => a9993e364706816aba3e25717850c26c9cd0d89d
+;;
+;; (sha1 "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq")
+;; => 84983e441c3bd26ebaae4aa1f95129e5e54670f1
+;;
+;; (sha1 (make-string 1000000 ?a))
+;; => 34aa973cd4c4daa4f61eeb2bdbad27316534016f
+;;
+;; BUGS:
+;;  * It is assumed that length of input string is less than 2^29 bytes.
+;;  * It is caller's responsibility to make string (or region) unibyte.
+;;
+;; TODO:
+;;  * Rewrite from scratch!
+;;    This version is much faster than Keiichi Suzuki's another sha1.el,
+;;    but it is too dirty.
+
+;;; Code:
+
+(require 'hex-util)
+
+;;;
+;;; external SHA1 function.
+;;;
+
+(defcustom sha1-maximum-internal-length 500
+  "*Maximum length of message to use lisp version of SHA1 function.
+If message is longer than this, `sha1-program' is used instead.
+
+If this variable is set to 0, use extarnal program only.
+If this variable is set to nil, use internal function only."
+  :type 'integer)
+
+(defcustom sha1-program '("openssl" "sha1")
+  "*Name of program to compute SHA1.
+It must be a string \(program name\) or list of strings \(name and its args\)."
+  :type '(repeat string))
+
+(defun sha1-string-external (string)
+  ;; `with-temp-buffer' is new in v20, so we do not use it.
+  (save-excursion
+    (let (buffer)
+      (unwind-protect
+	  (let (prog args)
+	    (if (consp sha1-program)
+		(setq prog (car sha1-program)
+		      args (cdr sha1-program))
+	      (setq prog sha1-program
+		    args nil))
+	    (setq buffer (set-buffer
+			  (generate-new-buffer " *sha1 external*")))
+	    (insert string)
+	    (apply (function call-process-region)
+		   (point-min)(point-max)
+		   prog t t nil args)
+	    ;; SHA1 is 40 bytes long in hexadecimal form.
+	    (buffer-substring (point-min)(+ (point-min) 40)))
+	(and buffer
+	     (buffer-name buffer)
+	     (kill-buffer buffer))))))
+
+(defun sha1-region-external (beg end)
+  (sha1-string-external (buffer-substring-no-properties beg end)))
+
+;;;
+;;; internal SHA1 function.
+;;;
+
+(eval-when-compile
+  ;; optional second arg of string-to-number is new in v20.
+  (defconst sha1-K0-high 23170)		; (string-to-number "5A82" 16)
+  (defconst sha1-K0-low  31129)		; (string-to-number "7999" 16)
+  (defconst sha1-K1-high 28377)		; (string-to-number "6ED9" 16)
+  (defconst sha1-K1-low  60321)		; (string-to-number "EBA1" 16)
+  (defconst sha1-K2-high 36635)		; (string-to-number "8F1B" 16)
+  (defconst sha1-K2-low  48348)		; (string-to-number "BCDC" 16)
+  (defconst sha1-K3-high 51810)		; (string-to-number "CA62" 16)
+  (defconst sha1-K3-low  49622)		; (string-to-number "C1D6" 16)
+
+;;; original definition of sha1-F0.
+;;; (defmacro sha1-F0 (B C D)
+;;;   (` (logior (logand (, B) (, C))
+;;; 	     (logand (lognot (, B)) (, D)))))
+;;; a little optimization from GnuPG/cipher/sha1.c.
+  (defmacro sha1-F0 (B C D)
+    (` (logxor (, D) (logand (, B) (logxor (, C) (, D))))))
+  (defmacro sha1-F1 (B C D)
+    (` (logxor (, B) (, C) (, D))))
+;;; original definition of sha1-F2.
+;;; (defmacro sha1-F2 (B C D)
+;;;   (` (logior (logand (, B) (, C))
+;;; 	     (logand (, B) (, D))
+;;; 	     (logand (, C) (, D)))))
+;;; a little optimization from GnuPG/cipher/sha1.c.
+  (defmacro sha1-F2 (B C D)
+    (` (logior (logand (, B) (, C))
+	       (logand (, D) (logior (, B) (, C))))))
+  (defmacro sha1-F3 (B C D)
+    (` (logxor (, B) (, C) (, D))))
+
+  (defmacro sha1-S1  (W-high W-low)
+    (` (let ((W-high (, W-high))
+	     (W-low  (, W-low)))
+	 (setq S1W-high (+ (% (* W-high 2) 65536)
+			   (/ W-low (, (/ 65536 2)))))
+	 (setq S1W-low (+ (/ W-high (, (/ 65536 2)))
+			  (% (* W-low 2) 65536))))))
+  (defmacro sha1-S5  (A-high A-low)
+    (` (progn
+	 (setq S5A-high (+ (% (* (, A-high) 32) 65536)
+			   (/ (, A-low) (, (/ 65536 32)))))
+	 (setq S5A-low  (+ (/ (, A-high) (, (/ 65536 32)))
+			   (% (* (, A-low) 32) 65536))))))
+  (defmacro sha1-S30 (B-high B-low)
+    (` (progn
+	 (setq S30B-high (+ (/ (, B-high) 4)
+			    (* (% (, B-low) 4) (, (/ 65536 4)))))
+	 (setq S30B-low  (+ (/ (, B-low) 4)
+			    (* (% (, B-high) 4) (, (/ 65536 4))))))))
+
+  (defmacro sha1-OP (round)
+    (` (progn
+	 (sha1-S5 sha1-A-high sha1-A-low)
+	 (sha1-S30 sha1-B-high sha1-B-low)
+	 (setq sha1-A-low (+ ((, (intern (format "sha1-F%d" round)))
+			      sha1-B-low sha1-C-low sha1-D-low)
+			     sha1-E-low
+			     (, (symbol-value
+				 (intern (format "sha1-K%d-low" round))))
+			     (aref block-low idx)
+			     (progn
+			       (setq sha1-E-low sha1-D-low)
+			       (setq sha1-D-low sha1-C-low)
+			       (setq sha1-C-low S30B-low)
+			       (setq sha1-B-low sha1-A-low)
+			       S5A-low)))
+	 (setq carry (/ sha1-A-low 65536))
+	 (setq sha1-A-low (% sha1-A-low 65536))
+	 (setq sha1-A-high (% (+ ((, (intern (format "sha1-F%d" round)))
+				  sha1-B-high sha1-C-high sha1-D-high)
+				 sha1-E-high
+				 (, (symbol-value
+				     (intern (format "sha1-K%d-high" round))))
+				 (aref block-high idx)
+				 (progn
+				   (setq sha1-E-high sha1-D-high)
+				   (setq sha1-D-high sha1-C-high)
+				   (setq sha1-C-high S30B-high)
+				   (setq sha1-B-high sha1-A-high)
+				   S5A-high)
+				 carry)
+			      65536)))))
+
+  (defmacro sha1-add-to-H (H X)
+    (` (progn
+	 (setq (, (intern (format "sha1-%s-low" H)))
+	       (+ (, (intern (format "sha1-%s-low" H)))
+		  (, (intern (format "sha1-%s-low" X)))))
+	 (setq carry (/ (, (intern (format "sha1-%s-low" H))) 65536))
+	 (setq (, (intern (format "sha1-%s-low" H)))
+	       (% (, (intern (format "sha1-%s-low" H))) 65536))
+	 (setq (, (intern (format "sha1-%s-high" H)))
+	       (% (+ (, (intern (format "sha1-%s-high" H)))
+		     (, (intern (format "sha1-%s-high" X)))
+		     carry)
+		  65536)))))
+  )
+
+;;; buffers (H0 H1 H2 H3 H4).
+(defvar sha1-H0-high)
+(defvar sha1-H0-low)
+(defvar sha1-H1-high)
+(defvar sha1-H1-low)
+(defvar sha1-H2-high)
+(defvar sha1-H2-low)
+(defvar sha1-H3-high)
+(defvar sha1-H3-low)
+(defvar sha1-H4-high)
+(defvar sha1-H4-low)
+
+(defun sha1-block (block-high block-low)
+  (let (;; step (c) --- initialize buffers (A B C D E).
+	(sha1-A-high sha1-H0-high) (sha1-A-low sha1-H0-low)
+	(sha1-B-high sha1-H1-high) (sha1-B-low sha1-H1-low)
+	(sha1-C-high sha1-H2-high) (sha1-C-low sha1-H2-low)
+	(sha1-D-high sha1-H3-high) (sha1-D-low sha1-H3-low)
+	(sha1-E-high sha1-H4-high) (sha1-E-low sha1-H4-low)
+	(idx 16))
+    ;; step (b).
+    (let (;; temporary variables used in sha1-S1 macro.
+	  S1W-high S1W-low)
+      (while (< idx 80)
+	(sha1-S1 (logxor (aref block-high (- idx 3))
+			 (aref block-high (- idx 8))
+			 (aref block-high (- idx 14))
+			 (aref block-high (- idx 16)))
+		 (logxor (aref block-low  (- idx 3))
+			 (aref block-low  (- idx 8))
+			 (aref block-low  (- idx 14))
+			 (aref block-low  (- idx 16))))
+	(aset block-high idx S1W-high)
+	(aset block-low  idx S1W-low)
+	(setq idx (1+ idx))))
+    ;; step (d).
+    (setq idx 0)
+    (let (;; temporary variables used in sha1-OP macro.
+	  S5A-high S5A-low S30B-high S30B-low carry)
+      (while (< idx 20) (sha1-OP 0) (setq idx (1+ idx)))
+      (while (< idx 40) (sha1-OP 1) (setq idx (1+ idx)))
+      (while (< idx 60) (sha1-OP 2) (setq idx (1+ idx)))
+      (while (< idx 80) (sha1-OP 3) (setq idx (1+ idx))))
+    ;; step (e).
+    (let (;; temporary variables used in sha1-add-to-H macro.
+	  carry)
+      (sha1-add-to-H H0 A)
+      (sha1-add-to-H H1 B)
+      (sha1-add-to-H H2 C)
+      (sha1-add-to-H H3 D)
+      (sha1-add-to-H H4 E))))
+
+(defun sha1-binary (string)
+  "Return the SHA1 of STRING in binary form."
+  (let (;; prepare buffers for a block. byte-length of block is 64.
+	;; input block is split into two vectors.
+	;;
+	;; input block: 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F ...
+	;; block-high:  +-0-+       +-1-+       +-2-+       +-3-+
+	;; block-low:         +-0-+       +-1-+       +-2-+       +-3-+
+	;;
+	;; length of each vector is 80, and elements of each vector are
+	;; 16bit integers.  elements 0x10-0x4F of each vector are
+	;; assigned later in `sha1-block'.
+	(block-high (eval-when-compile (make-vector 80 nil)))
+	(block-low  (eval-when-compile (make-vector 80 nil))))
+    (unwind-protect
+	(let* (;; byte-length of input string.
+	       (len (length string))
+	       (lim (* (/ len 64) 64))
+	       (rem (% len 4))
+	       (idx 0)(pos 0))
+	  ;; initialize buffers (H0 H1 H2 H3 H4).
+	  (setq sha1-H0-high 26437	; (string-to-number "6745" 16)
+		sha1-H0-low  8961	; (string-to-number "2301" 16)
+		sha1-H1-high 61389	; (string-to-number "EFCD" 16)
+		sha1-H1-low  43913	; (string-to-number "AB89" 16)
+		sha1-H2-high 39098	; (string-to-number "98BA" 16)
+		sha1-H2-low  56574	; (string-to-number "DCFE" 16)
+		sha1-H3-high 4146	; (string-to-number "1032" 16)
+		sha1-H3-low  21622	; (string-to-number "5476" 16)
+		sha1-H4-high 50130	; (string-to-number "C3D2" 16)
+		sha1-H4-low  57840)	; (string-to-number "E1F0" 16)
+	  ;; loop for each 64 bytes block.
+	  (while (< pos lim)
+	    ;; step (a).
+	    (setq idx 0)
+	    (while (< idx 16)
+	      (aset block-high idx (+ (* (aref string pos) 256)
+				      (aref string (1+ pos))))
+	      (setq pos (+ pos 2))
+	      (aset block-low  idx (+ (* (aref string pos) 256)
+				      (aref string (1+ pos))))
+	      (setq pos (+ pos 2))
+	      (setq idx (1+ idx)))
+	    (sha1-block block-high block-low))
+	  ;; last block.
+	  (if (prog1
+		  (< (- len lim) 56)
+		(setq lim (- len rem))
+		(setq idx 0)
+		(while (< pos lim)
+		  (aset block-high idx (+ (* (aref string pos) 256)
+					  (aref string (1+ pos))))
+		  (setq pos (+ pos 2))
+		  (aset block-low  idx (+ (* (aref string pos) 256)
+					  (aref string (1+ pos))))
+		  (setq pos (+ pos 2))
+		  (setq idx (1+ idx)))
+		;; this is the last (at most) 32bit word.
+		(cond
+		 ((= rem 3)
+		  (aset block-high idx (+ (* (aref string pos) 256)
+					  (aref string (1+ pos))))
+		  (setq pos (+ pos 2))
+		  (aset block-low  idx (+ (* (aref string pos) 256)
+					  128)))
+		 ((= rem 2)
+		  (aset block-high idx (+ (* (aref string pos) 256)
+					  (aref string (1+ pos))))
+		  (aset block-low  idx 32768))
+		 ((= rem 1)
+		  (aset block-high idx (+ (* (aref string pos) 256)
+					  128))
+		  (aset block-low  idx 0))
+		 (t ;; (= rem 0)
+		  (aset block-high idx 32768)
+		  (aset block-low  idx 0)))
+		(setq idx (1+ idx))
+		(while (< idx 16)
+		  (aset block-high idx 0)
+		  (aset block-low  idx 0)
+		  (setq idx (1+ idx))))
+	      ;; last block has enough room to write the length of string.
+	      (progn
+		;; write bit length of string to last 4 bytes of the block.
+		(aset block-low  15 (* (% len 8192) 8))
+		(setq len (/ len 8192))
+		(aset block-high 15 (% len 65536))
+		;; XXX: It is not practical to compute SHA1 of
+		;;      such a huge message on emacs.
+		;; (setq len (/ len 65536))	; for 64bit emacs.
+		;; (aset block-low  14 (% len 65536))
+		;; (aset block-high 14 (/ len 65536))
+		(sha1-block block-high block-low))
+	    ;; need one more block.
+	    (sha1-block block-high block-low)
+	    (fillarray block-high 0)
+	    (fillarray block-low  0)
+	    ;; write bit length of string to last 4 bytes of the block.
+	    (aset block-low  15 (* (% len 8192) 8))
+	    (setq len (/ len 8192))
+	    (aset block-high 15 (% len 65536))
+	    ;; XXX: It is not practical to compute SHA1 of
+	    ;;      such a huge message on emacs.
+	    ;; (setq len (/ len 65536))		; for 64bit emacs.
+	    ;; (aset block-low  14 (% len 65536))
+	    ;; (aset block-high 14 (/ len 65536))
+	    (sha1-block block-high block-low))
+	  ;; make output string (in binary form).
+	  (let ((result (make-string 20 0)))
+	    (aset result  0 (/ sha1-H0-high 256))
+	    (aset result  1 (% sha1-H0-high 256))
+	    (aset result  2 (/ sha1-H0-low  256))
+	    (aset result  3 (% sha1-H0-low  256))
+	    (aset result  4 (/ sha1-H1-high 256))
+	    (aset result  5 (% sha1-H1-high 256))
+	    (aset result  6 (/ sha1-H1-low  256))
+	    (aset result  7 (% sha1-H1-low  256))
+	    (aset result  8 (/ sha1-H2-high 256))
+	    (aset result  9 (% sha1-H2-high 256))
+	    (aset result 10 (/ sha1-H2-low  256))
+	    (aset result 11 (% sha1-H2-low  256))
+	    (aset result 12 (/ sha1-H3-high 256))
+	    (aset result 13 (% sha1-H3-high 256))
+	    (aset result 14 (/ sha1-H3-low  256))
+	    (aset result 15 (% sha1-H3-low  256))
+	    (aset result 16 (/ sha1-H4-high 256))
+	    (aset result 17 (% sha1-H4-high 256))
+	    (aset result 18 (/ sha1-H4-low  256))
+	    (aset result 19 (% sha1-H4-low  256))
+	    result))
+      ;; do not leave a copy of input string.
+      (fillarray block-high nil)
+      (fillarray block-low  nil))))
+
+(defun sha1-string-internal (string)
+  (encode-hex-string (sha1-binary string)))
+
+(defun sha1-region-internal (beg end)
+  (sha1-string-internal (buffer-substring-no-properties beg end)))
+
+;;;
+;;; application interface.
+;;;
+
+(defun sha1-region (beg end)
+  (if (and sha1-maximum-internal-length
+	   (> (abs (- end beg)) sha1-maximum-internal-length))
+      (sha1-region-external beg end)
+    (sha1-region-internal beg end)))
+
+(defun sha1-string (string)
+  (if (and sha1-maximum-internal-length
+	   (> (length string) sha1-maximum-internal-length))
+      (sha1-string-external string)
+    (sha1-string-internal string)))
+
+;;;###autoload
+(defun sha1 (object &optional beg end)
+  "Return the SHA1 (Secure Hash Algorithm) of an object.
+OBJECT is either a string or a buffer.
+Optional arguments BEG and END denote buffer positions for computing the
+hash of a portion of OBJECT."
+  (if (stringp object)
+      (sha1-string object)
+    (save-excursion
+      (set-buffer object)
+      (sha1-region (or beg (point-min)) (or end (point-max))))))
+
+(provide 'sha1-el)
+
+;;; sha1-el.el ends here
-;;;  sha1.el -- SHA-1 message digest algorithm
+;;; sha1.el --- SHA1 Secure Hash Algorithm.
 
-;; Copyright (C) 1998 Ray Jones
+;; Copyright (C) 1999, 2001  Free Software Foundation, Inc.
 
-;; Author: Ray Jones, rjones@pobox.com
-;; Keywords: MD5, message digest
-;; Created: 1998-04-27
+;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+;; Keywords: SHA1, FIPS 180-1
 
-;; 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 file is part of FLIM (Faithful Library about Internet Message).
+
+;; 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.
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
 
 ;;; Commentary:
 
-;; this is an implementation of the SHA-1 messages digest algorithm.
-;; Applied Cryptography, by Bruce Schneier, was used as a reference,
-;; with code written by Peter C. Gutmann (pgut1@cs.aukuni.ac.nz), for
-;; comparison testing.  programmers interested in writing their own
-;; version of this code are encouraged to find a good implementation
-;; to use for reference.  in particular, pay attention to the test
-;; cases.  3 differening implementations were found while searching
-;; for code to test this code against.
+;; Examples from FIPS PUB 180-1.
+;; <URL:http://www.itl.nist.gov/div897/pubs/fip180-1.htm>
 ;;
-;; this code was written for clarity, then adjusted for speed and to
-;; do less consing.  the original slower but easier to read version,
-;; sha1-old.el, should have accompanied this file.
+;; (sha1 "abc")
+;; => a9993e364706816aba3e25717850c26c9cd0d89d
+;;
+;; (sha1 "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq")
+;; => 84983e441c3bd26ebaae4aa1f95129e5e54670f1
+;;
+;; (sha1 (make-string 1000000 ?a))
+;; => 34aa973cd4c4daa4f61eeb2bdbad27316534016f
 
 ;;; Code:
-(require 'cl)
 
-(defun sha1 (string)
-  "return the sha1 hash of a string, as a 128 bit string"
-  (let* ((length (length string))
-	 ;; sha1 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
+(defvar sha1-dl-module
+  (cond
+   ((and (fboundp 'sha1)
+	 (subrp (symbol-function 'sha1)))
+    nil)
+   ((fboundp 'dynamic-link)
+    ;; Should we take care of `dynamic-link-path'?
+    (let ((path (expand-file-name "sha1.so" exec-directory)))
+      (if (file-exists-p path)
+	  path
+	nil)))
+   (t
+    nil)))
 
-    ;; 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.
-
-    (dotimes (idx 4)
-      (aset len-string (+ 4 idx) (logand ?\xff
-				   (ash length (+ -21 (* 8 idx))))))
-
-    (let* ((concat-string (concat string pad-string len-string))
-	   (vecs (sha1-string-to-32bit-vecs concat-string)))
-      (prog1
-	  (sha1-vectors (car vecs) (cdr vecs))
-	;; clear out the concat-string and vectors, in case they are
-	;; sensitive
-	(fillarray concat-string ?0)
-	(fillarray (car vecs) 0)
-	(fillarray (cdr vecs) 0)))))
-
-(defun sha1-string-to-32bit-vecs (string)
-"turn a string into 32 bit numbers, with high and low 16bit halves
-in different vectors.
-returned as \(cons vec-hi vec-lo\)."
-  ;; 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, MSB-first
-  (let* ((veclen (/ (length string) 4))
-	 (vec-hi (make-vector veclen nil))
-	 (vec-lo (make-vector veclen nil))
-	 (stridx 0))
-    (dotimes (vecidx veclen)
-      ;; SHA-1 integers are (hi . lo) 16 bit words
-      (aset vec-hi vecidx (+ (ash (aref string (+ stridx 0)) 8)
-			     (aref string (+ stridx 1))))
-      (aset vec-lo vecidx (+ (ash (aref string (+ stridx 2)) 8)
-			     (aref string (+ stridx 3))))
-      (incf stridx 4))
-
-    (cons vec-hi vec-lo)))
-
-;; f for rounds 0-19
-(eval-when-compile
-  (defun sha1-f1 (x y z)
-    `(logior (logand ,x ,y)
-	     (logand (lognot ,x)
-		     ,z))))
-
-;; f for rounds 20-39 and 60-79
-(eval-when-compile
-  (defun sha1-f2&4 (x y z)
-    `(logxor ,x ,y ,z)))
-
-; f for rounds 40-59
-(eval-when-compile
-  (defun sha1-f3 (x y z)
-    `(logior (logand ,x ,y)
-	     (logand ,y ,z)
-	     (logand ,x ,z))))
-
-(eval-when-compile
-  (defmacro sha1-rewrite (fun k-hi k-lo)
-    "helper function for sha1-vector, below.  ugly coding practice,
-having a macro-rewriter elsewhere, but the indentation was getting a
-bit out of control.
-NB: many variables must be defined at the calling point!"
-    `(progn
-       (setq temp-hi (+ (logand ?\xffff (logior (ash a-hi 5) (ash a-lo -11)))
-			,(funcall fun 'b-hi 'c-hi 'd-hi)
-			e-hi
-			(aref w-hi w-idx)
-			,k-hi)
-	     temp-lo (+ (logand ?\xffff (logior (ash a-lo 5) (ash a-hi -11)))
-			,(funcall fun 'b-lo 'c-lo 'd-lo)
-			e-lo
-			(aref w-lo w-idx)
-			,k-lo))
-       
-       (setq temp-hi (logand ?\xffff
-			     (+ temp-hi (ash temp-lo -16))))
-       (setq temp-lo (logand ?\xffff temp-lo))
-
-       (setq e-hi d-hi
-	     e-lo d-lo
-	   
-	     d-hi c-hi
-	     d-lo c-lo
-	   
-	     ;; shift by 30, which is swap hi/lo and shift 14
-	     c-hi (logand ?\xffff (logior (ash b-lo 14) (ash b-hi -2)))
-	     c-lo (logand ?\xffff (logior (ash b-hi 14) (ash b-lo -2)))
-
-	     b-hi a-hi
-	     b-lo a-lo
-
-	     a-hi temp-hi
-	     a-lo temp-lo)
-
-       (incf w-idx))))
-
-
-
-(defun sha1-vectors (vec-hi vec-lo)
-  ;; initialize the chaining variables
-  (let ((a-hi ?\x6745) (a-lo ?\x2301)
-	(b-hi ?\xefcd) (b-lo ?\xab89)
-	(c-hi ?\x98ba) (c-lo ?\xdcfe)
-	(d-hi ?\x1032) (d-lo ?\x5476)
-	(e-hi ?\xc3d2) (e-lo ?\xe1f0)
-	(w-hi (make-vector 80 0))
-	(w-lo (make-vector 80 0))
-	(v-offset 0)
-	temp-hi temp-lo)
-
-    (dotimes (count (/ (length vec-hi) 16))
-      ;; initialize w
-      (dotimes (idx 16)
-	(aset w-hi idx (aref vec-hi (+ v-offset idx)))
-	(aset w-lo idx (aref vec-lo (+ v-offset idx))))
-      
-      ;; fill in the rest of w
-      (do ((idx 16 (1+ idx)))
-	  ((= idx 80))
-	
-	(setq temp-hi (logxor (aref w-hi (- idx 3))
-			      (aref w-hi (- idx 8))
-			      (aref w-hi (- idx 14))
-			      (aref w-hi (- idx 16)))
-	      temp-lo (logxor (aref w-lo (- idx 3))
-			      (aref w-lo (- idx 8))
-			      (aref w-lo (- idx 14))
-			      (aref w-lo (- idx 16))))
-	(aset w-hi idx
-	      (logand ?\xffff (logior (ash temp-hi 1) 
-				      (ash temp-lo -15))))
-	(aset w-lo idx
-	      (logand ?\xffff (logior (ash temp-lo 1) 
-				      (ash temp-hi -15)))))
-
-      ;; run the hash
-      (let ((AA-hi a-hi) (AA-lo a-lo) 
-	    (BB-hi b-hi) (BB-lo b-lo)
-	    (CC-hi c-hi) (CC-lo c-lo)
-	    (DD-hi d-hi) (DD-lo d-lo)
-	    (EE-hi e-hi) (EE-lo e-lo)
-	    (w-idx 0))
-
-	(dotimes (count 20)
-	  (sha1-rewrite sha1-f1 ?\x5a82 ?\x7999))
-
-	(dotimes (count 20)
-	  (sha1-rewrite sha1-f2&4 ?\x6ed9 ?\xeba1))
-	
-	(dotimes (count 20)
-	  (sha1-rewrite sha1-f3 ?\x8f1b ?\xbcdc))
-	
-	(dotimes (count 20)
-	  (sha1-rewrite sha1-f2&4 ?\xca62 ?\xc1d6))
-	
-	(macrolet 
-	    ((add (x-hi x-lo y-hi y-lo)
-		  `(progn
-		     (setq ,x-lo (+ ,x-lo ,y-lo))
-		     (setq ,x-hi (logand ?\xffff 
-					(+ ,x-hi ,y-hi (ash ,x-lo -16))))
-		     (setq ,x-lo (logand ?\xffff ,x-lo)))))
-	  (add a-hi a-lo AA-hi AA-lo)
-	  (add b-hi b-lo BB-hi BB-lo)
-	  (add c-hi c-lo CC-hi CC-lo)
-	  (add d-hi d-lo DD-hi DD-lo)
-	  (add e-hi e-lo EE-hi EE-lo)))
-
-
-      (incf v-offset 16))
-
-    ;; return the hash as 16-bit words
-    (vector
-     a-hi a-lo
-     b-hi b-lo
-     c-hi c-lo
-     d-hi d-lo
-     e-hi e-lo)))
-
-;; clean up the namespace
-(eval-when-compile
-  (fmakunbound 'sha1-f1)
-  (fmakunbound 'sha1-f2&4)
-  (fmakunbound 'sha1-f3)
-  (fmakunbound 'sha1-rewrite))
+(cond
+ ((and (stringp sha1-dl-module)
+       (file-exists-p sha1-dl-module))
+  (require 'sha1-dl))
+ (t
+  (require 'sha1-el)))
 
 (provide 'sha1)
+
+;;; sha1.el ends here