-;;; sha1-el.el --- SHA1 Secure Hash Algorithm in Emacs-Lisp.
+;;; sha1-el.el --- SHA1 Secure Hash Algorithm in Emacs-Lisp
-;; Copyright (C) 1999 Shuhei KOBAYASHI
+;; Copyright (C) 1999, 2001, 2003, 2004 Free Software Foundation, Inc.
;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
;; Keywords: SHA1, FIPS 180-1
;; 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.
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; 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.
+;; (EXCEPTION; two optimizations taken from GnuPG/cipher/sha1.c)
+;;
+;; Test cases from FIPS PUB 180-1.
+;;
+;; (sha1 "abc")
+;; => a9993e364706816aba3e25717850c26c9cd0d89d
+;;
+;; (sha1 "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq")
+;; => 84983e441c3bd26ebaae4aa1f95129e5e54670f1
+;;
+;; (sha1 (make-string 1000000 ?a))
+;; => 34aa973cd4c4daa4f61eeb2bdbad27316534016f
;;
;; BUGS:
;; * It is assumed that length of input string is less than 2^29 bytes.
;; * It is caller's responsibility to make string (or region) unibyte.
+;;
+;; TODO:
+;; * Rewrite from scratch!
+;; This version is much faster than Keiichi Suzuki's another sha1.el,
+;; but it is too dirty.
;;; Code:
(require 'hex-util)
+(autoload 'executable-find "executable")
+
;;;
;;; external SHA1 function.
;;;
-(defvar sha1-maximum-internal-length 500
- "*Maximum length of message to use lisp version of SHA1 function.
+(defgroup sha1 nil
+ "Elisp interface for SHA1 hash computation."
+ :group 'extensions)
+
+(defcustom sha1-maximum-internal-length 500
+ "*Maximum length of message to use Lisp version of SHA1 function.
If message is longer than this, `sha1-program' is used instead.
-If this variable is set to 0, use extarnal program only.
-If this variable is set to nil, use internal function only.")
+If this variable is set to 0, use external program only.
+If this variable is set to nil, use internal function only."
+ :type 'integer
+ :group 'sha1)
-(defvar sha1-program '("openssl" "sha1")
+(defcustom sha1-program '("sha1sum")
"*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)))
+It must be a string \(program name\) or list of strings \(name and its args\)."
+ :type '(repeat string)
+ :group 'sha1)
+
+(defcustom sha1-use-external (condition-case ()
+ (executable-find (car sha1-program))
+ (error))
+ "*Use external SHA1 program.
+If this variable is set to nil, use internal function only."
+ :type 'boolean
+ :group 'sha1)
+
+(defun sha1-string-external (string &optional binary)
+ (let (prog args digest default-enable-multibyte-characters)
+ (if (consp sha1-program)
+ (setq prog (car sha1-program)
+ args (cdr sha1-program))
+ (setq prog sha1-program
+ args nil))
+ (with-temp-buffer
+ (insert string)
+ (apply (function call-process-region)
+ (point-min)(point-max)
+ prog t t nil args)
+ ;; SHA1 is 40 bytes long in hexadecimal form.
+ (setq digest (buffer-substring (point-min)(+ (point-min) 40))))
+ (if binary
+ (decode-hex-string digest)
+ digest)))
+
+(defun sha1-region-external (beg end &optional binary)
+ (sha1-string-external (buffer-substring-no-properties beg end) binary))
;;;
;;; internal SHA1 function.
(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.
+ ;; 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))))))
+ `(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.
+ `(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))))))
+ `(logior (logand ,B ,C)
+ (logand ,D (logior ,B ,C))))
(defmacro sha1-F3 (B C D)
- (` (logxor (, 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))))))
+ `(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))))))
+ `(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))))))))
+ `(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)))))
+ `(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)))))
+ `(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).
(fillarray block-high nil)
(fillarray block-low nil))))
-(defun sha1-string-internal (string)
- (encode-hex-string (sha1-binary string)))
+(defun sha1-string-internal (string &optional binary)
+ (if binary
+ (sha1-binary string)
+ (encode-hex-string (sha1-binary string))))
-(defun sha1-region-internal (beg end)
- (sha1-string-internal (buffer-substring-no-properties beg end)))
+(defun sha1-region-internal (beg end &optional binary)
+ (sha1-string-internal (buffer-substring-no-properties beg end) binary))
;;;
;;; application interface.
;;;
-(defun sha1-region (beg end)
- (if (and sha1-maximum-internal-length
+(defun sha1-region (beg end &optional binary)
+ (if (and sha1-use-external
+ sha1-maximum-internal-length
(> (abs (- end beg)) sha1-maximum-internal-length))
- (sha1-region-external beg end)
- (sha1-region-internal beg end)))
+ (sha1-region-external beg end binary)
+ (sha1-region-internal beg end binary)))
-(defun sha1-string (string)
- (if (and sha1-maximum-internal-length
+(defun sha1-string (string &optional binary)
+ (if (and sha1-use-external
+ sha1-maximum-internal-length
(> (length string) sha1-maximum-internal-length))
- (sha1-string-external string)
- (sha1-string-internal string)))
+ (sha1-string-external string binary)
+ (sha1-string-internal string binary)))
-(defun sha1 (object &optional beg end)
+;;;###autoload
+(defun sha1 (object &optional beg end binary)
"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."
+hash of a portion of OBJECT.
+If BINARY is non-nil, return a string in binary form."
(if (stringp object)
- (sha1-string object)
- (save-excursion
- (set-buffer object)
- (sha1-region (or beg (point-min)) (or end (point-max))))))
+ (sha1-string object binary)
+ (with-current-buffer object
+ (sha1-region (or beg (point-min)) (or end (point-max)) binary))))
(provide 'sha1-el)
projects / elisp / flim.git / blobdiff