X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fsha1.el;h=7f6ab4e10d0f900d50d20141730e1852ef8b0616;hp=8968f1d42d59ab9d4fc2c8406e7462b549447da7;hb=HEAD;hpb=20bc985a3232ebba106d335afcfd6b596bb8efba diff --git a/lisp/sha1.el b/lisp/sha1.el index 8968f1d42..7f6ab4e10 100644 --- a/lisp/sha1.el +++ b/lisp/sha1.el @@ -1,26 +1,24 @@ ;;; sha1.el --- SHA1 Secure Hash Algorithm in Emacs-Lisp -;; Copyright (C) 1999, 2001, 2003, 2004 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2001-2016 Free Software Foundation, Inc. ;; Author: Shuhei KOBAYASHI ;; Keywords: SHA1, FIPS 180-1 -;; This file is part of FLIM (Faithful Library about Internet Message). +;; This file is part of GNU Emacs. -;; 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 +;; GNU Emacs 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 3 of the License, or ;; (at your option) any later version. -;; This program is distributed in the hope that it will be useful, +;; GNU Emacs 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -64,7 +62,7 @@ :group 'extensions) (defcustom sha1-maximum-internal-length 500 - "*Maximum length of message to use Lisp version of SHA1 function. + "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 external program only. @@ -73,7 +71,7 @@ If this variable is set to nil, use internal function only." :group 'sha1) (defcustom sha1-program '("sha1sum") - "*Name of program to compute SHA1. + "Name of program to compute SHA1. It must be a string \(program name\) or list of strings \(name and its args\)." :type '(repeat string) :group 'sha1) @@ -81,22 +79,25 @@ It must be a string \(program name\) or list of strings \(name and its args\)." (defcustom sha1-use-external (condition-case () (executable-find (car sha1-program)) (error)) - "*Use external SHA1 program. + "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) + (let ((default-directory "/") ;; in case otherwise non-existent + (process-connection-type nil) ;; pipe + prog args digest) (if (consp sha1-program) (setq prog (car sha1-program) args (cdr sha1-program)) (setq prog sha1-program args nil)) (with-temp-buffer + (unless (featurep 'xemacs) (set-buffer-multibyte nil)) (insert string) (apply (function call-process-region) - (point-min)(point-max) + (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)))) @@ -122,93 +123,93 @@ If this variable is set to nil, use internal function only." (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))) + `(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)))))) + (/ 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). @@ -432,11 +433,9 @@ hash of a portion of OBJECT. If BINARY is non-nil, return a string in binary form." (if (stringp object) (sha1-string object binary) - (save-excursion - (set-buffer object) + (with-current-buffer object (sha1-region (or beg (point-min)) (or end (point-max)) binary)))) (provide 'sha1) -;;; arch-tag: c0f9abd0-ffc1-4557-aac6-ece7f2d4c901 ;;; sha1.el ends here