X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fpgg-parse.el;h=3d4539d9466f3d72d08f54447e11e7279104f69a;hb=c85ff27626350a909ee39474fecac012fec8cd26;hp=31fec954e395d89a0038ef857f16e9499e0c8030;hpb=4561b7af638f16343fbfef6a8227c498be6d6cc5;p=gnus diff --git a/lisp/pgg-parse.el b/lisp/pgg-parse.el index 31fec954e..3d4539d94 100644 --- a/lisp/pgg-parse.el +++ b/lisp/pgg-parse.el @@ -1,27 +1,27 @@ ;;; pgg-parse.el --- OpenPGP packet parsing -;; Copyright (C) 1999 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2002-2011 Free Software Foundation, Inc. ;; Author: Daiki Ueno ;; Created: 1999/10/28 ;; Keywords: PGP, OpenPGP, GnuPG +;; Package: pgg +;; Obsolete-since: 24.1 -;; 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 3 of the License, 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. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -35,31 +35,36 @@ ;;; Code: -(eval-when-compile (require 'cl)) - -(require 'custom) +(eval-when-compile + ;; For Emacs <22.2 and XEmacs. + (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))) + (require 'cl)) (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 @@ -67,7 +72,8 @@ (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") @@ -85,7 +91,8 @@ (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." @@ -108,7 +115,7 @@ `(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) @@ -131,7 +138,7 @@ (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) @@ -141,7 +148,7 @@ (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) @@ -173,6 +180,8 @@ (repeat)))) (repeat))))) + (defvar pgg-parse-crc24) + (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) @@ -271,7 +280,7 @@ (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 @@ -288,7 +297,7 @@ (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 @@ -298,13 +307,13 @@ ;; 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 @@ -318,12 +327,12 @@ (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))) @@ -376,7 +385,7 @@ (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 @@ -457,22 +466,29 @@ (cdr (assq (cdr field) pgg-parse-public-key-algorithm-alist))) result)) - + +;; p-d-p only calls this if it is defined, but the compiler does not +;; recognize that. +(declare-function pgg-parse-crc24-string "pgg-parse" (string)) + (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 @@ -482,15 +498,15 @@ (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 (buffer-disable-undo) - (if (fboundp 'set-buffer-multibyte) - (set-buffer-multibyte nil)) + (unless (featurep 'xemacs) + (set-buffer-multibyte nil)) (insert string) (pgg-decode-armor-region (point-min)(point))))