X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fpgg-pgp.el;h=1e1bd6d0fd13ffacf361170de76a1d4f65dcca69;hp=4ac1b5d92a76cfd5ce23941943fb6d68fa33126a;hb=fe70196e10cdd849981dbd014882fb20237d0740;hpb=39fd2884cffc24fbb4f0f314e55d2ef0fff871ab diff --git a/lisp/pgg-pgp.el b/lisp/pgg-pgp.el index 4ac1b5d92..1e1bd6d0f 100644 --- a/lisp/pgg-pgp.el +++ b/lisp/pgg-pgp.el @@ -1,34 +1,37 @@ ;;; pgg-pgp.el --- PGP 2.* and 6.* support for PGG. -;; Copyright (C) 1999,2000 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: Daiki Ueno ;; Created: 1999/11/02 ;; Keywords: PGP, OpenPGP -;; This file is part of SEMI (Secure Emacs MIME Interface). +;; This file is part of GNU Emacs. -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or (at -;; your option) any later version. +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Code: -(eval-when-compile (require 'pgg)) +(eval-when-compile + (require 'cl) ; for pgg macros + (require 'pgg)) (defgroup pgg-pgp () - "PGP 2.* and 6.* interface" + "PGP 2.* and 6.* interface." :group 'pgg) (defcustom pgg-pgp-program "pgp" @@ -58,13 +61,11 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." "PGP ID of your default identity.") (defun pgg-pgp-process-region (start end passphrase program args) - (let* ((errors-file-name - (expand-file-name (make-temp-name "pgg-errors") - pgg-temporary-file-directory)) + (let* ((errors-file-name (pgg-make-temp-file "pgg-errors")) (args - (append args + (concat args pgg-pgp-extra-args - (list (concat "2>" errors-file-name)))) + " 2>" (shell-quote-argument errors-file-name))) (shell-file-name pgg-pgp-shell-file-name) (shell-command-switch pgg-pgp-shell-command-switch) (process-environment process-environment) @@ -82,9 +83,8 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." (let ((coding-system-for-read 'binary) (coding-system-for-write 'binary)) (setq process - (apply #'funcall - #'start-process-shell-command "*PGP*" output-buffer - program args))) + (start-process-shell-command "*PGP*" output-buffer + (concat program " " args)))) (set-process-sentinel process #'ignore) (when passphrase (process-send-string process (concat passphrase "\n"))) @@ -131,43 +131,60 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." (buffer-substring (point)(progn (end-of-line) (point))))) 2)))))) -(defun pgg-pgp-encrypt-region (start end recipients) +(defun pgg-pgp-encrypt-region (start end recipients &optional sign passphrase) "Encrypt the current region between START and END." (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id)) + (passphrase (or passphrase + (when sign + (pgg-read-passphrase + (format "PGP passphrase for %s: " + pgg-pgp-user-id) + pgg-pgp-user-id)))) (args - `("+encrypttoself=off +verbose=1" "+batchmode" - "+language=us" "-fate" - ,@(if recipients - (mapcar (lambda (rcpt) (concat "\"" rcpt "\"")) - (append recipients - (if pgg-encrypt-for-me - (list pgg-pgp-user-id)))))))) + (concat + "+encrypttoself=off +verbose=1 +batchmode +language=us -fate " + (if recipients + (mapconcat 'shell-quote-argument + (append recipients + (if pgg-encrypt-for-me + (list pgg-pgp-user-id))))) + (if sign (concat " -s -u " (shell-quote-argument pgg-pgp-user-id)))))) (pgg-pgp-process-region start end nil pgg-pgp-program args) (pgg-process-when-success nil))) -(defun pgg-pgp-decrypt-region (start end) - "Decrypt the current region between START and END." +(defun pgg-pgp-decrypt-region (start end &optional passphrase) + "Decrypt the current region between START and END. + +If optional PASSPHRASE is not specified, it will be obtained from the +passphrase cache or user." (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id)) + (key (pgg-pgp-lookup-key pgg-pgp-user-id 'encrypt)) (passphrase - (pgg-read-passphrase - (format "PGP passphrase for %s: " pgg-pgp-user-id) - (pgg-pgp-lookup-key pgg-pgp-user-id 'encrypt))) + (or passphrase + (pgg-read-passphrase + (format "PGP passphrase for %s: " pgg-pgp-user-id) key))) (args - '("+verbose=1" "+batchmode" "+language=us" "-f"))) + "+verbose=1 +batchmode +language=us -f")) (pgg-pgp-process-region start end passphrase pgg-pgp-program args) - (pgg-process-when-success nil))) + (pgg-process-when-success + (if pgg-cache-passphrase + (pgg-add-passphrase-to-cache key passphrase))))) -(defun pgg-pgp-sign-region (start end &optional clearsign) - "Make detached signature from text between START and END." +(defun pgg-pgp-sign-region (start end &optional clearsign passphrase) + "Make detached signature from text between START and END. + +If optional PASSPHRASE is not specified, it will be obtained from the +passphrase cache or user." (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id)) (passphrase - (pgg-read-passphrase - (format "PGP passphrase for %s: " pgg-pgp-user-id) - (pgg-pgp-lookup-key pgg-pgp-user-id 'sign))) + (or passphrase + (pgg-read-passphrase + (format "PGP passphrase for %s: " pgg-pgp-user-id) + (pgg-pgp-lookup-key pgg-pgp-user-id 'sign)))) (args - (list (if clearsign "-fast" "-fbast") - "+verbose=1" "+language=us" "+batchmode" - "-u" pgg-pgp-user-id))) + (concat (if clearsign "-fast" "-fbast") + " +verbose=1 +language=us +batchmode" + " -u " (shell-quote-argument pgg-pgp-user-id)))) (pgg-pgp-process-region start end passphrase pgg-pgp-program args) (pgg-process-when-success (goto-char (point-min)) @@ -178,15 +195,14 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." (point)) (point-max)))))) (if pgg-cache-passphrase - (pgg-add-passphrase-cache + (pgg-add-passphrase-to-cache (cdr (assq 'key-identifier packet)) passphrase))))))) (defun pgg-pgp-verify-region (start end &optional signature) "Verify region between START and END as the detached signature SIGNATURE." - (let* ((basename (expand-file-name "pgg" temporary-file-directory)) - (orig-file (make-temp-name basename)) - (args '("+verbose=1" "+batchmode" "+language=us")) + (let* ((orig-file (pgg-make-temp-file "pgg")) + (args "+verbose=1 +batchmode +language=us") (orig-mode (default-file-modes))) (unwind-protect (progn @@ -195,9 +211,11 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." jka-compr-compression-info-list jam-zcat-filename-list) (write-region start end orig-file))) (set-default-file-modes orig-mode)) - (when (stringp signature) - (copy-file signature (setq signature (concat orig-file ".asc"))) - (setq args (append args (list signature orig-file)))) + (if (stringp signature) + (progn + (copy-file signature (setq signature (concat orig-file ".asc"))) + (setq args (concat args " " (shell-quote-argument signature))))) + (setq args (concat args " " (shell-quote-argument orig-file))) (pgg-pgp-process-region (point)(point) nil pgg-pgp-program args) (delete-file orig-file) (if signature (delete-file signature)) @@ -217,19 +235,18 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." "Insert public key at point." (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id)) (args - (list "+verbose=1" "+batchmode" "+language=us" "-kxaf" - (concat "\"" pgg-pgp-user-id "\"")))) + (concat "+verbose=1 +batchmode +language=us -kxaf " + (shell-quote-argument pgg-pgp-user-id)))) (pgg-pgp-process-region (point)(point) nil pgg-pgp-program args) (insert-buffer-substring pgg-output-buffer))) (defun pgg-pgp-snarf-keys-region (start end) "Add all public keys in region between START and END to the keyring." (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id)) - (basename (expand-file-name "pgg" temporary-file-directory)) - (key-file (make-temp-name basename)) + (key-file (pgg-make-temp-file "pgg")) (args - (list "+verbose=1" "+batchmode" "+language=us" "-kaf" - key-file))) + (concat "+verbose=1 +batchmode +language=us -kaf " + (shell-quote-argument key-file)))) (let ((coding-system-for-write 'raw-text-dos)) (write-region start end key-file)) (pgg-pgp-process-region start end nil pgg-pgp-program args) @@ -238,4 +255,5 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." (provide 'pgg-pgp) +;; arch-tag: 076b7801-37b2-49a6-97c3-218fdecde33c ;;; pgg-pgp.el ends here