;;; pgg-parse.el --- OpenPGP packet parsing
-;; Copyright (C) 1999 Free Software Foundation, Inc.
+;; 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 SEMI (Secure Emacs MIME Interface).
+;; 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 (at
-;; your option) any later version.
+;; 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.
-;; 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.
+;; 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., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
(eval-when-compile (require 'cl))
-(require 'custom)
-
(defgroup pgg-parse ()
- "OpenPGP packet parsing"
+ "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 'alist)
+ :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 'alist)
+ :type '(repeat
+ (cons (sexp :tag "Number") (sexp :tag "Type"))))
(defcustom pgg-parse-hash-algorithm-alist
- '((1 . MD5) (2 . SHA1) (3 . RIPEMD160) (5 . MD2))
+ '((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 'alist)
+ :type '(repeat
+ (cons (sexp :tag "Number") (sexp :tag "Type"))))
(defcustom pgg-parse-compression-algorithm-alist
'((0 . nil); Uncompressed
(2 . ZLIB))
"Alist of the assigned number to the compression algorithm."
:group 'pgg-parse
- :type 'alist)
+ :type '(repeat
+ (cons (sexp :tag "Number") (sexp :tag "Type"))))
(defcustom pgg-parse-signature-type-alist
'((0 . "Signature of a binary document")
(64 . "Timestamp signature."))
"Alist of the assigned number to the signature type."
:group 'pgg-parse
- :type 'alist)
+ :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."
`(mapconcat (lambda (c) (format "%02X" (pgg-char-int c)))
,string "")
;; `(upcase (apply #'format "%02x%02x%02x%02x%02x%02x%02x%02x"
- ;; (string-to-int-list ,string)))
+ ;; (string-to-number-list ,string)))
)
(defmacro pgg-parse-time-field (bytes)
(defmacro pgg-read-bytes (nbytes)
`(mapcar #'pgg-char-int (pgg-read-bytes-string ,nbytes))
- ;; `(string-to-int-list (pgg-read-bytes-string ,nbytes))
+ ;; `(string-to-number-list (pgg-read-bytes-string ,nbytes))
)
(defmacro pgg-read-body-string (ptag)
(defmacro pgg-read-body (ptag)
`(mapcar #'pgg-char-int (pgg-read-body-string ,ptag))
- ;; `(string-to-int-list (pgg-read-body-string ,ptag))
+ ;; `(string-to-number-list (pgg-read-body-string ,ptag))
)
(defalias 'pgg-skip-bytes 'forward-char)
(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 'trust-level (pgg-read-byte)))
(6 ;regular expression
(cons 'regular-expression
- (pgg-read-body-string ptag)))
+ (pgg-read-body-string ptag)))
(7 ;revocable
(cons 'revocability (pgg-read-byte)))
(9 ;key expiration time
;; 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))))
+ (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))))
+ (pgg-format-key-identifier (pgg-read-body-string ptag))))
(20 ;notation data
(pgg-skip-bytes 4)
(cons 'notation
(nth 1 value-bytes)))))))
(21 ;preferred hash algorithms
(cons 'preferred-hash-algorithm
- (cdr (assq (pgg-read-byte)
- pgg-parse-hash-algorithm-alist))))
+ (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))))
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-compression-algorithm-alist))))
(23 ;key server preferences
(cons 'key-server-preferences
(pgg-read-body ptag)))
(when (>= 10000 (setq n (pgg-read-bytes 2)
n (logior (lsh (car n) 8)
(nth 1 n))))
- (save-restriction
+ (save-restriction
(narrow-to-region (point)(+ n (point)))
(nconc result
(mapcar (function cdr) ;remove packet types
(cdr (assq (cdr field)
pgg-parse-public-key-algorithm-alist)))
result))
-
+
(defun pgg-decode-packets ()
- (let* ((marker
- (set-marker (make-marker)
- (and (re-search-forward "^=")
- (match-beginning 0))))
- (checksum (buffer-substring (point) (+ 4 (point)))))
- (delete-region marker (point-max))
- (base64-decode-region (point-min) marker)
- (when (fboundp 'pgg-parse-crc24-string)
- (or pgg-ignore-packet-checksum
- (string-equal
- (base64-encode-string (pgg-parse-crc24-string
- (buffer-string)))
- checksum)
- (error "PGP packet checksum does not match")))))
+ (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
(delete-region (point-min)
(and (search-forward "\n\n")
(match-end 0)))
- (pgg-decode-packets)
- (goto-char (point-min))
- (pgg-parse-packets)))
+ (when (pgg-decode-packets)
+ (goto-char (point-min))
+ (pgg-parse-packets))))
(defun pgg-parse-armor (string)
(with-temp-buffer
(provide 'pgg-parse)
+;;; arch-tag: 16c2eb82-1313-4a7c-a70f-420709b5b43e
;;; pgg-parse.el ends here
projects / gnus / blobdiff