;;; sha1-old.el -- SHA-1 message digest algorithm
;; Copyright (C) 1998 Ray Jones
;; Author: Ray Jones, rjones@pobox.com
;; Keywords: SHA, SHA-1, message digest
;; Created: 1998-04-27
;; 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; if not, you can either send email to this
;; program's maintainer or write to: The Free Software Foundation,
;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
;;; Commentary:
;; this is a slower, more clear, version of sha1.el. it's based on
;; md5-old.el, since much of the code is similar. however, SHA-1 is
;; different than MD5 in that MD5 treats the input bits as MSB-first
;; bitwise but LSB-first bytewise, but SHA-1 treats the data as
;; MSB-first both bit- and byte-wise.
;;; Code:
(require 'cl)
(defun sha1 (string)
"return the sha1 hash of a string, as a 128 bit string"
(let* ((length (length string))
;; sha1 requires the message be padded to a length of 512*k +
;; 64 (bits). confusion source: we're working with bytes.
;;
;; padding is always done.
;; 512 bits = 64 bytes, 64 bits = 8 bytes
(next-512 (+ 64 (logand (+ length 8) (lognot 63))))
(pad-bytes (- next-512 length 8))
(pad-string (make-string pad-bytes 0))
(len-string (make-string 8 0)))
;; message is constructed as:
;; original-message | pad | length-in-bits
;; pad is 10000... (bitwise)
;; length-in-bits is length before padding, and is 64 bits long
;; fill in the single bit of the pad
(aset pad-string 0 (ash 1 7))
;; there's a slim chance of overflow when multiplying the length
;; by 8 to get the length in bits. to avoid this, do some
;; slightly hairier math when writing the length into len-string.
(dotimes (idx 4)
(aset len-string (+ 4 idx) (logand #xff
(ash length (+ -21 (* 8 idx))))))
(sha1-vector
(sha1-string-to-32bit-vec
(concat string pad-string len-string)))))
(defun sha1-string-to-32bit-vec (string)
;; emacs doesn't actually have 32 bits, in most implementations.
;; 32 bit numbers are represented as a pair of 16 bit numbers
;; 4 chars per 32 bit number, MSB-first
(let* ((veclen (/ (length string) 4))
(vec (make-vector veclen nil))
(stridx 0))
(dotimes (vecidx veclen)
;; SHA-1 integers are (hi . lo) 16 bit words
(aset vec vecidx (cons (+ (ash (aref string (+ stridx 0)) 8)
(aref string (+ stridx 1)))
(+ (ash (aref string (+ stridx 2)) 8)
(aref string (+ stridx 3)))))
(incf stridx 4))
vec))
;; f for rounds 0-19
(defsubst sha1-f1-2 (x y z)
(logior (logand x y)
(logand (lognot x)
z)))
;; f for rounds 20-39 and 60-79
(defsubst sha1-f2&4-2 (x y z)
(logxor x y z))
; f for rounds 40-59
(defsubst sha1-f3-2 (x y z)
(logior (logand x y)
(logand y z)
(logand x z)))
(defsubst sha1-f1 (x y z)
(cons (sha1-f1-2 (car x) (car y) (car z))
(sha1-f1-2 (cdr x) (cdr y) (cdr z))))
(defsubst sha1-f2&4 (x y z)
(cons (sha1-f2&4-2 (car x) (car y) (car z))
(sha1-f2&4-2 (cdr x) (cdr y) (cdr z))))
(defsubst sha1-f3 (x y z)
(cons (sha1-f3-2 (car x) (car y) (car z))
(sha1-f3-2 (cdr x) (cdr y) (cdr z))))
(defsubst sha1<<< (val shift)
"circular shift sha1 32 bit int VAL by 1 bit"
(let ((a (car val))
(b (cdr val)))
;; only three cases ever occur
(cond ((= shift 1) (cons (logand #xffff (logior (ash a 1) (ash b -15)))
(logand #xffff (logior (ash b 1) (ash a -15)))))
((= shift 5) (cons (logand #xffff (logior (ash a 5) (ash b -11)))
(logand #xffff (logior (ash b 5) (ash a -11)))))
;; shift = 30, which is a swap and a shift by 14
(t (cons (logand #xffff (logior (ash b 14) (ash a -2)))
(logand #xffff (logior (ash a 14) (ash b -2))))))))
(defsubst sha1+ (&rest args)
;; since we only use 16 bits, there's enough room to just add
;; without carry checks for each add.
(let* ((lo (apply #'+ (mapcar #'cdr args)))
(hi (+ (ash lo -16) (apply #'+ (mapcar #'car args)))))
(cons (logand #xffff hi)
(logand #xffff lo))))
(defsubst sha1-logxor4 (a b c d)
(cons (logxor (car a) (car b) (car c) (car d))
(logxor (cdr a) (cdr b) (cdr c) (cdr d))))
(defmacro sha1-rewrite (fun k)
"helper function for sha1-vector, below. ugly coding practice,
having a macro-rewriter elsewhere, but the indentation was getting a
bit out of control.
NB: many variables must be defined at the calling point!"
`(let ((temp (sha1+ (sha1<<< a 5)
,(list fun 'b 'c 'd)
e
(aref w w-idx)
,k)))
(setq e d
d c
c (sha1<<< b 30)
b a
a temp)
(incf w-idx)))
(defun sha1-vector (vec)
;; initialize the chaining variables
(let ((a (cons #x6745 #x2301))
(b (cons #xefcd #xab89))
(c (cons #x98ba #xdcfe))
(d (cons #x1032 #x5476))
(e (cons #xc3d2 #xe1f0))
(w (make-vector 80 0))
(v-offset 0))
(dotimes (count (/ (length vec) 16))
;; initialize w
(dotimes (idx 16)
(aset w idx (aref vec (+ v-offset idx))))
;; fill in the rest of w
(do ((idx 16 (1+ idx)))
((= idx 80))
(aset w idx (sha1<<< (sha1-logxor4 (aref w (- idx 3))
(aref w (- idx 8))
(aref w (- idx 14))
(aref w (- idx 16)))
1)))
(let ((AA a) (BB b) (CC c) (DD d) (EE e)
(w-idx 0))
(dotimes (count 20)
;; (insert (format "%s %s %s %s %s\n"
;; a b c d e))
(sha1-rewrite sha1-f1 '(#x5a82 . #x7999)))
(dotimes (count 20)
(sha1-rewrite sha1-f2&4 '(#x6ed9 . #xeba1)))
(dotimes (count 20)
(sha1-rewrite sha1-f3 '(#x8f1b . #xbcdc)))
(dotimes (count 20)
(sha1-rewrite sha1-f2&4 '(#xca62 . #xc1d6)))
(setq a (sha1+ AA a)
b (sha1+ BB b)
c (sha1+ CC c)
d (sha1+ DD d)
e (sha1+ EE e)))
(incf v-offset 16))
;; write out the concatenation of the state
(mapconcat #'(lambda (x) (format "%04x" x))
(list (car a) (cdr a)
(car b) (cdr b)
(car c) (cdr c)
(car d) (cdr d)
(car e) (cdr e))
"")))
(provide 'sha1)