1 files changed, 0 insertions, 515 deletions
diff --git a/lisp/gnus/pgg-parse.el b/lisp/gnus/pgg-parse.el
deleted file mode 100644
index 422ccc6ac23..00000000000
--- a/lisp/gnus/pgg-parse.el
+++ /dev/null
@@ -1,515 +0,0 @@
-;;; pgg-parse.el --- OpenPGP packet parsing
-
-;; Copyright (C) 1999, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1999/10/28
-;; Keywords: PGP, OpenPGP, GnuPG
-
-;; This file is part of GNU Emacs.
-
-;; 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 2, or (at your option)
-;; any later version.
-
-;; 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 GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;    This module is based on
-
-;;	[OpenPGP] RFC 2440: "OpenPGP Message Format"
-;;	    by John W. Noerenberg, II <jwn2@qualcomm.com>,
-;;          Jon Callas <jon@pgp.com>, Lutz Donnerhacke <lutz@iks-jena.de>,
-;;          Hal Finney <hal@pgp.com> and Rodney Thayer <rodney@unitran.com>
-;;	    (1998/11)
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(defgroup pgg-parse ()
-  "OpenPGP packet parsing."
-  :group 'pgg)
-
-(defcustom pgg-parse-public-key-algorithm-alist
-  '((1 . RSA) (2 . RSA-E) (3 . RSA-S) (16 . ELG-E) (17 . DSA) (20 . ELG))
-  "Alist of the assigned number to the public key algorithm."
-  :group 'pgg-parse
-  :type '(repeat
-	  (cons (sexp :tag "Number") (sexp :tag "Type"))))
-
-(defcustom pgg-parse-symmetric-key-algorithm-alist
-  '((1 . IDEA) (2 . 3DES) (4 . CAST5) (5 . SAFER-SK128))
-  "Alist of the assigned number to the simmetric key algorithm."
-  :group 'pgg-parse
-  :type '(repeat
-	  (cons (sexp :tag "Number") (sexp :tag "Type"))))
-
-(defcustom pgg-parse-hash-algorithm-alist
-  '((1 . MD5) (2 . SHA1) (3 . RIPEMD160) (5 . MD2) (8 . SHA256) (9 . SHA384)
-    (10 . SHA512))
-  "Alist of the assigned number to the cryptographic hash algorithm."
-  :group 'pgg-parse
-  :type '(repeat
-	  (cons (sexp :tag "Number") (sexp :tag "Type"))))
-
-(defcustom pgg-parse-compression-algorithm-alist
-  '((0 . nil); Uncompressed
-    (1 . ZIP)
-    (2 . ZLIB))
-  "Alist of the assigned number to the compression algorithm."
-  :group 'pgg-parse
-  :type '(repeat
-	  (cons (sexp :tag "Number") (sexp :tag "Type"))))
-
-(defcustom pgg-parse-signature-type-alist
-  '((0 . "Signature of a binary document")
-    (1 . "Signature of a canonical text document")
-    (2 . "Standalone signature")
-    (16 . "Generic certification of a User ID and Public Key packet")
-    (17 . "Persona certification of a User ID and Public Key packet")
-    (18 . "Casual certification of a User ID and Public Key packet")
-    (19 . "Positive certification of a User ID and Public Key packet")
-    (24 . "Subkey Binding Signature")
-    (31 . "Signature directly on a key")
-    (32 . "Key revocation signature")
-    (40 . "Subkey revocation signature")
-    (48 . "Certification revocation signature")
-    (64 . "Timestamp signature."))
-  "Alist of the assigned number to the signature type."
-  :group 'pgg-parse
-  :type '(repeat
-	  (cons (sexp :tag "Number") (sexp :tag "Type"))))
-
-(defcustom pgg-ignore-packet-checksum t; XXX
-  "If non-nil checksum of each ascii armored packet will be ignored."
-  :group 'pgg-parse
-  :type 'boolean)
-
-(defvar pgg-armor-header-lines
-  '("^-----BEGIN PGP MESSAGE\\(, PART [0-9]+\\(/[0-9]+\\)?\\)?-----\r?$"
-    "^-----BEGIN PGP PUBLIC KEY BLOCK-----\r?$"
-    "^-----BEGIN PGP PRIVATE KEY BLOCK-----\r?$"
-    "^-----BEGIN PGP SIGNATURE-----\r?$")
-  "Armor headers.")
-
-(eval-and-compile
-  (defalias 'pgg-char-int (if (fboundp 'char-int)
-			      'char-int
-			    'identity)))
-
-(defmacro pgg-format-key-identifier (string)
-  `(mapconcat (lambda (c) (format "%02X" (pgg-char-int c)))
-	      ,string "")
-  ;; `(upcase (apply #'format "%02x%02x%02x%02x%02x%02x%02x%02x"
-  ;;                 (string-to-number-list ,string)))
-  )
-
-(defmacro pgg-parse-time-field (bytes)
-  `(list (logior (lsh (car ,bytes) 8)
-		 (nth 1 ,bytes))
-	 (logior (lsh (nth 2 ,bytes) 8)
-		 (nth 3 ,bytes))
-	 0))
-
-(defmacro pgg-byte-after (&optional pos)
-  `(pgg-char-int (char-after ,(or pos `(point)))))
-
-(defmacro pgg-read-byte ()
-  `(pgg-char-int (char-after (prog1 (point) (forward-char)))))
-
-(defmacro pgg-read-bytes-string (nbytes)
-  `(buffer-substring
-    (point) (prog1 (+ ,nbytes (point))
-	      (forward-char ,nbytes))))
-
-(defmacro pgg-read-bytes (nbytes)
-  `(mapcar #'pgg-char-int (pgg-read-bytes-string ,nbytes))
-  ;; `(string-to-number-list (pgg-read-bytes-string ,nbytes))
-  )
-
-(defmacro pgg-read-body-string (ptag)
-  `(if (nth 1 ,ptag)
-       (pgg-read-bytes-string (nth 1 ,ptag))
-     (pgg-read-bytes-string (- (point-max) (point)))))
-
-(defmacro pgg-read-body (ptag)
-  `(mapcar #'pgg-char-int (pgg-read-body-string ,ptag))
-  ;; `(string-to-number-list (pgg-read-body-string ,ptag))
-  )
-
-(defalias 'pgg-skip-bytes 'forward-char)
-
-(defmacro pgg-skip-header (ptag)
-  `(pgg-skip-bytes (nth 2 ,ptag)))
-
-(defmacro pgg-skip-body (ptag)
-  `(pgg-skip-bytes (nth 1 ,ptag)))
-
-(defmacro pgg-set-alist (alist key value)
-  `(setq ,alist (nconc ,alist (list (cons ,key ,value)))))
-
-(when (fboundp 'define-ccl-program)
-
-  (define-ccl-program pgg-parse-crc24
-    '(1
-      ((loop
-	(read r0) (r1 ^= r0) (r2 ^= 0)
-	(r5 = 0)
-	(loop
-	 (r1 <<= 1)
-	 (r1 += ((r2 >> 15) & 1))
-	 (r2 <<= 1)
-	 (if (r1 & 256)
-	     ((r1 ^= 390) (r2 ^= 19707)))
-	 (if (r5 < 7)
-	     ((r5 += 1)
-	      (repeat))))
-	(repeat)))))
-
-  (defun pgg-parse-crc24-string (string)
-    (let ((h (vector nil 183 1230 nil nil nil nil nil nil)))
-      (ccl-execute-on-string pgg-parse-crc24 h string)
-      (format "%c%c%c"
-	      (logand (aref h 1) 255)
-	      (logand (lsh (aref h 2) -8) 255)
-	      (logand (aref h 2) 255)))))
-
-(defmacro pgg-parse-length-type (c)
-  `(cond
-    ((< ,c 192) (cons ,c 1))
-    ((< ,c 224)
-     (cons (+ (lsh (- ,c 192) 8)
-	      (pgg-byte-after (+ 2 (point)))
-	      192)
-	   2))
-    ((= ,c 255)
-     (cons (cons (logior (lsh (pgg-byte-after (+ 2 (point))) 8)
-			 (pgg-byte-after (+ 3 (point))))
-		 (logior (lsh (pgg-byte-after (+ 4 (point))) 8)
-			 (pgg-byte-after (+ 5 (point)))))
-	   5))
-    (t;partial body length
-     '(0 . 0))))
-
-(defun pgg-parse-packet-header ()
-  (let ((ptag (pgg-byte-after))
-	length-type content-tag packet-bytes header-bytes)
-    (if (zerop (logand 64 ptag));Old format
-	(progn
-	  (setq length-type (logand ptag 3)
-		length-type (if (= 3 length-type) 0 (lsh 1 length-type))
-		content-tag (logand 15 (lsh ptag -2))
-		packet-bytes 0
-		header-bytes (1+ length-type))
-	  (dotimes (i length-type)
-	    (setq packet-bytes
-		  (logior (lsh packet-bytes 8)
-			  (pgg-byte-after (+ 1 i (point)))))))
-      (setq content-tag (logand 63 ptag)
-	    length-type (pgg-parse-length-type
-			 (pgg-byte-after (1+ (point))))
-	    packet-bytes (car length-type)
-	    header-bytes (1+ (cdr length-type))))
-    (list content-tag packet-bytes header-bytes)))
-
-(defun pgg-parse-packet (ptag)
-  (case (car ptag)
-    (1 ;Public-Key Encrypted Session Key Packet
-     (pgg-parse-public-key-encrypted-session-key-packet ptag))
-    (2 ;Signature Packet
-     (pgg-parse-signature-packet ptag))
-    (3 ;Symmetric-Key Encrypted Session Key Packet
-     (pgg-parse-symmetric-key-encrypted-session-key-packet ptag))
-    ;; 4        -- One-Pass Signature Packet
-    ;; 5        -- Secret Key Packet
-    (6 ;Public Key Packet
-     (pgg-parse-public-key-packet ptag))
-    ;; 7        -- Secret Subkey Packet
-    ;; 8        -- Compressed Data Packet
-    (9 ;Symmetrically Encrypted Data Packet
-     (pgg-read-body-string ptag))
-    (10 ;Marker Packet
-     (pgg-read-body-string ptag))
-    (11 ;Literal Data Packet
-     (pgg-read-body-string ptag))
-    ;; 12       -- Trust Packet
-    (13 ;User ID Packet
-     (pgg-read-body-string ptag))
-    ;; 14       -- Public Subkey Packet
-    ;; 60 .. 63 -- Private or Experimental Values
-    ))
-
-(defun pgg-parse-packets (&optional header-parser body-parser)
-  (let ((header-parser
-	 (or header-parser
-	     (function pgg-parse-packet-header)))
-	(body-parser
-	 (or body-parser
-	     (function pgg-parse-packet)))
-	result ptag)
-    (while (> (point-max) (1+ (point)))
-      (setq ptag (funcall header-parser))
-      (pgg-skip-header ptag)
-      (push (cons (car ptag)
-		  (save-excursion
-		    (funcall body-parser ptag)))
-	    result)
-      (if (zerop (nth 1 ptag))
-	  (goto-char (point-max))
-	(forward-char (nth 1 ptag))))
-    result))
-
-(defun pgg-parse-signature-subpacket-header ()
-  (let ((length-type (pgg-parse-length-type (pgg-byte-after))))
-    (list (pgg-byte-after (+ (cdr length-type) (point)))
-	  (1- (car length-type))
-	  (1+ (cdr length-type)))))
-
-(defun pgg-parse-signature-subpacket (ptag)
-  (case (car ptag)
-    (2 ;signature creation time
-     (cons 'creation-time
-	   (let ((bytes (pgg-read-bytes 4)))
-	     (pgg-parse-time-field bytes))))
-    (3 ;signature expiration time
-     (cons 'signature-expiry
-	   (let ((bytes (pgg-read-bytes 4)))
-	     (pgg-parse-time-field bytes))))
-    (4 ;exportable certification
-     (cons 'exportability (pgg-read-byte)))
-    (5 ;trust signature
-     (cons 'trust-level (pgg-read-byte)))
-    (6 ;regular expression
-     (cons 'regular-expression
-	   (pgg-read-body-string ptag)))
-    (7 ;revocable
-     (cons 'revocability (pgg-read-byte)))
-    (9 ;key expiration time
-     (cons 'key-expiry
-	   (let ((bytes (pgg-read-bytes 4)))
-	     (pgg-parse-time-field bytes))))
-    ;; 10 = placeholder for backward compatibility
-    (11 ;preferred symmetric algorithms
-     (cons 'preferred-symmetric-key-algorithm
-	   (cdr (assq (pgg-read-byte)
-		      pgg-parse-symmetric-key-algorithm-alist))))
-    (12 ;revocation key
-     )
-    (16 ;issuer key ID
-     (cons 'key-identifier
-	   (pgg-format-key-identifier (pgg-read-body-string ptag))))
-    (20 ;notation data
-     (pgg-skip-bytes 4)
-     (cons 'notation
-	   (let ((name-bytes (pgg-read-bytes 2))
-		 (value-bytes (pgg-read-bytes 2)))
-	     (cons (pgg-read-bytes-string
-		    (logior (lsh (car name-bytes) 8)
-			    (nth 1 name-bytes)))
-		   (pgg-read-bytes-string
-		    (logior (lsh (car value-bytes) 8)
-			    (nth 1 value-bytes)))))))
-    (21 ;preferred hash algorithms
-     (cons 'preferred-hash-algorithm
-	   (cdr (assq (pgg-read-byte)
-		      pgg-parse-hash-algorithm-alist))))
-    (22 ;preferred compression algorithms
-     (cons 'preferred-compression-algorithm
-	   (cdr (assq (pgg-read-byte)
-		      pgg-parse-compression-algorithm-alist))))
-    (23 ;key server preferences
-     (cons 'key-server-preferences
-	   (pgg-read-body ptag)))
-    (24 ;preferred key server
-     (cons 'preferred-key-server
-	   (pgg-read-body-string ptag)))
-    ;; 25 = primary user id
-    (26 ;policy URL
-     (cons 'policy-url (pgg-read-body-string ptag)))
-    ;; 27 = key flags
-    ;; 28 = signer's user id
-    ;; 29 = reason for revocation
-    ;; 100 to 110 = internal or user-defined
-    ))
-
-(defun pgg-parse-signature-packet (ptag)
-  (let* ((signature-version (pgg-byte-after))
-	 (result (list (cons 'version signature-version)))
-	 hashed-material field n)
-    (cond
-     ((= signature-version 3)
-      (pgg-skip-bytes 2)
-      (setq hashed-material (pgg-read-bytes 5))
-      (pgg-set-alist result
-		     'signature-type
-		     (cdr (assq (pop hashed-material)
-				pgg-parse-signature-type-alist)))
-      (pgg-set-alist result
-		     'creation-time
-		     (pgg-parse-time-field hashed-material))
-      (pgg-set-alist result
-		     'key-identifier
-		     (pgg-format-key-identifier
-		      (pgg-read-bytes-string 8)))
-      (pgg-set-alist result
-		     'public-key-algorithm (pgg-read-byte))
-      (pgg-set-alist result
-		     'hash-algorithm (pgg-read-byte)))
-     ((= signature-version 4)
-      (pgg-skip-bytes 1)
-      (pgg-set-alist result
-		     'signature-type
-		     (cdr (assq (pgg-read-byte)
-				pgg-parse-signature-type-alist)))
-      (pgg-set-alist result
-		     'public-key-algorithm
-		     (pgg-read-byte))
-      (pgg-set-alist result
-		     'hash-algorithm (pgg-read-byte))
-      (when (>= 10000 (setq n (pgg-read-bytes 2)
-			    n (logior (lsh (car n) 8)
-				      (nth 1 n))))
-	(save-restriction
-	  (narrow-to-region (point)(+ n (point)))
-	  (nconc result
-		 (mapcar (function cdr) ;remove packet types
-			 (pgg-parse-packets
-			  #'pgg-parse-signature-subpacket-header
-			  #'pgg-parse-signature-subpacket)))
-	  (goto-char (point-max))))
-      (when (>= 10000 (setq n (pgg-read-bytes 2)
-			    n (logior (lsh (car n) 8)
-				      (nth 1 n))))
-	(save-restriction
-	  (narrow-to-region (point)(+ n (point)))
-	  (nconc result
-		 (mapcar (function cdr) ;remove packet types
-			 (pgg-parse-packets
-			  #'pgg-parse-signature-subpacket-header
-			  #'pgg-parse-signature-subpacket)))))))
-
-    (setcdr (setq field (assq 'public-key-algorithm
-			      result))
-	    (cdr (assq (cdr field)
-		       pgg-parse-public-key-algorithm-alist)))
-    (setcdr (setq field (assq 'hash-algorithm
-			      result))
-	    (cdr (assq (cdr field)
-		       pgg-parse-hash-algorithm-alist)))
-    result))
-
-(defun pgg-parse-public-key-encrypted-session-key-packet (ptag)
-  (let (result)
-    (pgg-set-alist result
-		   'version (pgg-read-byte))
-    (pgg-set-alist result
-		   'key-identifier
-		   (pgg-format-key-identifier
-		    (pgg-read-bytes-string 8)))
-    (pgg-set-alist result
-		   'public-key-algorithm
-		   (cdr (assq (pgg-read-byte)
-			      pgg-parse-public-key-algorithm-alist)))
-    result))
-
-(defun pgg-parse-symmetric-key-encrypted-session-key-packet (ptag)
-  (let (result)
-    (pgg-set-alist result
-		   'version
-		   (pgg-read-byte))
-    (pgg-set-alist result
-		   'symmetric-key-algorithm
-		   (cdr (assq (pgg-read-byte)
-			      pgg-parse-symmetric-key-algorithm-alist)))
-    result))
-
-(defun pgg-parse-public-key-packet (ptag)
-  (let* ((key-version (pgg-read-byte))
-	 (result (list (cons 'version key-version)))
-	 field)
-    (cond
-     ((= 3 key-version)
-      (pgg-set-alist result
-		     'creation-time
-		     (let ((bytes (pgg-read-bytes 4)))
-		       (pgg-parse-time-field bytes)))
-      (pgg-set-alist result
-		     'key-expiry (pgg-read-bytes 2))
-      (pgg-set-alist result
-		     'public-key-algorithm (pgg-read-byte)))
-     ((= 4 key-version)
-      (pgg-set-alist result
-		     'creation-time
-		     (let ((bytes (pgg-read-bytes 4)))
-		       (pgg-parse-time-field bytes)))
-      (pgg-set-alist result
-		     'public-key-algorithm (pgg-read-byte))))
-
-    (setcdr (setq field (assq 'public-key-algorithm
-			      result))
-	    (cdr (assq (cdr field)
-		       pgg-parse-public-key-algorithm-alist)))
-    result))
-
-(defun pgg-decode-packets ()
-  (if (re-search-forward "^=\\([A-Za-z0-9+/]\\{4\\}\\)$" nil t)
-      (let ((p (match-beginning 0))
-	    (checksum (match-string 1)))
-	(delete-region p (point-max))
-	(if (ignore-errors (base64-decode-region (point-min) p))
-	    (or (not (fboundp 'pgg-parse-crc24-string))
-		pgg-ignore-packet-checksum
-		(string-equal (base64-encode-string (pgg-parse-crc24-string
-						     (buffer-string)))
-			      checksum)
-		(progn
-		  (message "PGP packet checksum does not match")
-		  nil))
-	  (message "PGP packet contain invalid base64")
-	  nil))
-    (message "PGP packet checksum not found")
-    nil))
-
-(defun pgg-decode-armor-region (start end)
-  (save-restriction
-    (narrow-to-region start end)
-    (goto-char (point-min))
-    (re-search-forward "^-+BEGIN PGP" nil t)
-    (delete-region (point-min)
-		   (and (search-forward "\n\n")
-			(match-end 0)))
-    (when (pgg-decode-packets)
-      (goto-char (point-min))
-      (pgg-parse-packets))))
-
-(defun pgg-parse-armor (string)
-  (with-temp-buffer
-    (buffer-disable-undo)
-    (if (fboundp 'set-buffer-multibyte)
-	(set-buffer-multibyte nil))
-    (insert string)
-    (pgg-decode-armor-region (point-min)(point))))
-
-(eval-and-compile
-  (defalias 'pgg-string-as-unibyte (if (fboundp 'string-as-unibyte)
-				       'string-as-unibyte
-				     'identity)))
-
-(defun pgg-parse-armor-region (start end)
-  (pgg-parse-armor (pgg-string-as-unibyte (buffer-substring start end))))
-
-(provide 'pgg-parse)
-
-;;; arch-tag: 16c2eb82-1313-4a7c-a70f-420709b5b43e
-;;; pgg-parse.el ends here