1 ;;; sha1.el --- SHA1 Secure Hash Algorithm in Emacs-Lisp
3 ;; Copyright (C) 1999, 2001-2014 Free Software Foundation, Inc.
5 ;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
6 ;; Keywords: SHA1, FIPS 180-1
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;; This program is implemented from the definition of SHA-1 in FIPS PUB
26 ;; 180-1 (Federal Information Processing Standards Publication 180-1),
27 ;; "Announcing the Standard for SECURE HASH STANDARD".
28 ;; <URL:http://www.itl.nist.gov/div897/pubs/fip180-1.htm>
29 ;; (EXCEPTION; two optimizations taken from GnuPG/cipher/sha1.c)
31 ;; Test cases from FIPS PUB 180-1.
34 ;; => a9993e364706816aba3e25717850c26c9cd0d89d
36 ;; (sha1 "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq")
37 ;; => 84983e441c3bd26ebaae4aa1f95129e5e54670f1
39 ;; (sha1 (make-string 1000000 ?a))
40 ;; => 34aa973cd4c4daa4f61eeb2bdbad27316534016f
43 ;; * It is assumed that length of input string is less than 2^29 bytes.
44 ;; * It is caller's responsibility to make string (or region) unibyte.
47 ;; * Rewrite from scratch!
48 ;; This version is much faster than Keiichi Suzuki's another sha1.el,
49 ;; but it is too dirty.
56 ;;; external SHA1 function.
60 "Elisp interface for SHA1 hash computation."
64 (defcustom sha1-maximum-internal-length 500
65 "Maximum length of message to use Lisp version of SHA1 function.
66 If message is longer than this, `sha1-program' is used instead.
68 If this variable is set to 0, use external program only.
69 If this variable is set to nil, use internal function only."
73 (defcustom sha1-program '("sha1sum")
74 "Name of program to compute SHA1.
75 It must be a string \(program name\) or list of strings \(name and its args\)."
76 :type '(repeat string)
79 (defcustom sha1-use-external (condition-case ()
80 (executable-find (car sha1-program))
82 "Use external SHA1 program.
83 If this variable is set to nil, use internal function only."
87 (defun sha1-string-external (string &optional binary)
88 (let ((default-directory "/") ;; in case otherwise non-existent
89 (process-connection-type nil) ;; pipe
91 (if (consp sha1-program)
92 (setq prog (car sha1-program)
93 args (cdr sha1-program))
94 (setq prog sha1-program
97 (unless (featurep 'xemacs) (set-buffer-multibyte nil))
99 (apply (function call-process-region)
100 (point-min) (point-max)
102 ;; SHA1 is 40 bytes long in hexadecimal form.
103 (setq digest (buffer-substring (point-min)(+ (point-min) 40))))
105 (decode-hex-string digest)
108 (defun sha1-region-external (beg end &optional binary)
109 (sha1-string-external (buffer-substring-no-properties beg end) binary))
112 ;;; internal SHA1 function.
116 ;; optional second arg of string-to-number is new in v20.
117 (defconst sha1-K0-high 23170) ; (string-to-number "5A82" 16)
118 (defconst sha1-K0-low 31129) ; (string-to-number "7999" 16)
119 (defconst sha1-K1-high 28377) ; (string-to-number "6ED9" 16)
120 (defconst sha1-K1-low 60321) ; (string-to-number "EBA1" 16)
121 (defconst sha1-K2-high 36635) ; (string-to-number "8F1B" 16)
122 (defconst sha1-K2-low 48348) ; (string-to-number "BCDC" 16)
123 (defconst sha1-K3-high 51810) ; (string-to-number "CA62" 16)
124 (defconst sha1-K3-low 49622) ; (string-to-number "C1D6" 16)
126 ;; original definition of sha1-F0.
127 ;; (defmacro sha1-F0 (B C D)
128 ;; (` (logior (logand (, B) (, C))
129 ;; (logand (lognot (, B)) (, D)))))
130 ;; a little optimization from GnuPG/cipher/sha1.c.
131 (defmacro sha1-F0 (B C D)
132 `(logxor ,D (logand ,B (logxor ,C ,D))))
133 (defmacro sha1-F1 (B C D)
135 ;; original definition of sha1-F2.
136 ;; (defmacro sha1-F2 (B C D)
137 ;; (` (logior (logand (, B) (, C))
138 ;; (logand (, B) (, D))
139 ;; (logand (, C) (, D)))))
140 ;; a little optimization from GnuPG/cipher/sha1.c.
141 (defmacro sha1-F2 (B C D)
142 `(logior (logand ,B ,C)
143 (logand ,D (logior ,B ,C))))
144 (defmacro sha1-F3 (B C D)
147 (defmacro sha1-S1 (W-high W-low)
148 `(let ((W-high ,W-high)
150 (setq S1W-high (+ (% (* W-high 2) 65536)
151 (/ W-low ,(/ 65536 2))))
152 (setq S1W-low (+ (/ W-high ,(/ 65536 2))
153 (% (* W-low 2) 65536)))))
154 (defmacro sha1-S5 (A-high A-low)
156 (setq S5A-high (+ (% (* ,A-high 32) 65536)
157 (/ ,A-low ,(/ 65536 32))))
158 (setq S5A-low (+ (/ ,A-high ,(/ 65536 32))
159 (% (* ,A-low 32) 65536)))))
160 (defmacro sha1-S30 (B-high B-low)
162 (setq S30B-high (+ (/ ,B-high 4)
163 (* (% ,B-low 4) ,(/ 65536 4))))
164 (setq S30B-low (+ (/ ,B-low 4)
165 (* (% ,B-high 4) ,(/ 65536 4))))))
167 (defmacro sha1-OP (round)
169 (sha1-S5 sha1-A-high sha1-A-low)
170 (sha1-S30 sha1-B-high sha1-B-low)
171 (setq sha1-A-low (+ (,(intern (format "sha1-F%d" round))
172 sha1-B-low sha1-C-low sha1-D-low)
175 (intern (format "sha1-K%d-low" round)))
178 (setq sha1-E-low sha1-D-low)
179 (setq sha1-D-low sha1-C-low)
180 (setq sha1-C-low S30B-low)
181 (setq sha1-B-low sha1-A-low)
183 (setq carry (/ sha1-A-low 65536))
184 (setq sha1-A-low (% sha1-A-low 65536))
185 (setq sha1-A-high (% (+ (,(intern (format "sha1-F%d" round))
186 sha1-B-high sha1-C-high sha1-D-high)
189 (intern (format "sha1-K%d-high" round)))
190 (aref block-high idx)
192 (setq sha1-E-high sha1-D-high)
193 (setq sha1-D-high sha1-C-high)
194 (setq sha1-C-high S30B-high)
195 (setq sha1-B-high sha1-A-high)
200 (defmacro sha1-add-to-H (H X)
202 (setq ,(intern (format "sha1-%s-low" H))
203 (+ ,(intern (format "sha1-%s-low" H))
204 ,(intern (format "sha1-%s-low" X))))
205 (setq carry (/ ,(intern (format "sha1-%s-low" H)) 65536))
206 (setq ,(intern (format "sha1-%s-low" H))
207 (% ,(intern (format "sha1-%s-low" H)) 65536))
208 (setq ,(intern (format "sha1-%s-high" H))
209 (% (+ ,(intern (format "sha1-%s-high" H))
210 ,(intern (format "sha1-%s-high" X))
215 ;;; buffers (H0 H1 H2 H3 H4).
216 (defvar sha1-H0-high)
218 (defvar sha1-H1-high)
220 (defvar sha1-H2-high)
222 (defvar sha1-H3-high)
224 (defvar sha1-H4-high)
227 (defun sha1-block (block-high block-low)
228 (let (;; step (c) --- initialize buffers (A B C D E).
229 (sha1-A-high sha1-H0-high) (sha1-A-low sha1-H0-low)
230 (sha1-B-high sha1-H1-high) (sha1-B-low sha1-H1-low)