+++ /dev/null
-README: SASL library for Emacs.
-=========================================================
-
-How to compile elisp files:
-
- cd lisp
- emacs --batch --no-init-file --no-site-file \
- --eval '(setq load-path (cons "." load-path))' \
- --funcall batch-byte-compile *.el
-
-How to compile DL modules (Emacs 20.3 and later with DL patch):
-
- cd src
- gcc -shared -nostdlib -fPIC -I${EMACSSRCDIR}/src -o md5.so md5-dl.c -lcrypto
- gcc -shared -nostdlib -fPIC -I${EMACSSRCDIR}/src -o sha1.so sha1-dl.c -lcrypto
-
- Current version of DL modules require libcrypto library from OpenSSL.
+++ /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.
+++ /dev/null
-;;; sasl-cram.el --- CRAM-MD5 module for the SASL client framework
-
-;; Copyright (C) 2000 Free Software Foundation, Inc.
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Kenichi OKADA <okada@opaopa.org>
-;; Keywords: SASL, 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:
-
-(require 'sasl)
-(require 'hmac-md5)
-
-(defconst sasl-cram-md5-steps
- '(ignore ;no initial response
- sasl-cram-md5-response))
-
-(defun sasl-cram-md5-response (client step)
- (let ((passphrase
- (sasl-read-passphrase
- (format "CRAM-MD5 passphrase for %s: "
- (sasl-client-name client)))))
- (unwind-protect
- (concat (sasl-client-name client) " "
- (encode-hex-string
- (hmac-md5 (sasl-step-data step) passphrase)))
- (fillarray passphrase 0))))
-
-(put 'sasl-cram 'sasl-mechanism
- (sasl-make-mechanism "CRAM-MD5" sasl-cram-md5-steps))
-
-(provide 'sasl-cram)
-
-;;; sasl-cram.el ends here
+++ /dev/null
-;;; sasl-digest.el --- DIGEST-MD5 module for the SASL client framework
-
-;; Copyright (C) 2000 Free Software Foundation, Inc.
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Kenichi OKADA <okada@opaopa.org>
-;; Keywords: SASL, DIGEST-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.
-
-;; This program is implemented from draft-leach-digest-sasl-05.txt.
-;;
-;; It is caller's responsibility to base64-decode challenges and
-;; base64-encode responses in IMAP4 AUTHENTICATE command.
-;;
-;; Passphrase should be longer than 16 bytes. (See RFC 2195)
-
-;;; Commentary:
-
-(require 'sasl)
-(require 'hmac-md5)
-
-(defvar sasl-digest-md5-nonce-count 1)
-(defvar sasl-digest-md5-unique-id-function
- sasl-unique-id-function)
-
-(defvar sasl-digest-md5-syntax-table
- (let ((table (make-syntax-table)))
- (modify-syntax-entry ?= "." table)
- (modify-syntax-entry ?, "." table)
- table)
- "A syntax table for parsing digest-challenge attributes.")
-
-(defconst sasl-digest-md5-steps
- '(ignore ;no initial response
- sasl-digest-md5-response
- ignore)) ;""
-
-(defun sasl-digest-md5-parse-string (string)
- "Parse STRING and return a property list.
-The value is a cons cell of the form \(realm nonce qop-options stale maxbuf
-charset algorithm cipher-opts auth-param)."
- (with-temp-buffer
- (set-syntax-table sasl-digest-md5-syntax-table)
- (save-excursion
- (insert string)
- (goto-char (point-min))
- (insert "(")
- (while (progn (forward-sexp) (not (eobp)))
- (delete-char 1)
- (insert " "))
- (insert ")")
- (read (point-min-marker)))))
-
-(defun sasl-digest-md5-digest-uri (serv-type host &optional serv-name)
- (concat serv-type "/" host
- (if (and serv-name
- (not (string= host serv-name)))
- (concat "/" serv-name))))
-
-(defun sasl-digest-md5-cnonce ()
- (let ((sasl-unique-id-function sasl-digest-md5-unique-id-function))
- (sasl-unique-id)))
-
-(defun sasl-digest-md5-response-value (username
- realm
- nonce
- cnonce
- nonce-count
- qop
- digest-uri
- authzid)
- (let ((passphrase
- (sasl-read-passphrase
- (format "DIGEST-MD5 passphrase for %s: "
- username))))
- (unwind-protect
- (encode-hex-string
- (md5-binary
- (concat
- (encode-hex-string
- (md5-binary (concat (md5-binary
- (concat username ":" realm ":" passphrase))
- ":" nonce ":" cnonce
- (if authzid
- (concat ":" authzid)))))
- ":" nonce
- ":" (format "%08x" nonce-count) ":" cnonce ":" qop ":"
- (encode-hex-string
- (md5-binary
- (concat "AUTHENTICATE:" digest-uri
- (if (string-equal "auth-int" qop)
- ":00000000000000000000000000000000")))))))
- (fillarray passphrase 0))))
-
-(defun sasl-digest-md5-response (client step)
- (let* ((plist
- (sasl-digest-md5-parse-string (sasl-step-data step)))
- (realm
- (or (sasl-client-property client 'realm)
- (plist-get plist 'realm))) ;need to check
- (nonce-count
- (or (sasl-client-property client 'nonce-count)
- sasl-digest-md5-nonce-count))
- (digest-uri
- (sasl-digest-md5-digest-uri
- (sasl-client-service client)(sasl-client-server client)))
- (cnonce
- (or (sasl-client-property client 'cnonce)
- (sasl-digest-md5-cnonce))))
- (sasl-client-set-property client 'nonce-count (1+ nonce-count))
- (concat
- "username=\"" (sasl-client-name client) "\","
- "realm=\"" realm "\","
- "nonce=\"" (plist-get plist 'nonce) "\","
- "cnonce=\"" cnonce "\","
- (format "nc=%08x," nonce-count)
- "digest-uri=\"" digest-uri "\","
- "response="
- (sasl-digest-md5-response-value
- (sasl-client-name client)
- realm
- (plist-get plist 'nonce)
- cnonce
- nonce-count
- (or (sasl-client-property client 'qop)
- "auth")
- digest-uri
- (plist-get plist 'authzid)))))
-
-(put 'sasl-digest 'sasl-mechanism
- (sasl-make-mechanism "DIGEST-MD5" sasl-digest-md5-steps))
-
-(provide 'sasl-digest)
-
-;;; sasl-digest.el ends here
+++ /dev/null
-;;; sasl.el --- SASL client framework
-
-;; Copyright (C) 2000 Free Software Foundation, Inc.
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Keywords: SASL
-
-;; 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 module provides common interface functions to share several
-;; SASL mechanism drivers. The toplevel is designed to be mostly
-;; compatible with [Java-SASL].
-;;
-;; [SASL] J. Myers, "Simple Authentication and Security Layer (SASL)",
-;; RFC 2222, October 1997.
-;;
-;; [Java-SASL] R. Weltman & R. Lee, "The Java SASL Application Program
-;; Interface", draft-weltman-java-sasl-03.txt, March 2000.
-
-;;; Code:
-
-(defvar sasl-mechanisms
- '("CRAM-MD5" "DIGEST-MD5" "PLAIN" "LOGIN" "ANONYMOUS"))
-
-(defvar sasl-mechanism-alist
- '(("CRAM-MD5" sasl-cram)
- ("DIGEST-MD5" sasl-digest)
- ("PLAIN" sasl-plain)
- ("LOGIN" sasl-login)
- ("ANONYMOUS" sasl-anonymous)))
-
-(defvar sasl-unique-id-function #'sasl-unique-id-function)
-
-(put 'sasl-error 'error-message "SASL error")
-(put 'sasl-error 'error-conditions '(sasl-error error))
-
-(defun sasl-error (datum)
- (signal 'sasl-error (list datum)))
-
-;;; @ SASL client
-;;;
-
-(defun sasl-make-client (mechanism name service server)
- "Return a newly allocated SASL client.
-NAME is name of the authorization. SERVICE is name of the service desired.
-SERVER is the fully qualified host name of the server to authenticate to."
- (vector mechanism name service server (make-symbol "sasl-client-properties")))
-
-(defun sasl-client-mechanism (client)
- "Return the authentication mechanism driver of CLIENT."
- (aref client 0))
-
-(defun sasl-client-name (client)
- "Return the authorization name of CLIENT, a string."
- (aref client 1))
-
-(defun sasl-client-service (client)
- "Return the service name of CLIENT, a string."
- (aref client 2))
-
-(defun sasl-client-server (client)
- "Return the server name of CLIENT, a string."
- (aref client 3))
-
-(defun sasl-client-set-properties (client plist)
- "Destructively set the properties of CLIENT.
-The second argument PLIST is the new property list."
- (setplist (aref client 4) plist))
-
-(defun sasl-client-set-property (client property value)
- "Add the given property/value to CLIENT."
- (put (aref client 4) property value))
-
-(defun sasl-client-property (client property)
- "Return the value of the PROPERTY of CLIENT."
- (get (aref client 4) property))
-
-(defun sasl-client-properties (client)
- "Return the properties of CLIENT."
- (symbol-plist (aref client 4)))
-
-;;; @ SASL mechanism
-;;;
-
-(defun sasl-make-mechanism (name steps)
- "Make an authentication mechanism.
-NAME is a IANA registered SASL mechanism name.
-STEPS is list of continuation function."
- (vector name
- (mapcar
- (lambda (step)
- (let ((symbol (make-symbol (symbol-name step))))
- (fset symbol (symbol-function step))
- symbol))
- steps)))
-
-(defun sasl-mechanism-name (mechanism)
- "Return name of MECHANISM, a string."
- (aref mechanism 0))
-
-(defun sasl-mechanism-steps (mechanism)
- "Return the authentication steps of MECHANISM, a list of functions."
- (aref mechanism 1))
-
-(defun sasl-find-mechanism (mechanisms)
- "Retrieve an apropriate mechanism object from MECHANISMS hints."
- (let* ((sasl-mechanisms sasl-mechanisms)
- (mechanism
- (catch 'done
- (while sasl-mechanisms
- (if (member (car sasl-mechanisms) mechanisms)
- (throw 'done (nth 1 (assoc (car sasl-mechanisms)
- sasl-mechanism-alist))))
- (setq sasl-mechanisms (cdr sasl-mechanisms))))))
- (if mechanism
- (require mechanism))
- (get mechanism 'sasl-mechanism)))
-
-;;; @ SASL authentication step
-;;;
-
-(defun sasl-step-data (step)
- "Return the data which STEP holds, a string."
- (aref step 1))
-
-(defun sasl-step-set-data (step data)
- "Store DATA string to STEP."
- (aset step 1 data))
-
-(defun sasl-next-step (client step)
- "Evaluate the challenge and prepare an appropriate next response.
-The data type of the value and optional 2nd argument STEP is nil or
-opaque authentication step which holds the reference to the next action
-and the current challenge. At the first time STEP should be set to nil."
- (let* ((steps
- (sasl-mechanism-steps
- (sasl-client-mechanism client)))
- (function
- (if (vectorp step)
- (nth 1 (memq (aref step 0) steps))
- (car steps))))
- (if function
- (vector function (funcall function client step)))))
-
-(defvar sasl-read-passphrase nil)
-(defun sasl-read-passphrase (prompt)
- (if (not sasl-read-passphrase)
- (if (functionp 'read-passwd)
- (setq sasl-read-passphrase 'read-passwd)
- (if (load "passwd" t)
- (setq sasl-read-passphrase 'read-passwd)
- (autoload 'ange-ftp-read-passwd "ange-ftp")
- (setq sasl-read-passphrase 'ange-ftp-read-passwd))))
- (funcall sasl-read-passphrase prompt))
-
-(defun sasl-unique-id ()
- "Compute a data string which must be different each time.
-It contain at least 64 bits of entropy."
- (concat (funcall sasl-unique-id-function)(funcall sasl-unique-id-function)))
-
-(defvar sasl-unique-id-char nil)
-
-;; stolen (and renamed) from message.el
-(defun sasl-unique-id-function ()
- ;; Don't use microseconds from (current-time), they may be unsupported.
- ;; Instead we use this randomly inited counter.
- (setq sasl-unique-id-char
- (% (1+ (or sasl-unique-id-char (logand (random t) (1- (lsh 1 20)))))
- ;; (current-time) returns 16-bit ints,
- ;; and 2^16*25 just fits into 4 digits i base 36.
- (* 25 25)))
- (let ((tm (current-time)))
- (concat
- (sasl-unique-id-number-base36
- (+ (car tm)
- (lsh (% sasl-unique-id-char 25) 16)) 4)
- (sasl-unique-id-number-base36
- (+ (nth 1 tm)
- (lsh (/ sasl-unique-id-char 25) 16)) 4))))
-
-(defun sasl-unique-id-number-base36 (num len)
- (if (if (< len 0)
- (<= num 0)
- (= len 0))
- ""
- (concat (sasl-unique-id-number-base36 (/ num 36) (1- len))
- (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
- (% num 36))))))
-
-;;; PLAIN (RFC2595 Section 6)
-(defconst sasl-plain-steps
- '(sasl-plain-response))
-
-(defun sasl-plain-response (client step)
- (let ((passphrase
- (sasl-read-passphrase
- (format "PLAIN passphrase for %s: " (sasl-client-name client))))
- (authenticator-name
- (sasl-client-property
- client 'authenticator-name))
- (name (sasl-client-name client)))
- (unwind-protect
- (if (and authenticator-name
- (not (string= authenticator-name name)))
- (concat authenticator-name "\0" name "\0" passphrase)
- (concat "\0" name "\0" passphrase))
- (fillarray passphrase 0))))
-
-(put 'sasl-plain 'sasl-mechanism
- (sasl-make-mechanism "PLAIN" sasl-plain-steps))
-
-(provide 'sasl-plain)
-
-;;; LOGIN (No specification exists)
-(defconst sasl-login-steps
- '(ignore ;no initial response
- sasl-login-response-1
- sasl-login-response-2))
-
-(defun sasl-login-response-1 (client step)
-;;; (unless (string-match "^Username:" (sasl-step-data step))
-;;; (sasl-error (format "Unexpected response: %s" (sasl-step-data step))))
- (sasl-client-name client))
-
-(defun sasl-login-response-2 (client step)
-;;; (unless (string-match "^Password:" (sasl-step-data step))
-;;; (sasl-error (format "Unexpected response: %s" (sasl-step-data step))))
- (sasl-read-passphrase
- (format "LOGIN passphrase for %s: " (sasl-client-name client))))
-
-(put 'sasl-login 'sasl-mechanism
- (sasl-make-mechanism "LOGIN" sasl-login-steps))
-
-(provide 'sasl-login)
-
-;;; ANONYMOUS (RFC2245)
-(defconst sasl-anonymous-steps
- '(ignore ;no initial response
- sasl-anonymous-response))
-
-(defun sasl-anonymous-response (client step)
- (or (sasl-client-property client 'trace)
- (sasl-client-name client)))
-
-(put 'sasl-anonymous 'sasl-mechanism
- (sasl-make-mechanism "ANONYMOUS" sasl-anonymous-steps))
-
-(provide 'sasl-anonymous)
-
-(provide 'sasl)
-
-;;; sasl.el ends here
+++ /dev/null
-;;; scram-md5.el --- Compute SCRAM-MD5.
-
-;; Copyright (C) 1999 Shuhei KOBAYASHI
-
-;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
-;; Kenichi OKADA <okada@opaopa.org>
-;; Keywords: SCRAM-MD5, HMAC-MD5, SASL, IMAP, POP, ACAP
-
-;; 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 draft-newman-auth-scram-03.txt.
-;;
-;; It is caller's responsibility to base64-decode challenges and
-;; base64-encode responses in IMAP4 AUTHENTICATE command.
-;;
-;; Passphrase should be longer than 16 bytes. (See RFC 2195)
-
-;; Examples.
-;;
-;; (scram-make-security-info nil t 0)
-;; => "^A^@^@^@"
-
-;;; Code:
-
-(require 'hmac-md5)
-(require 'unique-id)
-
-(defmacro scram-security-info-no-security-layer (security-info)
- `(eq (logand (aref ,security-info 0) 1) 1))
-(defmacro scram-security-info-integrity-protection-layer (security-info)
- `(eq (logand (aref ,security-info 0) 2) 2))
-(defmacro scram-security-info-buffer-size (security-info)
- `(let ((ssecinfo ,security-info))
- (+ (lsh (aref ssecinfo 1) 16)
- (lsh (aref ssecinfo 2) 8)
- (aref ssecinfo 3))))
-
-(defun scram-make-security-info (integrity-protection-layer
- no-security-layer buffer-size)
- (let ((csecinfo (make-string 4 0)))
- (when integrity-protection-layer
- (aset csecinfo 0 2))
- (if no-security-layer
- (aset csecinfo 0 (logior (aref csecinfo 0) 1))
- (aset csecinfo 1
- (lsh (logand buffer-size (lsh 255 16)) -16))
- (aset csecinfo 2
- (lsh (logand buffer-size (lsh 255 8)) -8))
- (aset csecinfo 3 (logand buffer-size 255)))
- csecinfo))
-
-(defun scram-make-unique-nonce () ; 8*OCTET, globally unique.
- ;; For example, concatenated string of process-identifier, system-clock,
- ;; sequence-number, random-number, and domain-name.
- (let (id)
- (unwind-protect
- (concat "<"
- (setq id (unique-id-m ".sasl"))
- "@" (system-name) ">")
- (fillarray id 0))))
-
-(defun scram-xor-string (str1 str2)
- ;; (length str1) == (length str2) == (length dst) == 16 (in SCRAM-MD5)
- (let* ((len (length str1))
- (dst (make-string len 0))
- (pos 0))
- (while (< pos len)
- (aset dst pos (logxor (aref str1 pos) (aref str2 pos)))
- (setq pos (1+ pos)))
- dst))
-
-(defun scram-md5-make-client-msg-1 (authenticate-id &optional authorize-id)
- "Make an initial client message from AUTHENTICATE-ID and AUTHORIZE-ID.
-If AUTHORIZE-ID is the same as AUTHENTICATE-ID, it may be omitted."
- (let (nonce)
- (unwind-protect
- (concat authorize-id "\0" authenticate-id "\0"
- (setq nonce (scram-make-unique-nonce)))
- (fillarray nonce 0))))
-
-(defun scram-md5-parse-server-msg-1 (server-msg-1)
- "Parse SERVER-MSG-1 and return a list of (SALT SECURITY-INFO SERVICE-ID)."
- (when (and (> (length server-msg-1) 16)
- (eq (string-match "[^@]+@[^\0]+\0" server-msg-1 12) 12))
- (list (substring server-msg-1 0 8) ; salt
- (substring server-msg-1 8 12) ; server-security-info
- (substring server-msg-1 ; service-id
- 12 (1- (match-end 0))))))
-
-(defun scram-md5-make-salted-pass (passphrase salt)
- (hmac-md5 salt passphrase))
-
-(defun scram-md5-make-client-key (salted-pass)
- (md5-binary salted-pass))
-
-(defun scram-md5-make-client-verifier (client-key)
- (md5-binary client-key))
-
-(defun scram-md5-make-shared-key (server-msg-1
- client-msg-1
- client-security-info
- client-verifier)
- (let (buff)
- (unwind-protect
- (hmac-md5
- (setq buff
- (concat server-msg-1 client-msg-1 client-security-info))
- client-verifier)
- (fillarray buff 0))))
-
-(defun scram-md5-make-client-proof (client-key shared-key)
- (scram-xor-string client-key shared-key))
-
-(defun scram-md5-make-client-msg-2 (client-security-info client-proof)
- (concat client-security-info client-proof))
-
-(defun scram-md5-make-server-msg-2 (server-msg-1
- client-msg-1
- client-security-info
- salt salted-pass)
- (let (buff server-salt)
- (setq server-salt
- (hmac-md5 salt salted-pass))
- (unwind-protect
- (hmac-md5
- (setq buff
- (concat
- client-msg-1
- server-msg-1
- client-security-info))
- server-salt)
- (fillarray server-salt 0)
- (fillarray buff 0))))
-
-(provide 'scram-md5)
-
-;;; scram-md5.el ends here
+++ /dev/null
-;;; sha1-dl.el --- SHA1 Secure Hash Algorithm using DL module.
-
-;; Copyright (C) 1999 Shuhei KOBAYASHI
-
-;; 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.
- (defun-maybe dynamic-link (a))
- (defun-maybe dynamic-call (a b)))
-
-(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' 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
+++ /dev/null
-;;; sha1-el.el --- SHA1 Secure Hash Algorithm in Emacs-Lisp.
-
-;; Copyright (C) 1999 Shuhei KOBAYASHI
-
-;; 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.
-;;
-;; 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.
-
-;;; Code:
-
-(require 'hex-util)
-
-;;;
-;;; external SHA1 function.
-;;;
-
-(defvar 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.")
-
-(defvar 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\).")
-
-(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)))
-
-(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
+++ /dev/null
-;;; sha1.el --- SHA1 Secure Hash Algorithm.
-
-;; 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: 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:
-
-;; Examples from FIPS PUB 180-1.
-;; <URL:http://www.itl.nist.gov/div897/pubs/fip180-1.htm>
-;;
-;; (sha1 "abc")
-;; => a9993e364706816aba3e25717850c26c9cd0d89d
-;;
-;; (sha1 "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq")
-;; => 84983e441c3bd26ebaae4aa1f95129e5e54670f1
-;;
-;; (sha1 (make-string 1000000 ?a))
-;; => 34aa973cd4c4daa4f61eeb2bdbad27316534016f
-
-;;; Code:
-
-(require 'hex-util)
-
-(eval-when-compile
- (defun-maybe sha1-string (a)))
-
-(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)))))
-
-(cond
- (sha1-dl-module
- ;; Emacs with DL patch.
- (require 'sha1-dl))
- (t
- (require 'sha1-el)))
-
-;; compatibility for another sha1.el by Keiichi Suzuki.
-(defun sha1-encode (string)
- (decode-hex-string
- (sha1-string string)))
-(defun sha1-encode-binary (string)
- (decode-hex-string
- (sha1-string string)))
-
-(make-obsolete 'sha1-encode "It's old API.")
-(make-obsolete 'sha1-encode-binary "It's old API.")
-
-(provide 'sha1)
-
-;;; sha1.el ends here
+++ /dev/null
-;;; unique-id.el --- Compute DIGEST-MD5.
-
-;; Copyright (C) 1999 Kenichi OKADA
-
-;; Author: Katsumi Yamaoka <yamaoka@jpl.org>
-
-;; This file is part of FLIM (Faithful Library about Internet Message).
-
-;;; Code:
-
-;;; Gnus 5.8.3: message.el
-
-(defvar unique-id-m-char nil)
-
-;; If you ever change this function, make sure the new version
-;; cannot generate IDs that the old version could.
-;; You might for example insert a "." somewhere (not next to another dot
-;; or string boundary), or modify the suffix string (default to "fsf").
-(defun unique-id-m (&optional suffix)
- ;; Don't use microseconds from (current-time), they may be unsupported.
- ;; Instead we use this randomly inited counter.
- (setq unique-id-m-char
- (% (1+ (or unique-id-m-char (logand (random t) (1- (lsh 1 20)))))
- ;; (current-time) returns 16-bit ints,
- ;; and 2^16*25 just fits into 4 digits i base 36.
- (* 25 25)))
- (let ((tm (current-time)))
- (concat
- (if (memq system-type '(ms-dos emx vax-vms))
- (let ((user (downcase (user-login-name))))
- (while (string-match "[^a-z0-9_]" user)
- (aset user (match-beginning 0) ?_))
- user)
- (unique-id-m-number-base36 (user-uid) -1))
- (unique-id-m-number-base36 (+ (car tm)
- (lsh (% unique-id-m-char 25) 16)) 4)
- (unique-id-m-number-base36 (+ (nth 1 tm)
- (lsh (/ unique-id-m-char 25) 16)) 4)
- ;; Append the suffix, because while the generated ID is unique to
- ;; the application, other applications might otherwise generate
- ;; the same ID via another algorithm.
- (or suffix ".fsf"))))
-
-(defun unique-id-m-number-base36 (num len)
- (if (if (< len 0)
- (<= num 0)
- (= len 0))
- ""
- (concat (unique-id-m-number-base36 (/ num 36) (1- len))
- (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
- (% num 36))))))
-
-\f
-;;; Wanderlust 1.0.3: wl-draft.el, wl-mule.el
-
-(defun unique-id-w-random-alphabet ()
- (let ((alphabet '(?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M
- ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z)))
- (nth (abs (% (random) 26)) alphabet)))
-
-(defun unique-id-w ()
- (let ((time (current-time)))
- (format "%d.%d.%d.%d%c"
- (car time) (nth 1 time) (nth 2 time)
- (random 100000)
- (unique-id-w-random-alphabet))))
-
-\f
-;;; VM 6.75: vm-misc.el
-
-(defun unique-id-v ()
- (let ((time (current-time)))
- (format "%d.%d.%d.%d"
- (car time) (nth 1 time) (nth 2 time)
- (random 1000000))))
-
-\f
-;;; X-PGP-Sig 1.3.5.1
-
-(defun unique-id-x (&optional length)
- (let ((i (or length 16))
- s)
- (while (> i 0)
- (setq i (1- i)
- s (concat s (char-to-string (+ (/ (* 94 (% (abs (random)) 100))
- 100) 33)))))
- s))
-
-(provide 'unique-id)
-
-;;; unique-id.el ends here
-
+++ /dev/null
-/* Dynamic loading module to compute MD5 for Emacs 20 with DL support.
-
- Copyright (C) 1999 Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
-
- 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.
-
-*/
-
-/*
- How to compile: (OpenSSL is required)
-
- gcc -shared -nostdlib -fPIC -I${EMACS}/src -o md5.so md5-dl.c -lcrypto
-
-*/
-
-#include "config.h"
-#include "lisp.h"
-
-/* for 20.2 (not tested)
-#ifndef STRING_BYTES
-#define STRING_BYTES(STR) ((STR)->size)
-#define make_unibyte_string make_string
-#endif
-*/
-
-#include <openssl/md5.h>
-
-static unsigned char to_hex[] = {'0', '1', '2', '3', '4', '5', '6', '7',
- '8', '9', 'a', 'b', 'c', 'd', 'e', 'f'};
-
-DEFUN ("md5-string", Fmd5_string, Smd5_string, 1, 1, 0,
- "Return the MD5 of the STRING.")
- (string)
- Lisp_Object string;
-{
- unsigned char *md;
- unsigned char md_hex[MD5_DIGEST_LENGTH*2];
- int i, j;
-
- CHECK_STRING (string, 0);
-
- md = MD5 (XSTRING (string)->data, STRING_BYTES (XSTRING (string)),
- (unsigned char *) 0);
-
- for (i = j = 0; i < MD5_DIGEST_LENGTH; i++, j++)
- {
- md_hex[j] = to_hex[(unsigned int)(md[i] / 16)];
- md_hex[++j] = to_hex[(unsigned int)(md[i] & 15)];
- }
-
- return make_unibyte_string (md_hex, sizeof(md_hex));
-}
-
-/*
- * setting
- */
-static struct Lisp_Subr *s_md5_string;
-
-void
-emacs_md5_init ()
-{
- s_md5_string = (struct Lisp_Subr *) xmalloc (sizeof (struct Lisp_Subr));
- bcopy (&Smd5_string, s_md5_string, sizeof (struct Lisp_Subr));
- defsubr (s_md5_string);
-}
-
-void
-emacs_md5_fini ()
-{
- undefsubr (s_md5_string);
- free (s_md5_string);
-}
+++ /dev/null
-/* Dynamic loading module to compute SHA-1 for Emacs 20 with DL support.
-
- Copyright (C) 1999 Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
-
- 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.
-
-*/
-
-/*
- How to compile: (OpenSSL is required)
-
- gcc -shared -nostdlib -fPIC -I${EMACS}/src -o sha1.so sha1-dl.c -lcrypto
-
-*/
-
-#include "config.h"
-#include "lisp.h"
-
-/* for 20.2 (not tested)
-#ifndef STRING_BYTES
-#define STRING_BYTES(STR) ((STR)->size)
-#define make_unibyte_string make_string
-#endif
-*/
-
-#include <openssl/sha.h>
-
-static unsigned char to_hex[] = {'0', '1', '2', '3', '4', '5', '6', '7',
- '8', '9', 'a', 'b', 'c', 'd', 'e', 'f'};
-DEFUN ("sha1-string", Fsha1_string, Ssha1_string, 1, 1, 0,
- "Return the SHA-1 of the STRING.")
- (string)
- Lisp_Object string;
-{
- unsigned char *md;
- unsigned char md_hex[SHA_DIGEST_LENGTH*2];
- int i, j;
-
- CHECK_STRING (string, 0);
-
- md = SHA1 (XSTRING (string)->data, STRING_BYTES (XSTRING (string)),
- (unsigned char *) 0);
-
- for (i = j = 0; i < SHA_DIGEST_LENGTH; i++, j++)
- {
- md_hex[j] = to_hex[(unsigned int)(md[i] / 16)];
- md_hex[++j] = to_hex[(unsigned int)(md[i] & 15)];
- }
-
- return make_unibyte_string (md_hex, sizeof(md_hex));
-}
-
-/*
- * setting
- */
-static struct Lisp_Subr *s_sha1_string;
-
-void
-emacs_sha1_init ()
-{
- s_sha1_string = (struct Lisp_Subr *) xmalloc (sizeof (struct Lisp_Subr));
- bcopy (&Ssha1_string, s_sha1_string, sizeof (struct Lisp_Subr));
- defsubr (s_sha1_string);
-}
-
-void
-emacs_sha1_fini ()
-{
- undefsubr (s_sha1_string);
- free (s_sha1_string);
-}
projects / elisp / wanderlust.git / commitdiff