--- /dev/null
+Euglena gracilis EMIKO 1.13.6
+Euglena caudata EMIKO 1.13.7
+Euglena oxyuris
+Euglena tripteris
+Euglena proxima
+Euglena viridis
+Euglena sociabilis
+Euglena ehrenbergii
+Euglena deses
+Euglena pisciformis
+Strombomonas acuminata
+Lepocinclis salina
+Lepocinclis wangi
+Phacus longicauda
+Phacus pleuronectes
+Notosolenus
+Anisonema
+Petalomonas
+Peranema
+Urceolus
+Entosiphon
\ No newline at end of file
--- /dev/null
+;;; pgg-def.el --- functions/macros for defining PGG functions
+
+;; Copyright (C) 1999 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; Created: 1999/11/02
+;; Keywords: PGP, OpenPGP, GnuPG
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; 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 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.
+
+;;; Code:
+
+(require 'pcustom)
+
+(defgroup pgg ()
+ "Glue for the various PGP implementations."
+ :group 'mime)
+
+(defcustom pgg-default-scheme 'gpg
+ "Default PGP scheme"
+ :group 'symbol
+ :type 'string)
+
+(defcustom pgg-default-user-id (user-login-name)
+ "User ID of your default identity."
+ :group 'pgg
+ :type 'string)
+
+(defvar pgg-status-buffer " *PGG status*")
+(defvar pgg-errors-buffer " *PGG errors*")
+(defvar pgg-output-buffer " *PGG output*")
+
+(defvar pgg-scheme nil
+ "Current scheme of PGP implementation")
+
+(provide 'pgg-def)
+
+;;; pgg-def.el ends here
--- /dev/null
+;;; pgg-gpg.el --- GnuPG support for PGG.
+
+;; Copyright (C) 1999 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; Created: 1999/10/28
+;; Keywords: PGP, OpenPGP, GnuPG
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; 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 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.
+
+;;; Code:
+
+(eval-when-compile (require 'pgg))
+
+(defgroup pgg-gpg ()
+ "GnuPG interface"
+ :group 'pgg)
+
+(defcustom pgg-gpg-program "gpg"
+ "The GnuPG executable."
+ :group 'pgg-gpg
+ :type 'string)
+
+(defcustom pgg-gpg-shell-file-name "/bin/sh"
+ "The GnuPG executable."
+ :group 'pgg-gpg
+ :type 'string)
+
+(defcustom pgg-gpg-extra-args nil
+ "Extra arguments for every GnuPG invocation."
+ :group 'pgg-gpg
+ :type 'string)
+
+(eval-and-compile
+ (luna-define-class pgg-scheme-gpg (pgg-scheme))
+ )
+
+(defvar pgg-gpg-user-id nil
+ "GnuPG ID of your default identity.")
+
+(defvar pgg-scheme-gpg-instance nil)
+
+;;;###autoload
+(defun pgg-make-scheme-gpg ()
+ (or pgg-scheme-gpg-instance
+ (setq pgg-scheme-gpg-instance
+ (luna-make-entity 'pgg-scheme-gpg))))
+
+(defun pgg-gpg-process-region (start end passphrase program args)
+ (let* ((errors-file-name
+ (concat temporary-file-directory
+ (make-temp-name "pgg-errors")))
+ (status-file-name
+ (concat temporary-file-directory
+ (make-temp-name "pgg-status")))
+ (args
+ (append
+ `("--status-fd" "3"
+ ,@(if passphrase '("--passphrase-fd" "0"))
+ ,@pgg-gpg-extra-args)
+ args
+ (list (concat "2>" errors-file-name)
+ (concat "3>" status-file-name))))
+ (shell-file-name pgg-gpg-shell-file-name)
+ (output-buffer pgg-output-buffer)
+ (errors-buffer pgg-errors-buffer)
+ (status-buffer pgg-status-buffer)
+ (process-connection-type nil)
+ process status exit-status)
+ (with-current-buffer (get-buffer-create output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer))
+ (setq process
+ (apply #'start-process-shell-command "*GnuPG*" output-buffer
+ program args))
+ (set-process-sentinel process 'ignore)
+ (when passphrase
+ (process-send-string process (concat passphrase "\n")))
+ (process-send-region process start end)
+ (process-send-eof process)
+ (while (eq 'run (process-status process))
+ (accept-process-output process 5))
+ (setq status (process-status process)
+ exit-status (process-exit-status process))
+ (delete-process process)
+ (with-current-buffer output-buffer
+ (goto-char (point-min))
+ (while (search-forward "\r$" nil t)
+ (replace-match ""))
+ (if (memq status '(stop signal))
+ (error "%s exited abnormally: '%s'" program exit-status))
+ (if (= 127 exit-status)
+ (error "%s could not be found" program))
+
+ (set-buffer (get-buffer-create errors-buffer))
+ (buffer-disable-undo)
+ (erase-buffer)
+ (insert-file-contents errors-file-name)
+ (delete-file errors-file-name)
+
+ (set-buffer (get-buffer-create status-buffer))
+ (buffer-disable-undo)
+ (erase-buffer)
+ (insert-file-contents status-file-name)
+ (delete-file status-file-name)
+
+ (if (and process (eq 'run (process-status process)))
+ (interrupt-process process))
+ )
+ ))
+
+(luna-define-method encrypt-region ((scheme pgg-scheme-gpg)
+ start end recipients)
+ (let* ((pgg-gpg-user-id pgg-default-user-id)
+ (passphrase
+ (pgg-read-passphrase
+ (format "GnuPG passphrase for %s: " pgg-gpg-user-id)))
+ (args
+ `("--batch" "--armor" "--textmode" "--always-trust" "--encrypt"
+ ,@(if recipients
+ (apply #'append
+ (mapcar (lambda (rcpt)
+ (list "--remote-user"
+ (concat "\"" rcpt "\"")))
+ recipients))))))
+ (pgg-gpg-process-region start end passphrase pgg-gpg-program args)
+ (with-current-buffer pgg-output-buffer
+ (when (zerop (buffer-size))
+ (insert-buffer-substring pgg-errors-buffer)))
+ ))
+
+(luna-define-method decrypt-region ((scheme pgg-scheme-gpg)
+ start end)
+ (let* ((pgg-gpg-user-id pgg-default-user-id)
+ (passphrase
+ (pgg-read-passphrase
+ (format "GnuPG passphrase for %s: " pgg-gpg-user-id)))
+ (args '("--batch" "--decrypt")))
+ (pgg-gpg-process-region start end passphrase pgg-gpg-program args)
+ (with-current-buffer pgg-output-buffer
+ (when (zerop (buffer-size))
+ (insert-buffer-substring pgg-errors-buffer)))
+ ))
+
+(luna-define-method sign-region ((scheme pgg-scheme-gpg)
+ start end)
+ (let* ((pgg-gpg-user-id pgg-default-user-id)
+ (passphrase
+ (pgg-read-passphrase
+ (format "GnuPG passphrase for %s: " pgg-gpg-user-id)))
+ (args
+ (list "--detach-sign" "--armor" "--batch" "--verbose"
+ "--local-user" pgg-gpg-user-id)))
+ (goto-char start)
+ (setq end (set-marker (make-marker) (point-max)))
+ (while (progn (end-of-line) (> (marker-position end) (point)))
+ (insert "\r")
+ (forward-line 1))
+ (pgg-gpg-process-region start end passphrase pgg-gpg-program args)
+ (goto-char start)
+ (while (re-search-forward "\r$" end t)
+ (replace-match ""))
+ (with-current-buffer pgg-output-buffer
+ (when (zerop (buffer-size))
+ (insert-buffer-substring pgg-errors-buffer)))
+ ))
+
+(luna-define-method verify-region ((scheme pgg-scheme-gpg)
+ start end &optional signature)
+ (let ((args '("--batch" "--verify")))
+ (when (stringp signature)
+ (setq args (append args (list signature))))
+ (pgg-gpg-process-region start end nil pgg-gpg-program args)
+ (set-buffer pgg-errors-buffer)
+ (goto-char (point-min))
+ (while (re-search-forward "^gpg: " nil t)
+ (replace-match ""))
+ (goto-char (point-min))
+ (let ((case-fold-search t))
+ (while (re-search-forward "^warning: " nil t)
+ (delete-region (match-beginning 0)
+ (progn (beginning-of-line 2) (point)))))
+ (append-to-buffer pgg-output-buffer
+ (point-min)(point-max))
+ ))
+
+(luna-define-method insert-key ((scheme pgg-scheme-gpg))
+ (let* ((pgg-gpg-user-id pgg-default-user-id)
+ (args (list "--batch" "--export" "--armor"
+ (concat "\"" pgg-gpg-user-id "\""))))
+ (pgg-gpg-process-region (point)(point) nil pgg-gpg-program args)
+ (insert-buffer-substring pgg-output-buffer)
+ ))
+
+(luna-define-method snarf-keys-region ((scheme pgg-scheme-gpg)
+ start end)
+ (let ((args '("--import" "--batch")) status)
+ (pgg-gpg-process-region start end nil pgg-gpg-program args)
+ (set-buffer pgg-status-buffer)
+ (goto-char (point-min))
+ (when (re-search-forward "^\\[GNUPG:] +IMPORT_RES +" nil t)
+ (setq status (buffer-substring (match-end 0)
+ (progn (end-of-line)
+ (point)))
+ status (vconcat (split-string status)))
+ (erase-buffer)
+ (insert (aref status 0) "keys seen\n"
+ (format "\t%d bad, %d new, %d old\n"
+ (string-to-int (aref status 1))
+ (+ (string-to-int (aref status 2))
+ (string-to-int (aref status 10)))
+ (+ (string-to-int (aref status 4))
+ (string-to-int (aref status 11))))
+ (if (zerop (aref status 9))
+ ""
+ "\tSecret keys are imported\n")))
+ (append-to-buffer pgg-output-buffer
+ (point-min)(point-max))
+ (with-current-buffer pgg-output-buffer
+ (when (zerop (buffer-size))
+ (insert-buffer-substring pgg-errors-buffer)))
+ ))
+
+(provide 'pgg-gpg)
+
+;;; pgg-gpg.el ends here
+
--- /dev/null
+;;; pgg-parse.el --- OpenPGP packet parsing
+
+;; Copyright (C) 1999 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; Created: 1999/10/28
+;; Keywords: PGP, OpenPGP, GnuPG
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; 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 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.
+
+;;; 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))
+
+(eval-when-compile (require 'static))
+
+(require 'poem)
+(require 'pccl)
+(require 'pcustom)
+(require 'mel)
+
+(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 'alist)
+
+(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)
+
+(defcustom pgg-parse-hash-algorithm-alist
+ '((1 . MD5) (2 . SHA1) (3 . RIPEMD160) (5 . MD2))
+ "Alist of the assigned number to the cryptographic hash algorithm."
+ :group 'pgg-parse
+ :type 'alist)
+
+(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 'alist)
+
+(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 'alist)
+
+(defcustom pgg-ignore-packet-checksum (featurep 'xemacs); XXX
+ "If non-nil checksum of each ascii armored packet will be ignored."
+ :group 'pgg-parse
+ :type 'boolean)
+
+(defmacro pgg-format-key-identifier (string)
+ `(upcase (apply #'format "%02x%02x%02x%02x%02x%02x%02x%02x"
+ (string-to-int-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)
+ `(char-int (char-after ,pos)))
+
+(defmacro pgg-read-byte ()
+ `(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)
+ `(string-to-int-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)
+ `(string-to-int-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)))))
+
+(unless-broken ccl-usable
+ (check-broken-facility ccl-cascading-read)
+
+ (define-ccl-program pgg-parse-crc24
+ '(1
+ ((r1 = 183) (r2 = 1230)
+ (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)))
+ ((r1 &= 255)
+ (r3 = (r2 & 255))
+ (r2 = ((r2 >> 8) & 255))
+ (write r1 r2 r3))))
+
+ (make-ccl-coding-system
+ 'pgg-parse-crc24 ?C "CRC24 checker"
+ 'pgg-parse-crc24 'pgg-parse-crc24)
+
+ (defun pgg-parse-crc24-string (string)
+ (encode-coding-string string 'pgg-parse-crc24))
+ )
+
+(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 ptag))
+ (10 ;Marker Packet
+ (pgg-read-body ptag))
+ (11 ;Literal Data Packet
+ (pgg-read-body ptag))
+ ;; 12 -- Trust Packet
+ (13 ;User ID Packet
+ (pgg-read-body 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 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
+ )
+ ;; 24 = preferred key server
+ ;; 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
+ 'public-key-identifier
+ (pgg-format-key-identifier (pgg-read-bytes 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 ()
+ (let* ((marker
+ (set-marker (make-marker)
+ (and (re-search-forward "^=")
+ (match-beginning 0))))
+ (checksum (buffer-substring (point) (+ 4 (point)))))
+ (delete-region marker (point-max))
+ (mime-decode-region (point-min) marker "base64")
+ (static-when (fboundp 'pgg-parse-crc24-string )
+ (or pgg-ignore-packet-checksum
+ (string-equal (mime-encode-string
+ (pgg-parse-crc24-string
+ (buffer-substring (point-min)(point-max)))
+ "base64")
+ checksum)
+ (error "PGP packet checksum does not match.")))))
+
+;;;###autoload
+(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)))
+ (pgg-decode-packets)
+ (goto-char (point-min))
+ (pgg-parse-packets)))
+
+(defun pgg-parse-armor (string)
+ (with-temp-buffer
+ (buffer-disable-undo)
+ (set-buffer-multibyte nil)
+ (insert string)
+ (pgg-decode-armor-region (point-min)(point))))
+
+(defun pgg-parse-armor-region (start end)
+ (pgg-parse-armor (string-as-unibyte (buffer-substring start end))))
+
+(provide 'pgg-parse)
+
+;;; pgg-parse.el ends here
--- /dev/null
+;;; pgg-pgp.el --- PGP 2.* and 6.* support for PGG.
+
+;; Copyright (C) 1999 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; Created: 1999/11/02
+;; Keywords: PGP, OpenPGP
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; 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 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.
+
+;;; Code:
+
+(eval-when-compile (require 'pgg))
+
+(defgroup pgg-pgp ()
+ "PGP 2.* and 6.* interface"
+ :group 'pgg)
+
+(defcustom pgg-pgp-program "pgp"
+ "PGP 2.* and 6.* executable."
+ :group 'pgg-pgp
+ :type 'string)
+
+(defcustom pgg-pgp-shell-file-name "/bin/sh"
+ "The GnuPG executable."
+ :group 'pgg-pgp
+ :type 'string)
+
+(defcustom pgg-pgp-extra-args nil
+ "Extra arguments for every PGP invocation."
+ :group 'pgg-pgp
+ :type 'string)
+
+(eval-and-compile
+ (luna-define-class pgg-scheme-pgp (pgg-scheme))
+ )
+
+(defvar pgg-pgp-user-id nil
+ "GnuPG ID of your default identity.")
+
+(defvar pgg-scheme-pgp-instance nil)
+
+;;;###autoload
+(defun pgg-make-scheme-pgp ()
+ (or pgg-scheme-pgp-instance
+ (setq pgg-scheme-pgp-instance
+ (luna-make-entity 'pgg-scheme-pgp))))
+
+(defun pgg-pgp-process-region (start end passphrase program args)
+ (let* ((errors-file-name
+ (concat temporary-file-directory
+ (make-temp-name "pgg-errors")))
+ (args
+ (append args
+ pgg-pgp-extra-args
+ (list (concat "2>" errors-file-name))))
+ (shell-file-name pgg-pgp-shell-file-name)
+ (output-buffer pgg-output-buffer)
+ (errors-buffer pgg-errors-buffer)
+ (process-connection-type nil)
+ process status exit-status)
+ (with-current-buffer (get-buffer-create output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer))
+ (setq process
+ (apply #'start-process-shell-command "*PGP*" output-buffer
+ program args))
+ (set-process-sentinel process 'ignore)
+ (when passphrase
+ (setenv "PGPPASSFD" "0")
+ (process-send-string process (concat passphrase "\n")))
+ (process-send-region process start end)
+ (process-send-eof process)
+ (while (eq 'run (process-status process))
+ (accept-process-output process 5))
+ (setq status (process-status process)
+ exit-status (process-exit-status process))
+ (delete-process process)
+ (with-current-buffer output-buffer
+ (goto-char (point-min))
+ (while (search-forward "\r$" nil t)
+ (replace-match ""))
+ (if (memq status '(stop signal))
+ (error "%s exited abnormally: '%s'" program exit-status))
+ (if (= 127 exit-status)
+ (error "%s could not be found" program))
+
+ (set-buffer (get-buffer-create errors-buffer))
+ (buffer-disable-undo)
+ (erase-buffer)
+ (insert-file-contents errors-file-name)
+ (delete-file errors-file-name)
+
+ (if (and process (eq 'run (process-status process)))
+ (interrupt-process process))
+ )
+ ))
+
+(luna-define-method encrypt-region ((scheme pgg-scheme-pgp)
+ start end recipients)
+ (let* ((pgg-pgp-user-id pgg-default-user-id)
+ (passphrase
+ (pgg-read-passphrase
+ (format "PGP passphrase for %s: " pgg-pgp-user-id)))
+ (args
+ `("+encrypttoself=off +verbose=1" "+batchmode"
+ "+language=us" "-fate"
+ ,@(if recipients
+ (mapcar (lambda (rcpt) (concat "\"" rcpt "\""))
+ recipients)))))
+ (pgg-pgp-process-region start end passphrase
+ pgg-pgp-program args)
+ (with-current-buffer pgg-output-buffer
+ (when (zerop (buffer-size))
+ (insert-buffer-substring pgg-errors-buffer)))
+ ))
+
+(luna-define-method decrypt-region ((scheme pgg-scheme-pgp)
+ start end)
+ (let* ((pgg-pgp-user-id pgg-default-user-id)
+ (passphrase
+ (pgg-read-passphrase
+ (format "PGP passphrase for %s: " pgg-pgp-user-id)))
+ (args
+ '("+verbose=1" "+batchmode" "+language=us" "-f")))
+ (pgg-pgp-process-region start end passphrase
+ pgg-pgp-program args)
+ (with-current-buffer pgg-output-buffer
+ (when (zerop (buffer-size))
+ (insert-buffer-substring pgg-errors-buffer)))
+ ))
+
+(luna-define-method sign-region ((scheme pgg-scheme-pgp)
+ start end)
+ (let* ((pgg-pgp-user-id pgg-default-user-id)
+ (passphrase
+ (pgg-read-passphrase
+ (format "PGP passphrase for %s: " pgg-pgp-user-id)))
+ (args
+ (list "-fbast" "+verbose=1" "+language=us" "+batchmode"
+ "-u" pgg-pgp-user-id)))
+ (pgg-pgp-process-region start end passphrase
+ pgg-pgp-program args)
+ (with-current-buffer pgg-output-buffer
+ (when (zerop (buffer-size))
+ (insert-buffer-substring pgg-errors-buffer)))
+ ))
+
+(luna-define-method verify-region ((scheme pgg-scheme-pgp)
+ start end &optional signature)
+ (let* ((basename (expand-file-name "pgg" temporary-file-directory))
+ (orig-file (make-temp-name basename))
+ (args '("+verbose=1" "+batchmode" "+language=us")))
+ (write-region-as-binary start end orig-file)
+ (when (stringp signature)
+ (copy-file signature (setq signature (concat orig-file ".asc")))
+ (setq args (append args (list signature orig-file)))
+ )
+ (pgg-pgp-process-region (point-min)(point-max) nil
+ pgg-pgp-program args)
+ (delete-file orig-file)
+ (delete-file signature)
+ (set-buffer pgg-output-buffer)
+ (with-current-buffer pgg-output-buffer
+ (when (zerop (buffer-size))
+ (insert-buffer-substring pgg-errors-buffer)))
+ ))
+
+(luna-define-method insert-key ((scheme pgg-scheme-pgp))
+ (let* ((pgg-pgp-user-id pgg-default-user-id)
+ (args
+ (list "+verbose=1" "+batchmode" "+language=us" "-kxaf"
+ (concat "\"" pgg-pgp-user-id "\""))))
+ (pgg-pgp-process-region (point)(point) nil
+ pgg-pgp-program args)
+ (insert-buffer-substring pgg-output-buffer)
+ ))
+
+(luna-define-method snarf-keys-region ((scheme pgg-scheme-pgp)
+ start end)
+ (let* ((pgg-pgp-user-id pgg-default-user-id)
+ (basename (expand-file-name "pgg" temporary-file-directory))
+ (key-file (make-temp-name basename))
+ (args
+ (list "+verbose=1" "+batchmode" "+language=us" "-kaf"
+ key-file)))
+ (write-region-as-raw-text-CRLF start end key-file)
+ (pgg-pgp-process-region start end nil
+ pgg-pgp-program args)
+ (delete-file key-file)
+ ))
+
+(provide 'pgg-pgp)
+
+;;; pgg-pgp.el ends here
--- /dev/null
+;;; pgg-pgp5.el --- PGP 5.* support for PGG.
+
+;; Copyright (C) 1999 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; Created: 1999/11/02
+;; Keywords: PGP, OpenPGP
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; 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 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.
+
+;;; Code:
+
+(eval-when-compile (require 'pgg))
+
+(defgroup pgg-pgp5 ()
+ "PGP 5.* interface"
+ :group 'pgg)
+
+(defcustom pgg-pgp5-pgpe-program "pgpe"
+ "PGP 5.* 'pgpe' executable."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-pgps-program "pgps"
+ "PGP 5.* 'pgps' executable."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-pgpk-program "pgpk"
+ "PGP 5.* 'pgpk' executable."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-pgpv-program "pgpv"
+ "PGP 5.* 'pgpv' executable."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-shell-file-name "/bin/sh"
+ "The GnuPG executable."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-extra-args nil
+ "Extra arguments for every PGP invocation."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(eval-and-compile
+ (luna-define-class pgg-scheme-pgp5 (pgg-scheme))
+ )
+
+(defvar pgg-pgp5-user-id nil
+ "GnuPG ID of your default identity.")
+
+(defvar pgg-scheme-pgp5-instance nil)
+
+;;;###autoload
+(defun pgg-make-scheme-pgp5 ()
+ (or pgg-scheme-pgp5-instance
+ (setq pgg-scheme-pgp5-instance
+ (luna-make-entity 'pgg-scheme-pgp5))))
+
+(defun pgg-pgp5-process-region (start end passphrase program args)
+ (let* ((errors-file-name
+ (concat temporary-file-directory
+ (make-temp-name "pgg-errors")))
+ (args
+ (append args
+ pgg-pgp5-extra-args
+ (list (concat "2>" errors-file-name))))
+ (shell-file-name pgg-pgp5-shell-file-name)
+ (output-buffer pgg-output-buffer)
+ (errors-buffer pgg-errors-buffer)
+ (process-connection-type nil)
+ process status exit-status)
+ (with-current-buffer (get-buffer-create output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer))
+ (setq process
+ (apply #'start-process-shell-command "*PGP*" output-buffer
+ program args))
+ (set-process-sentinel process 'ignore)
+ (when passphrase
+ (setenv "PGPPASSFD" "0")
+ (process-send-string process (concat passphrase "\n")))
+ (process-send-region process start end)
+ (process-send-eof process)
+ (while (eq 'run (process-status process))
+ (accept-process-output process 5))
+ (setq status (process-status process)
+ exit-status (process-exit-status process))
+ (delete-process process)
+ (with-current-buffer output-buffer
+ (goto-char (point-min))
+ (while (search-forward "\r$" nil t)
+ (replace-match ""))
+ (if (memq status '(stop signal))
+ (error "%s exited abnormally: '%s'" program exit-status))
+ (if (= 127 exit-status)
+ (error "%s could not be found" program))
+
+ (set-buffer (get-buffer-create errors-buffer))
+ (buffer-disable-undo)
+ (erase-buffer)
+ (insert-file-contents errors-file-name)
+ (delete-file errors-file-name)
+
+ (if (and process (eq 'run (process-status process)))
+ (interrupt-process process))
+ )
+ ))
+
+(luna-define-method encrypt-region ((scheme pgg-scheme-pgp5)
+ start end recipients)
+ (let* ((pgg-pgp5-user-id pgg-default-user-id)
+ (passphrase
+ (pgg-read-passphrase
+ (format "PGP passphrase for %s: " pgg-pgp5-user-id)))
+ (args
+ `("+NoBatchInvalidKeys=off" "-fat" "+batchmode=1"
+ ,@(if recipients
+ (apply #'append
+ (mapcar (lambda (rcpt)
+ (list "-r"
+ (concat "\"" rcpt "\"")))
+ recipients))))))
+ (pgg-pgp5-process-region start end passphrase
+ pgg-pgp5-pgpe-program args)
+ (with-current-buffer pgg-output-buffer
+ (when (zerop (buffer-size))
+ (insert-buffer-substring pgg-errors-buffer)))
+ ))
+
+(luna-define-method decrypt-region ((scheme pgg-scheme-pgp5)
+ start end)
+ (let* ((pgg-pgp5-user-id pgg-default-user-id)
+ (passphrase
+ (pgg-read-passphrase
+ (format "PGP passphrase for %s: " pgg-pgp5-user-id)))
+ (args
+ '("+verbose=1" "+batchmode=1" "+language=us" "-f")))
+ (pgg-pgp5-process-region start end passphrase
+ pgg-pgp5-pgpv-program args)
+ (with-current-buffer pgg-output-buffer
+ (when (zerop (buffer-size))
+ (insert-buffer-substring pgg-errors-buffer)))
+ ))
+
+(luna-define-method sign-region ((scheme pgg-scheme-pgp5)
+ start end)
+ (let* ((pgg-pgp5-user-id pgg-default-user-id)
+ (passphrase
+ (pgg-read-passphrase
+ (format "PGP passphrase for %s: " pgg-pgp5-user-id)))
+ (args
+ (list "-fbat" "+verbose=1" "+language=us" "+batchmode=1"
+ "-u" pgg-pgp5-user-id)))
+ (pgg-pgp5-process-region start end passphrase
+ pgg-pgp5-pgps-program args)
+ (with-current-buffer pgg-output-buffer
+ (when (zerop (buffer-size))
+ (insert-buffer-substring pgg-errors-buffer)))
+ ))
+
+(luna-define-method verify-region ((scheme pgg-scheme-pgp5)
+ start end &optional signature)
+ (let* ((basename (expand-file-name "pgg" temporary-file-directory))
+ (orig-file (make-temp-name basename))
+ (args '("+verbose=1" "+batchmode=1" "+language=us")))
+ (write-region-as-binary start end orig-file)
+ (when (stringp signature)
+ (copy-file signature (setq signature (concat orig-file ".asc")))
+ (setq args (append args (list signature)))
+ )
+ (pgg-pgp5-process-region (point-min)(point-max) nil
+ pgg-pgp5-pgpv-program args)
+ (delete-file orig-file)
+ (delete-file signature)
+ (set-buffer pgg-output-buffer)
+ (with-current-buffer pgg-output-buffer
+ (when (zerop (buffer-size))
+ (insert-buffer-substring pgg-errors-buffer)))
+ ))
+
+(luna-define-method insert-key ((scheme pgg-scheme-pgp5))
+ (let* ((pgg-pgp5-user-id pgg-default-user-id)
+ (args
+ (list "+verbose=1" "+batchmode=1" "+language=us" "-x"
+ (concat "\"" pgg-pgp5-user-id "\""))))
+ (pgg-pgp5-process-region (point)(point) nil
+ pgg-pgp5-pgpk-program args)
+ (insert-buffer-substring pgg-output-buffer)
+ ))
+
+(luna-define-method snarf-keys-region ((scheme pgg-scheme-pgp5)
+ start end)
+ (let* ((pgg-pgp5-user-id pgg-default-user-id)
+ (basename (expand-file-name "pgg" temporary-file-directory))
+ (key-file (make-temp-name basename))
+ (args
+ (list "+verbose=1" "+batchmode=1" "+language=us" "-a"
+ key-file)))
+ (write-region-as-raw-text-CRLF start end key-file)
+ (pgg-pgp5-process-region start end nil
+ pgg-pgp5-pgpk-program args)
+ (delete-file key-file)
+ ))
+
+(provide 'pgg-pgp5)
+
+;;; pgg-pgp5.el ends here
--- /dev/null
+;;; pgg.el --- glue for the various PGP implementations.
+
+;; Copyright (C) 1999 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; Created: 1999/10/28
+;; Keywords: PGP
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; 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 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.
+
+;;; Code:
+
+(require 'calist)
+
+(eval-and-compile (require 'luna))
+
+(require 'pgg-def)
+(require 'pgg-parse)
+
+(in-calist-package 'pgg)
+
+(defun pgg-field-match-method-with-containment
+ (calist field-type field-value)
+ (let ((s-field (assq field-type calist)))
+ (cond ((null s-field)
+ (cons (cons field-type field-value) calist)
+ )
+ ((memq (cdr s-field) field-value)
+ calist))))
+
+(define-calist-field-match-method 'signature-version
+ #'pgg-field-match-method-with-containment)
+
+(define-calist-field-match-method 'cipher-algorithm
+ #'pgg-field-match-method-with-containment)
+
+(define-calist-field-match-method 'public-key-algorithm
+ #'pgg-field-match-method-with-containment)
+
+(define-calist-field-match-method 'hash-algorithm
+ #'pgg-field-match-method-with-containment)
+
+(defvar pgg-verify-codition nil
+ "Condition-tree about how to display entity.")
+
+(defvar pgg-decrypt-codition nil
+ "Condition-tree about how to display entity.")
+
+(ctree-set-calist-strictly
+ 'pgg-verify-codition
+ '((signature-version 3)(public-key-algorithm RSA)(hash-algorithm MD5)
+ (scheme . pgp)))
+
+(ctree-set-calist-strictly
+ 'pgg-decrypt-codition
+ '((cipher-algorithm IDEA)(public-key-algorithm RSA)
+ (scheme . pgp)))
+
+(ctree-set-calist-strictly
+ 'pgg-verify-codition
+ '((signature-version 3 4)
+ (public-key-algorithm RSA ELG DSA)
+ (hash-algorithm MD5 SHA1 RIPEMD160)
+ (scheme . pgp5)))
+
+(ctree-set-calist-strictly
+ 'pgg-decrypt-codition
+ '((cipher-algorithm 3DES CAST5 IDEA)
+ (public-key-algorithm RSA ELG DSA)
+ (scheme . pgp5)))
+
+(ctree-set-calist-strictly
+ 'pgg-verify-codition
+ '((signature-version 3 4)
+ (public-key-algorithm ELG-E DSA ELG)
+ (hash-algorithm MD5 SHA1 RIPEMD160)
+ (scheme . gpg)))
+
+(ctree-set-calist-strictly
+ 'pgg-decrypt-codition
+ '((public-key-algorithm ELG-E DSA ELG)
+ (cipher-algorithm 3DES CAST5 BLOWFISH TWOFISH)
+ (scheme . gpg)))
+
+;;; @ definition of the implementation scheme
+;;;
+
+(eval-and-compile
+ (luna-define-class pgg-scheme ()
+ (message-beginning-line
+ message-end-line
+ signed-beginning-line
+ signed-end-line
+ key-beginning-line
+ key-end-line
+ ))
+
+ (luna-define-internal-accessors 'pgg-scheme)
+ )
+
+(luna-define-generic encrypt-region (scheme start end recipients)
+ "Encrypt the current region between START and END.")
+
+(luna-define-generic decrypt-region (scheme start end)
+ "Decrypt the current region between START and END.")
+
+(luna-define-generic sign-region (scheme start end)
+ "Make detached signature from text between START and END.")
+
+(luna-define-generic verify-region (scheme start end &optional signature)
+ "Verify region between START and END
+as the detached signature SIGNATURE.")
+
+(luna-define-generic insert-key (scheme)
+ "Insert public key at point.")
+
+(luna-define-generic snarf-keys-region (scheme start end)
+ "Add all public keys in region between START
+and END to the keyring.")
+
+(defvar pgg-scheme-message-delimiters
+ '(:message-beginning-line
+ "^-----BEGIN PGP MESSAGE-----\r?$"
+ :message-end-line
+ "^-----END PGP MESSAGE-----\r?$"
+ :signed-beginning-line
+ "^-----BEGIN PGP SIGNED MESSAGE-----\r?$"
+ :signed-end-line
+ "^-----END PGP SIGNATURE-----\r?$"
+ :key-beginning-line
+ "^-----BEGIN PGP PUBLIC KEY BLOCK-----\r?$"
+ :key-end-line
+ "^-----END PGP PUBLIC KEY BLOCK-----\r?$")
+ "Message delimiters")
+
+(luna-define-method initialize-instance :before ((scheme pgg-scheme)
+ &rest init-args)
+ (let ((luna-current-method-arguments
+ (cons scheme (or init-args
+ pgg-scheme-message-delimiters))))
+ (luna-call-next-method)))
+
+;;; @ interface functions
+;;;
+
+(defmacro pgg-make-scheme (scheme)
+ `(progn
+ (require (intern (format "pgg-%s" ,scheme)))
+ (funcall (intern (format "pgg-make-scheme-%s"
+ ,scheme)))))
+
+(defun pgg-encrypt-region (start end rcpts)
+ (let ((entity (pgg-make-scheme pgg-default-scheme)))
+ (luna-send entity 'encrypt-region entity start end rcpts)))
+
+(defun pgg-decrypt-region (start end)
+ (let* ((packets (pgg-parse-armor-region start end))
+ (scheme
+ (or pgg-scheme
+ (cdr (assq 'scheme
+ (progn
+ (in-calist-package 'pgg)
+ (ctree-match-calist pgg-decrypt-codition
+ packets))))
+ pgg-default-scheme))
+ (entity (pgg-make-scheme scheme)))
+ (luna-send entity 'decrypt-region entity start end)))
+
+(defun pgg-sign-region (start end)
+ (let ((entity (pgg-make-scheme pgg-default-scheme)))
+ (luna-send entity 'sign-region entity start end)))
+
+(defun pgg-verify-region (start end &optional signature)
+ (let* ((packets
+ (with-temp-buffer
+ (buffer-disable-undo)
+ (set-buffer-multibyte nil)
+ (insert-file-contents signature)
+ (pgg-decode-armor-region (point-min)(point-max))
+ ))
+ (scheme
+ (or pgg-scheme
+ (cdr (assq 'scheme
+ (progn
+ (in-calist-package 'pgg)
+ (ctree-match-calist pgg-verify-codition
+ packets))))
+ pgg-default-scheme))
+ (entity (pgg-make-scheme scheme)))
+ (luna-send entity 'verify-region entity start end signature)))
+
+(defun pgg-insert-key ()
+ (let ((entity (pgg-make-scheme pgg-default-scheme)))
+ (luna-send entity 'insert-key entity)))
+
+(defun pgg-snarf-keys-region (start end)
+ (let ((entity (pgg-make-scheme pgg-default-scheme)))
+ (luna-send entity 'snarf-keys-region start end)))
+
+;;; @ utility functions
+;;;
+
+(defvar pgg-read-passphrase nil)
+(defun pgg-read-passphrase (prompt)
+ (if (not pgg-read-passphrase)
+ (if (functionp 'read-passwd)
+ (setq pgg-read-passphrase 'read-passwd)
+ (if (load "passwd" t)
+ (setq pgg-read-passphrase 'read-passwd)
+ (autoload 'ange-ftp-read-passwd "ange-ftp")
+ (setq pgg-read-passphrase 'ange-ftp-read-passwd))))
+ (funcall pgg-read-passphrase prompt))
+
+(provide 'pgg)
+
+;;; pgg.el ends here
projects / elisp / semi.git / commitdiff