--- /dev/null
+;;; hex-util.el --- Functions to encode/decode hexadecimal string.
+
+;; Copyright (C) 1999 Shuhei KOBAYASHI
+
+;; 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
--- /dev/null
+;;; hmac-def.el --- A macro for defining HMAC functions.
+
+;; Copyright (C) 1999 Shuhei KOBAYASHI
+
+;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+;; Keywords: HMAC, RFC 2104
+
+;; 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 RFC 2104,
+;; "HMAC: Keyed-Hashing for Message Authentication".
+
+;;; Code:
+
+(defmacro define-hmac-function (name H B L &optional bit)
+ "Define a function NAME(TEXT KEY) which computes HMAC with function H.
+
+HMAC function is H(KEY XOR opad, H(KEY XOR ipad, TEXT)):
+
+H is a cryptographic hash function, such as SHA1 and MD5, which takes
+a string and return a digest of it (in binary form).
+B is a byte-length of a block size of H. (B=64 for both SHA1 and MD5.)
+L is a byte-length of hash outputs. (L=16 for MD5, L=20 for SHA1.)
+If BIT is non-nil, truncate output to specified bits."
+ (` (defun (, name) (text key)
+ (, (concat "Compute "
+ (upcase (symbol-name name))
+ " over TEXT with KEY."))
+ (let ((key-xor-ipad (make-string (, B) ?\x36))
+ (key-xor-opad (make-string (, B) ?\x5C))
+ (len (length key))
+ (pos 0))
+ (unwind-protect
+ (progn
+ ;; if `key' is longer than the block size, apply hash function
+ ;; to `key' and use the result as a real `key'.
+ (if (> len (, B))
+ (setq key ((, H) key)
+ len (, L)))
+ (while (< pos len)
+ (aset key-xor-ipad pos (logxor (aref key pos) ?\x36))
+ (aset key-xor-opad pos (logxor (aref key pos) ?\x5C))
+ (setq pos (1+ pos)))
+ (setq key-xor-ipad (unwind-protect
+ (concat key-xor-ipad text)
+ (fillarray key-xor-ipad 0))
+ key-xor-ipad (unwind-protect
+ ((, H) key-xor-ipad)
+ (fillarray key-xor-ipad 0))
+ key-xor-opad (unwind-protect
+ (concat key-xor-opad key-xor-ipad)
+ (fillarray key-xor-opad 0))
+ key-xor-opad (unwind-protect
+ ((, H) key-xor-opad)
+ (fillarray key-xor-opad 0)))
+ ;; now `key-xor-opad' contains
+ ;; H(KEY XOR opad, H(KEY XOR ipad, TEXT)).
+ (, (if (and bit (< (/ bit 8) L))
+ (` (substring key-xor-opad 0 (, (/ bit 8))))
+ ;; return a copy of `key-xor-opad'.
+ (` (concat key-xor-opad)))))
+ ;; cleanup.
+ (fillarray key-xor-ipad 0)
+ (fillarray key-xor-opad 0))))))
+
+(provide 'hmac-def)
+
+;;; hmac-def.el ends here
--- /dev/null
+;;; hmac-md5.el --- Compute HMAC-MD5.
+
+;; Copyright (C) 1999 Shuhei KOBAYASHI
+
+;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+;; Kenichi OKADA <okada@opaopa.org>
+;; Maintainer: Kenichi OKADA <okada@opaopa.org>
+;; Keywords: HMAC, RFC 2104, HMAC-MD5, MD5, KEYED-MD5, CRAM-MD5
+
+;; 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:
+
+;; Test cases from RFC 2202, "Test Cases for HMAC-MD5 and HMAC-SHA-1".
+;;
+;; (encode-hex-string (hmac-md5 "Hi There" (make-string 16 ?\x0b)))
+;; => "9294727a3638bb1c13f48ef8158bfc9d"
+;;
+;; (encode-hex-string (hmac-md5 "what do ya want for nothing?" "Jefe"))
+;; => "750c783e6ab0b503eaa86e310a5db738"
+;;
+;; (encode-hex-string (hmac-md5 (make-string 50 ?\xdd) (make-string 16 ?\xaa)))
+;; => "56be34521d144c88dbb8c733f0e8b3f6"
+;;
+;; (encode-hex-string
+;; (hmac-md5
+;; (make-string 50 ?\xcd)
+;; (decode-hex-string "0102030405060708090a0b0c0d0e0f10111213141516171819")))
+;; => "697eaf0aca3a3aea3a75164746ffaa79"
+;;
+;; (encode-hex-string
+;; (hmac-md5 "Test With Truncation" (make-string 16 ?\x0c)))
+;; => "56461ef2342edc00f9bab995690efd4c"
+;; (encode-hex-string
+;; (hmac-md5-96 "Test With Truncation" (make-string 16 ?\x0c)))
+;; => "56461ef2342edc00f9bab995"
+;;
+;; (encode-hex-string
+;; (hmac-md5
+;; "Test Using Larger Than Block-Size Key - Hash Key First"
+;; (make-string 80 ?\xaa)))
+;; => "6b1ab7fe4bd7bf8f0b62e6ce61b9d0cd"
+;;
+;; (encode-hex-string
+;; (hmac-md5
+;; "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data"
+;; (make-string 80 ?\xaa)))
+;; => "6f630fad67cda0ee1fb1f562db3aa53e"
+
+;;; Code:
+
+(eval-when-compile (require 'hmac-def))
+(require 'hex-util) ; (decode-hex-string STRING)
+(require 'md5) ; expects (md5 STRING)
+
+;; We cannot define this function in md5.el because recent XEmacs provides
+;; built-in md5 function and provides feature 'md5 at startup.
+(if (and (featurep 'xemacs)
+ (fboundp 'md5)
+ (subrp (symbol-function 'md5))
+ (condition-case nil
+ ;; `md5' of XEmacs 21 takes 4th arg CODING (and 5th arg NOERROR).
+ (md5 "" nil nil 'binary) ; => "fb5d2156096fa1f254352f3cc3fada7e"
+ (error nil)))
+ ;; XEmacs 21.
+ (defun md5-binary (string &optional start end)
+ "Return the MD5 of STRING in binary form."
+ (decode-hex-string (md5 string start end 'binary)))
+ ;; not XEmacs 21 and not DL.
+ (if (not (fboundp 'md5-binary))
+ (defun md5-binary (string)
+ "Return the MD5 of STRING in binary form."
+ (decode-hex-string (md5 string)))))
+
+(define-hmac-function hmac-md5 md5-binary 64 16) ; => (hmac-md5 TEXT KEY)
+;; (define-hmac-function hmac-md5-96 md5-binary 64 16 96)
+
+(provide 'hmac-md5)
+
+;;; hmac-md5.el ends here
--- /dev/null
+;;; hmac-sha1.el --- Compute HMAC-SHA1.
+
+;; Copyright (C) 1999 Shuhei KOBAYASHI
+
+;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+;; Keywords: HMAC, RFC 2104, HMAC-SHA1, SHA1, Cancel-Lock
+
+;; 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:
+
+;; Test cases from RFC 2202, "Test Cases for HMAC-MD5 and HMAC-SHA-1".
+;;
+;; (encode-hex-string (hmac-sha1 "Hi There" (make-string 20 ?\x0b)))
+;; => "b617318655057264e28bc0b6fb378c8ef146be00"
+;;
+;; (encode-hex-string (hmac-sha1 "what do ya want for nothing?" "Jefe"))
+;; => "effcdf6ae5eb2fa2d27416d5f184df9c259a7c79"
+;;
+;; (encode-hex-string (hmac-sha1 (make-string 50 ?\xdd) (make-string 20 ?\xaa)))
+;; => "125d7342b9ac11cd91a39af48aa17b4f63f175d3"
+;;
+;; (encode-hex-string
+;; (hmac-sha1
+;; (make-string 50 ?\xcd)
+;; (decode-hex-string "0102030405060708090a0b0c0d0e0f10111213141516171819")))
+;; => "4c9007f4026250c6bc8414f9bf50c86c2d7235da"
+;;
+;; (encode-hex-string
+;; (hmac-sha1 "Test With Truncation" (make-string 20 ?\x0c)))
+;; => "4c1a03424b55e07fe7f27be1d58bb9324a9a5a04"
+;; (encode-hex-string
+;; (hmac-sha1-96 "Test With Truncation" (make-string 20 ?\x0c)))
+;; => "4c1a03424b55e07fe7f27be1"
+;;
+;; (encode-hex-string
+;; (hmac-sha1
+;; "Test Using Larger Than Block-Size Key - Hash Key First"
+;; (make-string 80 ?\xaa)))
+;; => "aa4ae5e15272d00e95705637ce8a3b55ed402112"
+;;
+;; (encode-hex-string
+;; (hmac-sha1
+;; "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data"
+;; (make-string 80 ?\xaa)))
+;; => "e8e99d0f45237d786d6bbaa7965c7808bbff1a91"
+
+;;; Code:
+
+(eval-when-compile (require 'hmac-def))
+(require 'hex-util) ; (decode-hex-string STRING)
+(require 'sha1) ; expects (sha1 STRING)
+
+;;; For consintency with hmac-md5.el, we define this function here.
+(or (fboundp 'sha1-binary)
+ (defun sha1-binary (string)
+ "Return the SHA1 of STRING in binary form."
+ (decode-hex-string (sha1 string))))
+
+(define-hmac-function hmac-sha1 sha1-binary 64 20) ; => (hmac-sha1 TEXT KEY)
+;; (define-hmac-function hmac-sha1-96 sha1-binary 64 20 96)
+
+(provide 'hmac-sha1)
+
+;;; hmac-sha1.el ends here
--- /dev/null
+;;; md5-dl.el --- MD5 Message Digest Algorithm using DL module.
+
+;; Copyright (C) 1999 Shuhei KOBAYASHI
+
+;; 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:
+
+(eval-when-compile
+ (defun-maybe md5-string (a))
+ (defun-maybe dynamic-link (a))
+ (defun-maybe dynamic-call (a b)))
+
+(defvar md5-dl-module
+ (if (and (fboundp 'md5-string)
+ (subrp (symbol-function 'md5-string)))
+ nil
+ (if (fboundp 'dynamic-link)
+ (let ((path (expand-file-name "md5.so" exec-directory)))
+ (and (file-exists-p path)
+ path)))))
+
+(defvar md5-dl-handle
+ (and (stringp md5-dl-module)
+ (file-exists-p md5-dl-module)
+ (dynamic-link md5-dl-module)))
+
+;;; md5-dl-module provides `md5-string'.
+(dynamic-call "emacs_md5_init" md5-dl-handle)
+
+(defun md5-region (beg end)
+ (interactive "r")
+ (md5-string (buffer-substring-no-properties beg end)))
+
+;;; Note that XEmacs built-in version takes two more args: CODING and NOERROR.
+;;;###autoload
+(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.
--- /dev/null
+;;; 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: ---------------------------------------------------------------------
+
+(defvar md5-program "md5"
+ "*Program that reads a message on its standard input and writes an
+MD5 digest on its output.")
+
+(defvar 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.")
+
+(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
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(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)
--- /dev/null
+;;; md5.el --- MD5 Message Digest Algorithm.
+
+;; Copyright (C) 1999 Shuhei KOBAYASHI
+
+;; 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:
+
+;; Examples from RFC 1321.
+;;
+;; (md5 "")
+;; => d41d8cd98f00b204e9800998ecf8427e
+;;
+;; (md5 "a")
+;; => 0cc175b9c0f1b6a831c399e269772661
+;;
+;; (md5 "abc")
+;; => 900150983cd24fb0d6963f7d28e17f72
+;;
+;; (md5 "message digest")
+;; => f96b697d7cb7938d525a2f31aaf161d0
+;;
+;; (md5 "abcdefghijklmnopqrstuvwxyz")
+;; => c3fcd3d76192e4007dfb496cca67e13b
+;;
+;; (md5 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789")
+;; => d174ab98d277d9f5a5611c2c9f419d9f
+;;
+;; (md5 "12345678901234567890123456789012345678901234567890123456789012345678901234567890")
+;; => 57edf4a22be3c955ac49da2e2107b67a
+
+;;; Code:
+
+(cond
+ ((and (fboundp 'md5)
+ (subrp (symbol-function 'md5)))
+ ;; recent XEmacs has `md5' as a built-in function.
+ ;; (and 'md5 is already provided.)
+ )
+ ((and (fboundp 'dynamic-link)
+ (file-exists-p (expand-file-name "md5.so" exec-directory)))
+ ;; Emacs with DL patch.
+ (require 'md5-dl))
+ (t
+ (require 'md5-el)))
+
+(provide 'md5)
+
+;;; md5.el ends here.
projects / elisp / flim.git / commitdiff