From ff6618d00c734705821c70ccb35674e8554c2256 Mon Sep 17 00:00:00 2001 From: ueno Date: Tue, 2 Nov 1999 17:38:27 +0000 Subject: [PATCH] New file. --- EMIKO-VERSION | 21 +++ pgg-def.el | 53 ++++++ pgg-gpg.el | 242 ++++++++++++++++++++++++++++ pgg-parse.el | 499 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ pgg-pgp.el | 210 ++++++++++++++++++++++++ pgg-pgp5.el | 227 ++++++++++++++++++++++++++ pgg.el | 231 ++++++++++++++++++++++++++ 7 files changed, 1483 insertions(+) create mode 100644 EMIKO-VERSION create mode 100644 pgg-def.el create mode 100644 pgg-gpg.el create mode 100644 pgg-parse.el create mode 100644 pgg-pgp.el create mode 100644 pgg-pgp5.el create mode 100644 pgg.el diff --git a/EMIKO-VERSION b/EMIKO-VERSION new file mode 100644 index 0000000..3dda9e4 --- /dev/null +++ b/EMIKO-VERSION @@ -0,0 +1,21 @@ +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 diff --git a/pgg-def.el b/pgg-def.el new file mode 100644 index 0000000..83507f3 --- /dev/null +++ b/pgg-def.el @@ -0,0 +1,53 @@ +;;; pgg-def.el --- functions/macros for defining PGG functions + +;; Copyright (C) 1999 Daiki Ueno + +;; Author: Daiki Ueno +;; 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 diff --git a/pgg-gpg.el b/pgg-gpg.el new file mode 100644 index 0000000..aa26249 --- /dev/null +++ b/pgg-gpg.el @@ -0,0 +1,242 @@ +;;; pgg-gpg.el --- GnuPG support for PGG. + +;; Copyright (C) 1999 Daiki Ueno + +;; Author: Daiki Ueno +;; 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 + diff --git a/pgg-parse.el b/pgg-parse.el new file mode 100644 index 0000000..b8c82f7 --- /dev/null +++ b/pgg-parse.el @@ -0,0 +1,499 @@ +;;; pgg-parse.el --- OpenPGP packet parsing + +;; Copyright (C) 1999 Daiki Ueno + +;; Author: Daiki Ueno +;; 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 , +;; Jon Callas , Lutz Donnerhacke , +;; Hal Finney and Rodney Thayer +;; (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 diff --git a/pgg-pgp.el b/pgg-pgp.el new file mode 100644 index 0000000..7529c5c --- /dev/null +++ b/pgg-pgp.el @@ -0,0 +1,210 @@ +;;; pgg-pgp.el --- PGP 2.* and 6.* support for PGG. + +;; Copyright (C) 1999 Daiki Ueno + +;; Author: Daiki Ueno +;; 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 diff --git a/pgg-pgp5.el b/pgg-pgp5.el new file mode 100644 index 0000000..05e5181 --- /dev/null +++ b/pgg-pgp5.el @@ -0,0 +1,227 @@ +;;; pgg-pgp5.el --- PGP 5.* support for PGG. + +;; Copyright (C) 1999 Daiki Ueno + +;; Author: Daiki Ueno +;; 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 diff --git a/pgg.el b/pgg.el new file mode 100644 index 0000000..2db896b --- /dev/null +++ b/pgg.el @@ -0,0 +1,231 @@ +;;; pgg.el --- glue for the various PGP implementations. + +;; Copyright (C) 1999 Daiki Ueno + +;; Author: Daiki Ueno +;; 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 -- 1.7.10.4