From: okada Date: Thu, 18 Nov 1999 19:53:56 +0000 (+0000) Subject: merge hmac package X-Git-Tag: slim-1_13_0~4 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=ef4ddfd5f5d5d10706d8269f3a1311985d04603c;p=elisp%2Fflim.git merge hmac package --- diff --git a/ChangeLog b/ChangeLog index fbf4381..eb6e74c 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,18 @@ 1999-10-19 Kenichi OKADA + * md5.el: New file. (import from hmac package) + * md5-el.el: New file. (import from hmac package) + * md5-dl.el: New file. (import from hmac package) + * sha1.el: New file. (import from hmac package) + * sha1-el.el: New file. (import from hmac package) + * sha1-dl.el: New file. (import from hmac package) + * hmac-def.el: New file. (import from hmac package) + * hmac-util.el: New file. (import from hmac package) + * hmac-md5.el: New file. (import from hmac package) + * hmac-sha1.el: New file. (import from hmac package) + +1999-10-19 Kenichi OKADA + * SLIM-VERSION: New file. * sasl.el: Add keyword. diff --git a/FLIM-ELS b/FLIM-ELS index 23bc7b9..dbe4721 100644 --- a/FLIM-ELS +++ b/FLIM-ELS @@ -10,7 +10,10 @@ eword-decode eword-encode mime mime-parse mmbuffer mmcooked mmdbuffer mailcap - smtp smtpmail sasl)) + smtp smtpmail sasl + md5 md5-el md5-dl + sha1 sha1-el sha1-dl + hmac-def hmac-util hmac-md5 hmac-sha1)) (unless (and (fboundp 'base64-encode-string) (subrp (symbol-function 'base64-encode-string))) diff --git a/hmac-def.el b/hmac-def.el new file mode 100644 index 0000000..cc59fef --- /dev/null +++ b/hmac-def.el @@ -0,0 +1,92 @@ +;;; hmac-def.el --- Functions/macros for defining HMAC functions. + +;; Copyright (C) 1999 Shuhei KOBAYASHI + +;; Author: Shuhei KOBAYASHI +;; Keywords: HMAC, RFC 2104 + +;; 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: + +;; See RFC 2104, "HMAC: Keyed-Hashing for Message Authentication" +;; for definition of HMAC. + +;;; Code: + +(require 'hmac-util) + +(defmacro hmac-unhex-string-macro (string length) + (let* ((len (eval length)) + (dst (make-string (/ len 2) 0))) + `(let ((str ,string) + (dst ,dst) + (idx 0)(pos 0)) + (while (< pos ,len) + (aset dst idx (+ (* (hmac-hex-to-int (aref str pos)) 16) + (hmac-hex-to-int (aref str (1+ pos))))) + (setq idx (1+ idx) + pos (+ 2 pos))) + dst))) + +;; Note that H, B, and L will be evaluated multiple times. They are +;; usually constants, so I don't want to bother to bind them locally. +(defmacro define-hmac-function (name H B L &optional bit) + "Define a function NAME which computes HMAC with hash 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 hexadecimal 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)) + (when (> len ,B) + (setq key (hmac-unhex-string-macro (,H key) ,(* L 2))) + (setq 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))) + ;; If outer `hmac-unhex-string-macro' is removed, return value + ;; will be in hexadecimal form. It is useful for test. + ,(if (and bit (< (/ bit 8) L)) + `(substring + (hmac-unhex-string-macro + (,H + (concat key-xor-opad + (hmac-unhex-string-macro + (,H (concat key-xor-ipad text)) + ,(* L 2)))) + ,(* L 2)) + 0 ,(/ bit 8)) + `(hmac-unhex-string-macro + (,H + (concat key-xor-opad + (hmac-unhex-string-macro + (,H (concat key-xor-ipad text)) + ,(* L 2)))) + ,(* L 2)))))) + +(provide 'hmac-def) + +;;; hmac-def.el ends here. diff --git a/hmac-md5.el b/hmac-md5.el new file mode 100644 index 0000000..e1b37aa --- /dev/null +++ b/hmac-md5.el @@ -0,0 +1,72 @@ +;;; hmac-md5.el --- Compute HMAC-MD5. + +;; Copyright (C) 1999 Shuhei KOBAYASHI + +;; Author: Shuhei KOBAYASHI +;; Keywords: HMAC, RFC 2104, HMAC-MD5, MD5, KEYED-MD5, CRAM-MD5 + +;; 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". +;; +;; (hmac-hex-string (hmac-md5 "Hi There" (make-string 16 ?\x0b))) +;; => "9294727a3638bb1c13f48ef8158bfc9d" +;; +;; (hmac-hex-string (hmac-md5 "what do ya want for nothing?" "Jefe")) +;; => "750c783e6ab0b503eaa86e310a5db738" +;; +;; (hmac-hex-string (hmac-md5 (make-string 50 ?\xdd) (make-string 16 ?\xaa))) +;; => "56be34521d144c88dbb8c733f0e8b3f6" +;; +;; (hmac-hex-string +;; (hmac-md5 +;; (make-string 50 ?\xcd) +;; (hmac-unhex-string "0102030405060708090a0b0c0d0e0f10111213141516171819"))) +;; => "697eaf0aca3a3aea3a75164746ffaa79" +;; +;; (hmac-hex-string +;; (hmac-md5 "Test With Truncation" (make-string 16 ?\x0c))) +;; => "56461ef2342edc00f9bab995690efd4c" +;; (hmac-hex-string +;; (hmac-md5-96 "Test With Truncation" (make-string 16 ?\x0c))) +;; => "56461ef2342edc00f9bab995" +;; +;; (hmac-hex-string +;; (hmac-md5 +;; "Test Using Larger Than Block-Size Key - Hash Key First" +;; (make-string 80 ?\xaa))) +;; => "6b1ab7fe4bd7bf8f0b62e6ce61b9d0cd" +;; +;; (hmac-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 'md5) ; expects (md5 STRING) + +(define-hmac-function hmac-md5 md5 64 16) ; => (hmac-md5 TEXT KEY) +;; (define-hmac-function hmac-md5-96 md5 64 16 96) +;; => (hmac-md5-96 TEXT KEY) + +(provide 'hmac-md5) + +;;; hmac-md5.el ends here. diff --git a/hmac-sha1.el b/hmac-sha1.el new file mode 100644 index 0000000..58696a3 --- /dev/null +++ b/hmac-sha1.el @@ -0,0 +1,72 @@ +;;; hmac-sha1.el --- Compute HMAC-SHA1. + +;; Copyright (C) 1999 Shuhei KOBAYASHI + +;; Author: Shuhei KOBAYASHI +;; Keywords: HMAC, RFC 2104, HMAC-SHA1, SHA1, Cancel-Lock + +;; 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". +;; +;; (hmac-hex-string (hmac-sha1 "Hi There" (make-string 20 ?\x0b))) +;; => "b617318655057264e28bc0b6fb378c8ef146be00" +;; +;; (hmac-hex-string (hmac-sha1 "what do ya want for nothing?" "Jefe")) +;; => "effcdf6ae5eb2fa2d27416d5f184df9c259a7c79" +;; +;; (hmac-hex-string (hmac-sha1 (make-string 50 ?\xdd) (make-string 20 ?\xaa))) +;; => "125d7342b9ac11cd91a39af48aa17b4f63f175d3" +;; +;; (hmac-hex-string +;; (hmac-sha1 +;; (make-string 50 ?\xcd) +;; (hmac-unhex-string "0102030405060708090a0b0c0d0e0f10111213141516171819"))) +;; => "4c9007f4026250c6bc8414f9bf50c86c2d7235da" +;; +;; (hmac-hex-string +;; (hmac-sha1 "Test With Truncation" (make-string 20 ?\x0c))) +;; => "4c1a03424b55e07fe7f27be1d58bb9324a9a5a04" +;; (hmac-hex-string +;; (hmac-sha1-96 "Test With Truncation" (make-string 20 ?\x0c))) +;; => "4c1a03424b55e07fe7f27be1" +;; +;; (hmac-hex-string +;; (hmac-sha1 +;; "Test Using Larger Than Block-Size Key - Hash Key First" +;; (make-string 80 ?\xaa))) +;; => "aa4ae5e15272d00e95705637ce8a3b55ed402112" +;; +;; (hmac-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 'sha1) ; expects (sha1 STRING) + +(define-hmac-function hmac-sha1 sha1 64 20) ; => (hmac-sha1 TEXT KEY) +;; (define-hmac-function hmac-sha1-96 sha1 64 20 96) +;; => (hmac-sha1-96 TEXT KEY) + +(provide 'hmac-sha1) + +;;; hmac-sha1.el ends here. diff --git a/hmac-util.el b/hmac-util.el new file mode 100644 index 0000000..61b36f3 --- /dev/null +++ b/hmac-util.el @@ -0,0 +1,60 @@ +;;; hmac-util.el --- Utilities for HMAC functions. + +;; Copyright (C) 1999 Shuhei KOBAYASHI + +;; Author: Shuhei KOBAYASHI +;; Keywords: HMAC, RFC 2104 + +;; 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: + +(defsubst hmac-hex-to-int (chr) + (cond ((<= ?a chr) (+ (- chr ?a) 10)) + ((<= ?A chr) (+ (- chr ?A) 10)) + ((<= ?0 chr) (- chr ?0)))) + +(defsubst hmac-int-to-hex (num) + (aref "0123456789abcdef" num)) + +(defun hmac-unhex-string (str) + (let* ((len (length str)) + (dst (make-string (/ len 2) 0)) + (idx 0)(pos 0)) + (while (< pos len) + (aset dst idx (logior (lsh (hmac-hex-to-int (aref str pos)) 4) + (hmac-hex-to-int (aref str (1+ pos))))) + (setq idx (1+ idx) + pos (+ 2 pos))) + dst)) + +(defun hmac-hex-string (str) + (let* ((len (length str)) + (dst (make-string (* len 2) 0)) + (idx 0)(pos 0)) + (while (< pos len) + (aset dst idx (hmac-int-to-hex (logand (lsh (aref str pos) -4) 15))) + (setq idx (1+ idx)) + (aset dst idx (hmac-int-to-hex (logand (aref str pos) 15))) + (setq idx (1+ idx) + pos (1+ pos))) + dst)) + +(provide 'hmac-util) + +;;; hmac-util.el ends here. diff --git a/md5-dl.el b/md5-dl.el new file mode 100644 index 0000000..659856c --- /dev/null +++ b/md5-dl.el @@ -0,0 +1,64 @@ +;;; md5-dl.el --- MD5 Message Digest Algorithm using DL module. + +;; Copyright (C) 1999 Shuhei KOBAYASHI + +;; Author: Shuhei KOBAYASHI +;; 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 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: + +(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) +(provide 'md5) + +;;; md5-dl.el ends here. diff --git a/md5-el.el b/md5-el.el new file mode 100644 index 0000000..b4a64e9 --- /dev/null +++ b/md5-el.el @@ -0,0 +1,406 @@ +;;; md5.el -- MD5 Message Digest Algorithm +;;; Gareth Rees + +;; 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 (<= (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 (<= (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) diff --git a/md5.el b/md5.el new file mode 100644 index 0000000..3548b99 --- /dev/null +++ b/md5.el @@ -0,0 +1,63 @@ +;;; md5.el --- MD5 Message Digest Algorithm. + +;; Copyright (C) 1999 Shuhei KOBAYASHI + +;; Author: Shuhei KOBAYASHI +;; 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 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 "md5-dl")) + (t + (require 'md5 "md5-el"))) + +;;; md5.el ends here. diff --git a/sha1-dl.el b/sha1-dl.el new file mode 100644 index 0000000..8708c01 --- /dev/null +++ b/sha1-dl.el @@ -0,0 +1,63 @@ +;;; sha1-dl.el --- SHA1 Secure Hash Algorithm using DL module. + +;; Copyright (C) 1999 Shuhei KOBAYASHI + +;; Author: Shuhei KOBAYASHI +;; 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 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: + +(defvar sha1-dl-module + (if (and (fboundp 'sha1-string) + (subrp (symbol-function 'sha1-string))) + nil + (if (fboundp 'dynamic-link) + (let ((path (expand-file-name "sha1.so" exec-directory))) + (and (file-exists-p path) + path))))) + +(defvar sha1-dl-handle + (and (stringp sha1-dl-module) + (file-exists-p sha1-dl-module) + (dynamic-link sha1-dl-module))) + +;;; sha1-dl-module provides `sha1-string'. +(dynamic-call "emacs_sha1_init" sha1-dl-handle) + +(defun sha1-region (beg end) + (interactive "r") + (sha1-string (buffer-substring-no-properties beg end))) + +;;;###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-dl) +(provide 'sha1) + +;;; sha1-dl.el ends here. diff --git a/sha1-el.el b/sha1-el.el new file mode 100644 index 0000000..f4706b8 --- /dev/null +++ b/sha1-el.el @@ -0,0 +1,397 @@ +;;; sha1.el --- SHA1 Message Digest Algorithm. +;; Copyright (C) 1998,1999 Keiichi Suzuki. + +;; Author: Keiichi Suzuki +;; Author: Katsumi Yamaoka +;; Created: 1998-12-25 +;; Revised: 1999-01-13 +;; Keywords: sha1, news, cancel-lock, hmac, rfc2104 + +;; 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. + +;;; A copy of the GNU General Public License can be obtained from this +;;; program's author (send electronic mail to kyle@uunet.uu.net) or from +;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA +;;; 02139, USA. + +;;; Commentary: + +;; This is a direct translation into Emacs LISP of the reference C +;; implementation of the SHA1 message digest algorithm. + +;;; Usage: + +;; To compute the SHA1 message digest for a message M (represented as +;; a string), call +;; +;; (sha1-encode M) +;; +;; which returns the message digest as a hexadecimal string of 20 bytes. +;; If you need to supply the message in pieces M1, M2, ... Mn, then call +;; +;; (sha1-init) +;; (sha1-update M1) +;; (sha1-update M2) +;; ... +;; (sha1-update Mn) +;; (sha1-final) + +;;; Notes: + +;; 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 19 bits of integer representation in order to represent the +;; carry from a 16-bit addition. (see sha1-add()) + +;;; Code: + +(defmacro sha1-f1 (x y z) + `(cons + (logior (logand (car ,x) (car ,y)) (logand (lognot (car ,x)) (car ,z))) + (logior (logand (cdr ,x) (cdr ,y)) (logand (lognot (cdr ,x)) (cdr ,z))) + )) + +(defmacro sha1-f2 (x y z) + `(cons + (logxor (car ,x) (car ,y) (car ,z)) + (logxor (cdr ,x) (cdr ,y) (cdr ,z)) + )) + +(defmacro sha1-f3 (x y z) + `(cons + (logior (logand (car ,x) (car ,y)) (logand (car ,x) (car ,z)) + (logand (car ,y) (car ,z))) + (logior (logand (cdr ,x) (cdr ,y)) (logand (cdr ,x) (cdr ,z)) + (logand (cdr ,y) (cdr ,z))) + )) + +(defmacro sha1-f4 (x y z) + `(cons + (logxor (car ,x) (car ,y) (car ,z)) + (logxor (cdr ,x) (cdr ,y) (cdr ,z)) + )) + +(defconst sha1-const1 '(23170 . 31129) + "SHA constants 1 \(0x5a827999\)") +(defconst sha1-const2 '(28377 . 60321) + "SHA constants 2 \(0x6ed9eba1\)") +(defconst sha1-const3 '(36635 . 48348) + "SHA constants 3 \(0x8f1bbcdc\)") +(defconst sha1-const4 '(51810 . 49622) + "SHA constants 4 \(0xca62c1d6\)") + +(defvar sha1-digest (make-vector 5 nil)) +(defvar sha1-count-lo nil) +(defvar sha1-count-hi nil) +(defvar sha1-data nil) +(defvar sha1-local nil) +(defconst SHA1-BLOCKSIZE 64) + +(defun sha1-init () + "Initialize the state of the SHA1 message digest routines." + (aset sha1-digest 0 (cons 26437 8961)) + (aset sha1-digest 1 (cons 61389 43913)) + (aset sha1-digest 2 (cons 39098 56574)) + (aset sha1-digest 3 (cons 4146 21622)) + (aset sha1-digest 4 (cons 50130 57840)) + (setq sha1-count-lo (cons 0 0) + sha1-count-hi (cons 0 0) + sha1-local 0 + sha1-data nil) + ) + +(defmacro sha1-32-make (v) + "Return 32bits internal value from normal integer." + `(cons (lsh ,v -16) (logand 65535 ,v))) + +(defun sha1-add (to &rest vals) + "Set sum of all the arguments to the first one." + (let (val) + (while (setq val (car vals)) + (setcar to (+ (car to) (car val))) + (setcdr to (+ (cdr to) (cdr val))) + (setq vals (cdr vals)) + ) + (setcar to (logand 65535 (+ (car to) (lsh (cdr to) -16)))) + (setcdr to (logand 65535 (cdr to))) + to + )) + +(defun sha1-xor (to &rest vals) + "Set bitwise-exclusive-or of all the arguments to the first one." + (let (val) + (while (setq val (car vals)) + (setcar to (logxor (car to) (car val))) + (setcdr to (logxor (cdr to) (cdr val))) + (setq vals (cdr vals))) + )) + +(defmacro sha1-rot (val c1 c2) + "Internal macro for sha1-rot-*." + `(cons + (logand 65535 (logior (lsh (car ,val) ,c1) (lsh (cdr ,val) ,c2))) + (logand 65535 (logior (lsh (cdr ,val) ,c1) (lsh (car ,val) ,c2))) + )) + +(defmacro sha1-rot-1 (val) + "Return VAL with its bits rotated left by 1." + `(sha1-rot ,val 1 -15) + ) + +(defmacro sha1-rot-5 (val) + "Return VAL with its bits rotated left by 5." + `(sha1-rot ,val 5 -11) + ) + +(defmacro sha1-rot-30 (val) + "Return VAL with its bits rotated left by 30." + `(sha1-rot ,val -2 14) + ) + +(defun sha1-inc (to) + "Set TO pulus one to TO." + (setcdr to (1+ (cdr to))) + (when (> (cdr to) 65535) + (setcdr to (logand 65535 (cdr to))) + (setcar to (logand 65535 (1+ (car to)))))) + +(defun sha1-lsh (to v count) + "Set TO with its bits shifted left by COUNT to TO." + (setcar to (logand 65535 + (logior (lsh (car v) count) (lsh (cdr v) (- count 16))))) + (setcdr to (logand 65535 (lsh (cdr v) count))) + to + ) + +(defun sha1-rsh (to v count) + "Set TO with its bits shifted right by COUNT to TO." + (setq count (- 0 count)) + (setcdr to (logand 65535 + (logior (lsh (cdr v) count) (lsh (car v) (- count 16))))) + (setcar to (logand 65535 (lsh (car v) count))) + to + ) + +(defun sha1-< (v1 v2) + "Return t if firast argment is less then second argument." + (or (< (car v1) (car v2)) + (and (eq (car v1) (car v2)) + (< (cdr v1) (cdr v2)))) + ) + +(unless (fboundp 'string-as-unibyte) + (defsubst string-as-unibyte (string) + string) + ) + +(defun sha1-update (bytes) + "Update the current SHA1 state with BYTES (an string of uni-bytes)." + (setq bytes (string-as-unibyte bytes)) + (let* ((len (length bytes)) + (len32 (sha1-32-make len)) + (tmp32 (cons 0 0)) + (top 0) + (clo (cons 0 0)) + i done) + (sha1-add clo sha1-count-lo (sha1-lsh tmp32 len32 3)) + (when (sha1-< clo sha1-count-lo) + (sha1-inc sha1-count-hi)) + (setq sha1-count-lo clo) + (sha1-add sha1-count-hi (sha1-rsh tmp32 len32 29)) + (when (> (length sha1-data) 0) + (setq i (- SHA1-BLOCKSIZE (length sha1-data))) + (when (> i len) + (setq i len)) + (setq sha1-data (concat sha1-data (substring bytes 0 i))) + (setq len (- len i) + top i) + (if (eq (length sha1-data) SHA1-BLOCKSIZE) + (sha1-transform) + (setq done t))) + (when (not done) + (while (and (not done) + (>= len SHA1-BLOCKSIZE)) + (setq sha1-data (substring bytes top (+ top SHA1-BLOCKSIZE)) + top (+ top SHA1-BLOCKSIZE) + len (- len SHA1-BLOCKSIZE)) + (sha1-transform)) + (setq sha1-data (substring bytes top (+ top len)))) + )) + +(defmacro sha1-FA (n) + (let ((func (intern (format "sha1-f%d" n))) + (const (intern (format "sha1-const%d" n)))) + `(setq T (sha1-add (cons 0 0) (sha1-rot-5 A) (,func B C D) E (aref W WIDX) + ,const) + WIDX (1+ WIDX) + B (sha1-rot-30 B)))) + +(defmacro sha1-FB (n) + (let ((func (intern (format "sha1-f%d" n))) + (const (intern (format "sha1-const%d" n)))) + `(setq E (sha1-add (cons 0 0) (sha1-rot-5 T) (,func A B C) D (aref W WIDX) + ,const) + WIDX (1+ WIDX) + A (sha1-rot-30 A)))) + +(defmacro sha1-FC (n) + (let ((func (intern (format "sha1-f%d" n))) + (const (intern (format "sha1-const%d" n)))) + `(setq D (sha1-add (cons 0 0) (sha1-rot-5 E) (,func T A B) C (aref W WIDX) + ,const) + WIDX (1+ WIDX) + T (sha1-rot-30 T)))) + +(defmacro sha1-FD (n) + (let ((func (intern (format "sha1-f%d" n))) + (const (intern (format "sha1-const%d" n)))) + `(setq C (sha1-add (cons 0 0) (sha1-rot-5 D) (,func E T A) B (aref W WIDX) + ,const) + WIDX (1+ WIDX) + E (sha1-rot-30 E)))) + +(defmacro sha1-FE (n) + (let ((func (intern (format "sha1-f%d" n))) + (const (intern (format "sha1-const%d" n)))) + `(setq B (sha1-add (cons 0 0) (sha1-rot-5 C) (,func D E T) A (aref W WIDX) + ,const) + WIDX (1+ WIDX) + D (sha1-rot-30 D)))) + +(defmacro sha1-FT (n) + (let ((func (intern (format "sha1-f%d" n))) + (const (intern (format "sha1-const%d" n)))) + `(setq A (sha1-add (cons 0 0) (sha1-rot-5 B) (,func C D E) T (aref W WIDX) + ,const) + WIDX (1+ WIDX) + C (sha1-rot-30 C)))) + +(defun sha1-transform () + "Basic SHA1 step. Transform sha1-digest based on sha1-data." + (let ((W (make-vector 80 nil)) + (WIDX 0) + (bidx 0) + T A B C D E) + (while (< WIDX 16) + (aset W WIDX + (cons (logior (lsh (aref sha1-data bidx) 8) + (aref sha1-data (setq bidx (1+ bidx)))) + (logior (lsh (aref sha1-data (setq bidx (1+ bidx))) 8) + (aref sha1-data (setq bidx (1+ bidx)))))) + (setq bidx (1+ bidx) + WIDX (1+ WIDX))) + (while (< WIDX 80) + (aset W WIDX (cons 0 0)) + (sha1-xor (aref W WIDX) + (aref W (- WIDX 3)) (aref W (- WIDX 8)) + (aref W (- WIDX 14)) (aref W (- WIDX 16))) + (aset W WIDX (sha1-rot-1 (aref W WIDX))) + (setq WIDX (1+ WIDX))) + (setq A (cons (car (aref sha1-digest 0)) (cdr (aref sha1-digest 0))) + B (cons (car (aref sha1-digest 1)) (cdr (aref sha1-digest 1))) + C (cons (car (aref sha1-digest 2)) (cdr (aref sha1-digest 2))) + D (cons (car (aref sha1-digest 3)) (cdr (aref sha1-digest 3))) + E (cons (car (aref sha1-digest 4)) (cdr (aref sha1-digest 4))) + WIDX 0) + + (sha1-FA 1) (sha1-FB 1) (sha1-FC 1) (sha1-FD 1) (sha1-FE 1) (sha1-FT 1) + (sha1-FA 1) (sha1-FB 1) (sha1-FC 1) (sha1-FD 1) (sha1-FE 1) (sha1-FT 1) + (sha1-FA 1) (sha1-FB 1) (sha1-FC 1) (sha1-FD 1) (sha1-FE 1) (sha1-FT 1) + (sha1-FA 1) (sha1-FB 1) (sha1-FC 2) (sha1-FD 2) (sha1-FE 2) (sha1-FT 2) + (sha1-FA 2) (sha1-FB 2) (sha1-FC 2) (sha1-FD 2) (sha1-FE 2) (sha1-FT 2) + (sha1-FA 2) (sha1-FB 2) (sha1-FC 2) (sha1-FD 2) (sha1-FE 2) (sha1-FT 2) + (sha1-FA 2) (sha1-FB 2) (sha1-FC 2) (sha1-FD 2) (sha1-FE 3) (sha1-FT 3) + (sha1-FA 3) (sha1-FB 3) (sha1-FC 3) (sha1-FD 3) (sha1-FE 3) (sha1-FT 3) + (sha1-FA 3) (sha1-FB 3) (sha1-FC 3) (sha1-FD 3) (sha1-FE 3) (sha1-FT 3) + (sha1-FA 3) (sha1-FB 3) (sha1-FC 3) (sha1-FD 3) (sha1-FE 3) (sha1-FT 3) + (sha1-FA 4) (sha1-FB 4) (sha1-FC 4) (sha1-FD 4) (sha1-FE 4) (sha1-FT 4) + (sha1-FA 4) (sha1-FB 4) (sha1-FC 4) (sha1-FD 4) (sha1-FE 4) (sha1-FT 4) + (sha1-FA 4) (sha1-FB 4) (sha1-FC 4) (sha1-FD 4) (sha1-FE 4) (sha1-FT 4) + (sha1-FA 4) (sha1-FB 4) + + (sha1-add (aref sha1-digest 0) E) + (sha1-add (aref sha1-digest 1) T) + (sha1-add (aref sha1-digest 2) A) + (sha1-add (aref sha1-digest 3) B) + (sha1-add (aref sha1-digest 4) C) + )) + +(defun sha1-final (&optional binary) + "Transform buffered sha1-data and return SHA1 message digest. +If optional argument BINARY is non-nil, then return binary formed +string of message digest." + (let ((count (logand (lsh (cdr sha1-count-lo) -3) 63))) + (when (< (length sha1-data) SHA1-BLOCKSIZE) + (setq sha1-data + (concat sha1-data + (make-string (- SHA1-BLOCKSIZE (length sha1-data)) 0)))) + (aset sha1-data count 128) + (setq count (1+ count)) + (if (> count (- SHA1-BLOCKSIZE 8)) + (progn + (setq sha1-data (concat (substring sha1-data 0 count) + (make-string (- SHA1-BLOCKSIZE count) 0))) + (sha1-transform) + (setq sha1-data (concat (make-string (- SHA1-BLOCKSIZE 8) 0) + (substring sha1-data -8)))) + (setq sha1-data (concat (substring sha1-data 0 count) + (make-string (- SHA1-BLOCKSIZE 8 count) 0) + (substring sha1-data -8)))) + (aset sha1-data 56 (lsh (car sha1-count-hi) -8)) + (aset sha1-data 57 (logand 255 (car sha1-count-hi))) + (aset sha1-data 58 (lsh (cdr sha1-count-hi) -8)) + (aset sha1-data 59 (logand 255 (cdr sha1-count-hi))) + (aset sha1-data 60 (lsh (car sha1-count-lo) -8)) + (aset sha1-data 61 (logand 255 (car sha1-count-lo))) + (aset sha1-data 62 (lsh (cdr sha1-count-lo) -8)) + (aset sha1-data 63 (logand 255 (cdr sha1-count-lo))) + (sha1-transform) + (if binary + (mapconcat + (lambda (elem) + (concat (char-to-string (/ (car elem) 256)) + (char-to-string (% (car elem) 256)) + (char-to-string (/ (cdr elem) 256)) + (char-to-string (% (cdr elem) 256)))) + (list (aref sha1-digest 0) (aref sha1-digest 1) (aref sha1-digest 2) + (aref sha1-digest 3) (aref sha1-digest 4)) + "") + (format "%04x%04x%04x%04x%04x%04x%04x%04x%04x%04x" + (car (aref sha1-digest 0)) (cdr (aref sha1-digest 0)) + (car (aref sha1-digest 1)) (cdr (aref sha1-digest 1)) + (car (aref sha1-digest 2)) (cdr (aref sha1-digest 2)) + (car (aref sha1-digest 3)) (cdr (aref sha1-digest 3)) + (car (aref sha1-digest 4)) (cdr (aref sha1-digest 4))) + ))) + +(defun sha1-encode (message &optional binary) + "Encodes MESSAGE using the SHA1 message digest algorithm. +MESSAGE must be a unibyte-string. +By default, return a string which formed hex-decimal charcters +from message digest. +If optional argument BINARY is non-nil, then return binary formed +string of message digest." + (sha1-init) + (sha1-update message) + (sha1-final binary)) + +(defun sha1-encode-binary (message) + "Encodes MESSAGE using the SHA1 message digest algorithm. +MESSAGE must be a unibyte-string. +Return binary formed string of message digest." + (sha1-encode message 'binary)) + +(provide 'sha1) + +;;; sha1.el ends here diff --git a/sha1.el b/sha1.el new file mode 100644 index 0000000..55a8981 --- /dev/null +++ b/sha1.el @@ -0,0 +1,60 @@ +;;; sha1.el --- SHA1 Secure Hash Algorithm. + +;; Copyright (C) 1999 Shuhei KOBAYASHI + +;; Author: Shuhei KOBAYASHI +;; 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 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 FIPS PUB 180-1. +;; +;; +;; (sha1 "abc") +;; => a9993e364706816aba3e25717850c26c9cd0d89d +;; +;; (sha1 "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq") +;; => 84983e441c3bd26ebaae4aa1f95129e5e54670f1 +;; +;; (sha1 (make-string 1000000 ?a)) +;; => 34aa973cd4c4daa4f61eeb2bdbad27316534016f + +;;; Code: + +(cond + ((and (fboundp 'dynamic-link) + (file-exists-p (expand-file-name "sha1.so" exec-directory))) + ;; Emacs with DL patch. + (require 'sha1 "sha1-dl")) + (t + (require 'sha1 "sha1-el") + (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-encode object) + (save-excursion + (set-buffer object) + (sha1-encode + (buffer-substring-no-properties + (or beg (point-min)) (or end (point-max))))))) + )) + +;;; sha1.el ends here.