From 6260b782ec94886678bc08ecf41d7fa91fa6c9c5 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Wed, 5 Sep 2007 23:39:48 +0000 Subject: [PATCH] * eword-encode.el (make-ew-rword, ew-rword-text, ew-rword-charset) (ew-rword-encoding, ew-rword-type) * hmac-def.el (define-hmac-function) * md4.el (md4-make-step) * sha1-el.el (sha1-F0, sha1-F1, sha1-F2, sha1-F3, sha1-S1) (sha1-S5, sha1-S30, sha1-OP, sha1-add-to-H) * hex-util.el (hex-char-to-num, num-to-hex-char): Revert last changes. --- ChangeLog | 10 ++++ eword-encode.el | 10 ++-- hex-util.el | 26 +++++----- hmac-def.el | 80 ++++++++++++++--------------- md4.el | 9 ++-- sha1-el.el | 153 ++++++++++++++++++++++++++++--------------------------- 6 files changed, 150 insertions(+), 138 deletions(-) diff --git a/ChangeLog b/ChangeLog index b31945d..b59f2ac 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,13 @@ +2007-09-05 Katsumi Yamaoka + + * eword-encode.el (make-ew-rword, ew-rword-text, ew-rword-charset) + (ew-rword-encoding, ew-rword-type) + * hmac-def.el (define-hmac-function) + * md4.el (md4-make-step) + * sha1-el.el (sha1-F0, sha1-F1, sha1-F2, sha1-F3, sha1-S1) + (sha1-S5, sha1-S30, sha1-OP, sha1-add-to-H) + * hex-util.el (hex-char-to-num, num-to-hex-char): Revert last changes. + 2007-09-04 Katsumi Yamaoka * eword-encode.el (make-ew-rword, ew-rword-text, ew-rword-charset) diff --git a/eword-encode.el b/eword-encode.el index 8782254..5b62199 100644 --- a/eword-encode.el +++ b/eword-encode.el @@ -161,15 +161,15 @@ MODE is allows `text', `comment', `phrase' or nil. Default value is ;;; (defmacro make-ew-rword (text charset encoding type) - `(list ,text ,charset ,encoding ,type)) + (` (list (, text)(, charset)(, encoding)(, type)))) (defmacro ew-rword-text (rword) - `(car ,rword)) + (` (car (, rword)))) (defmacro ew-rword-charset (rword) - `(car (cdr ,rword))) + (` (car (cdr (, rword))))) (defmacro ew-rword-encoding (rword) - `(car (cdr (cdr ,rword)))) + (` (car (cdr (cdr (, rword)))))) (defmacro ew-rword-type (rword) - `(car (cdr (cdr (cdr ,rword))))) + (` (car (cdr (cdr (cdr (, rword))))))) (defun ew-find-charset-rule (charsets) (if charsets diff --git a/hex-util.el b/hex-util.el index ed93a3e..09fca4a 100644 --- a/hex-util.el +++ b/hex-util.el @@ -28,14 +28,14 @@ (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))))) + (` (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))) + (` (aref "0123456789abcdef" (, num))))) (defun decode-hex-string (string) "Decode hexadecimal STRING to octet string." @@ -43,9 +43,9 @@ (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))))) +;;; 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) @@ -58,11 +58,11 @@ (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))) +;;; 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 (logand (aref string pos) 15))) (aset dst idx (num-to-hex-char (% (aref string pos) 16))) (setq idx (1+ idx) pos (1+ pos))) diff --git a/hmac-def.el b/hmac-def.el index 4b62b20..9b599d5 100644 --- a/hmac-def.el +++ b/hmac-def.el @@ -39,46 +39,46 @@ 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))))) + (` (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) diff --git a/md4.el b/md4.el index adfc5ec..43af2ae 100644 --- a/md4.el +++ b/md4.el @@ -88,10 +88,11 @@ bytes long. N is required to handle strings containing character 0." (defsubst md4-H (x y z) (logxor x y z)) (defmacro md4-make-step (name func) - `(defun ,name (a b c d xk s ac) + (` + (defun (, name) (a b c d xk s ac) (let* - ((h1 (+ (car a) (,func (car b) (car c) (car d)) (car xk) (car ac))) - (l1 (+ (cdr a) (,func (cdr b) (cdr c) (cdr d)) (cdr xk) (cdr ac))) + ((h1 (+ (car a) ((, func) (car b) (car c) (car d)) (car xk) (car ac))) + (l1 (+ (cdr a) ((, func) (cdr b) (cdr c) (cdr d)) (cdr xk) (cdr ac))) (h2 (logand 65535 (+ h1 (lsh l1 -16)))) (l2 (logand 65535 l1)) ;; cyclic shift of 32 bits integer @@ -101,7 +102,7 @@ bytes long. N is required to handle strings containing character 0." (l3 (logand 65535 (if (> s 15) (+ (lsh l2 (- s 32)) (lsh h2 (- s 16))) (+ (lsh l2 s) (lsh h2 (- s 16))))))) - (cons h3 l3)))) + (cons h3 l3))))) (md4-make-step md4-round1 md4-F) (md4-make-step md4-round2 md4-G) diff --git a/sha1-el.el b/sha1-el.el index dbb9e07..82657b8 100644 --- a/sha1-el.el +++ b/sha1-el.el @@ -123,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)) - (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). @@ -433,7 +433,8 @@ hash of a portion of OBJECT. If BINARY is non-nil, return a string in binary form." (if (stringp object) (sha1-string object binary) - (with-current-buffer object + (save-excursion + (set-buffer object) (sha1-region (or beg (point-min)) (or end (point-max)) binary)))) (provide 'sha1-el) -- 1.7.10.4