From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/65116 Path: news.gmane.org!not-for-mail From: Reiner Steib Newsgroups: gmane.emacs.gnus.general Subject: Reverting PGG to v5-10 code base on the trunk (was: PGG and EasyPG) Date: Fri, 31 Aug 2007 12:21:06 +0200 Message-ID: References: <06937cc5-86bc-4c13-9779-5b1acab5cc6d@well-done.deisui.org> <876448f20z.fsf@catnip.gol.com> <832a1fc1-35da-426c-a66b-f1b5f850ae92@well-done.deisui.org> <4e687c1c-a602-4248-a49f-535fa0372646@well-done.deisui.org> Reply-To: Reiner Steib NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: sea.gmane.org 1188555727 23334 80.91.229.12 (31 Aug 2007 10:22:07 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Fri, 31 Aug 2007 10:22:07 +0000 (UTC) Cc: Daiki Ueno , Miles Bader To: ding@gnus.org Original-X-From: ding-owner+M13627@lists.math.uh.edu Fri Aug 31 12:22:04 2007 Return-path: Envelope-to: ding-account@gmane.org Original-Received: from util0.math.uh.edu ([129.7.128.18]) by lo.gmane.org with esmtp (Exim 4.50) id 1IR3dT-0005Au-5J for ding-account@gmane.org; Fri, 31 Aug 2007 12:21:56 +0200 Original-Received: from localhost ([127.0.0.1] helo=lists.math.uh.edu) by util0.math.uh.edu with smtp (Exim 4.63) (envelope-from ) id 1IR3d4-0000z8-7I; Fri, 31 Aug 2007 05:21:30 -0500 Original-Received: from mx2.math.uh.edu ([129.7.128.33]) by util0.math.uh.edu with esmtps (TLSv1:AES256-SHA:256) (Exim 4.63) (envelope-from ) id 1IR3d1-0000yp-O5 for ding@lists.math.uh.edu; Fri, 31 Aug 2007 05:21:27 -0500 Original-Received: from quimby.gnus.org ([80.91.231.51]) by mx2.math.uh.edu with esmtp (Exim 4.67) (envelope-from ) id 1IR3cw-000877-OT for ding@lists.math.uh.edu; Fri, 31 Aug 2007 05:21:27 -0500 Original-Received: from mail.uni-ulm.de ([134.60.1.11]) by quimby.gnus.org with esmtp (Exim 3.35 #1 (Debian)) id 1IR3cv-0006Rr-00 for ; Fri, 31 Aug 2007 12:21:21 +0200 Original-Received: from bridgekeeper.physik.uni-ulm.de (bridgekeeper.physik.uni-ulm.de [134.60.41.37]) by mail.uni-ulm.de (8.14.1/8.14.1) with ESMTP id l7VALIXm022735; Fri, 31 Aug 2007 12:21:18 +0200 (MEST) Original-Received: from localhost (bridgekeeper.physik.uni-ulm.de [134.60.41.37]) by bridgekeeper.physik.uni-ulm.de (Postfix) with ESMTP id 81ADB12C5B; Fri, 31 Aug 2007 12:21:18 +0200 (CEST) X-Face: 3Phac&+dw=IZHjhua]bp}LH<*p{qzj8u+ Precedence: bulk Xref: news.gmane.org gmane.emacs.gnus.general:65116 Archived-At: --=-=-= On Fri, Aug 31 2007, Reiner Steib wrote: > [Quoting added:] >>> > 1. Reverting PGG in the Gnus trunk to the version in v5-10. >>> > 1a. Fixing bugs caused by 1. and testing... >>> > 2. Synch'ing Gnus in the Emacs CVS to the Gnus trunk. >>> > 3. Including EasyPG to the Emacs CVS (not to the Gnus CVS). [...] >>> Getting through the copyright process may take quite a long time, so I >>> don't think we should delay items 1, 1a and 2 while waiting for (or >>> working on) 3. >> >> Sure. > > Fine. [I'll come back to this later on.] Would someone like to work on this? I.e. compare v5-10/lisp/pgg*.el with trunk/lisp/pgg*.el and sync the files (direction: v5-10 --> trunk). The use of `password.el' in the trunk might need some attention. I don't know what is the right thing to do there. The diff (cvs diff -u -r HEAD -r v5-10 pgg*.el) is only 13 hunks (unrelated GPLv3 changes excluded), so it should be a feasible job. Probably Daiki Ueno or Simon Josefsson are able to answer specific questions. Here's the diff (unrelated GPLv3 changes excluded). If someone thinks reverting any of these changes (to the v5-10 code) is problematic, please report and explain. --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=PGG-HEAD-vs-v5-10-wo-GPLv3.diff Index: pgg-def.el =================================================================== RCS file: /usr/local/cvsroot/gnus/lisp/pgg-def.el,v retrieving revision 7.12 retrieving revision 6.6.2.14 diff -u -r7.12 -r6.6.2.14 --- pgg-def.el 24 Jan 2007 07:15:37 -0000 7.12 +++ pgg-def.el 27 Aug 2007 04:03:54 -0000 6.6.2.14 @@ -70,6 +70,11 @@ `pgg-cache-passphrase'." :group 'pgg :type 'integer) + +(defcustom pgg-passphrase-coding-system nil + "Coding system to encode passphrase." + :group 'pgg + :type 'coding-system) (defvar pgg-messages-coding-system nil "Coding system used when reading from a PGP external process.") Index: pgg.el =================================================================== RCS file: /usr/local/cvsroot/gnus/lisp/pgg.el,v retrieving revision 7.14 retrieving revision 6.23.2.16 diff -u -r7.14 -r6.23.2.16 --- pgg.el 14 Jun 2007 09:49:28 -0000 7.14 +++ pgg.el 27 Aug 2007 04:03:53 -0000 6.23.2.16 @@ -31,7 +31,7 @@ (require 'pgg-def) (require 'pgg-parse) -(require 'password) +(autoload 'run-at-time "timer") ;; Don't merge these two `eval-when-compile's. (eval-when-compile @@ -88,11 +88,19 @@ (defun pgg-display-error-buffer () "Pop up an error buffer indicating the reason for an en/decryption failure." (let ((temp-buffer-show-function - (function pgg-temp-buffer-show-function))) + (function pgg-temp-buffer-show-function))) (with-output-to-temp-buffer pgg-echo-buffer (set-buffer standard-output) (insert-buffer-substring pgg-errors-buffer)))) +(defvar pgg-passphrase-cache (make-vector 7 0)) + +(defvar pgg-pending-timers (make-vector 7 0) + "Hash table for managing scheduled pgg cache management timers. + +We associate key and timer, so the timer can be cancelled if a new +timeout for the key is set while an old one is still pending.") + (defun pgg-read-passphrase (prompt &optional key notruncate) "Using PROMPT, obtain passphrase for KEY from cache or user. @@ -101,9 +109,21 @@ Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry' regulate cache behavior." - (password-read prompt (if notruncate - key - (pgg-truncate-key-identifier key)))) + (or (pgg-read-passphrase-from-cache key notruncate) + (read-passwd prompt))) + +(defun pgg-read-passphrase-from-cache (key &optional notruncate) + "Obtain passphrase for KEY from time-limited passphrase cache. + +Truncate the key to 8 trailing characters unless NOTRUNCATE is true +\(default false). + +Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry' +regulate cache behavior." + (and pgg-cache-passphrase + key (or notruncate + (setq key (pgg-truncate-key-identifier key))) + (symbol-value (intern-soft key pgg-passphrase-cache)))) (defun pgg-add-passphrase-to-cache (key passphrase &optional notruncate) "Associate KEY with PASSPHRASE in time-limited passphrase cache. @@ -113,11 +133,25 @@ Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry' regulate cache behavior." - (let ((password-cache-expiry pgg-passphrase-cache-expiry)) - (password-cache-add (if notruncate - key - (pgg-truncate-key-identifier key)) - passphrase))) + + (let* ((key (if notruncate key (pgg-truncate-key-identifier key))) + (interned-timer-key (intern-soft key pgg-pending-timers)) + (old-timer (symbol-value interned-timer-key)) + new-timer) + (when old-timer + (cancel-timer old-timer) + (unintern interned-timer-key pgg-pending-timers)) + (set (intern key pgg-passphrase-cache) + passphrase) + (set (intern key pgg-pending-timers) + (pgg-run-at-time pgg-passphrase-cache-expiry nil + #'pgg-remove-passphrase-from-cache + key notruncate)))) + +(if (fboundp 'clear-string) + (defalias 'pgg-clear-string 'clear-string) + (defun pgg-clear-string (string) + (fillarray string ?_))) (defun pgg-remove-passphrase-from-cache (key &optional notruncate) "Omit passphrase associated with KEY in time-limited passphrase cache. @@ -132,9 +166,95 @@ Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry' regulate cache behavior." - (password-cache-remove (if notruncate - key - (pgg-truncate-key-identifier key)))) + (let* ((passphrase (pgg-read-passphrase-from-cache key notruncate)) + (key (if notruncate key (pgg-truncate-key-identifier key))) + (interned-timer-key (intern-soft key pgg-pending-timers)) + (old-timer (symbol-value interned-timer-key))) + (when passphrase + (pgg-clear-string passphrase) + (unintern key pgg-passphrase-cache)) + (when old-timer + (pgg-cancel-timer old-timer) + (unintern interned-timer-key pgg-pending-timers)))) + +(eval-when-compile + (defmacro pgg-run-at-time-1 (time repeat function args) + (when (featurep 'xemacs) + (if (condition-case nil + (let ((delete-itimer 'delete-itimer) + (itimer-driver-start 'itimer-driver-start) + (itimer-value 'itimer-value) + (start-itimer 'start-itimer)) + (unless (or (symbol-value 'itimer-process) + (symbol-value 'itimer-timer)) + (funcall itimer-driver-start)) + ;; Check whether there is a bug to which the difference of + ;; the present time and the time when the itimer driver was + ;; woken up is subtracted from the initial itimer value. + (let* ((inhibit-quit t) + (ctime (current-time)) + (itimer-timer-last-wakeup + (prog1 + ctime + (setcar ctime (1- (car ctime))))) + (itimer-list nil) + (itimer (funcall start-itimer "pgg-run-at-time" + 'ignore 5))) + (sleep-for 0.1) ;; Accept the timeout interrupt. + (prog1 + (> (funcall itimer-value itimer) 0) + (funcall delete-itimer itimer)))) + (error nil)) + `(let ((time ,time)) + (apply #'start-itimer "pgg-run-at-time" + ,function (if time (max time 1e-9) 1e-9) + ,repeat nil t ,args))) + `(let ((time ,time) + (itimers (list nil))) + (setcar + itimers + (apply #'start-itimer "pgg-run-at-time" + (lambda (itimers repeat function &rest args) + (let ((itimer (car itimers))) + (if repeat + (progn + (set-itimer-function + itimer + (lambda (itimer repeat function &rest args) + (set-itimer-restart itimer repeat) + (set-itimer-function itimer function) + (set-itimer-function-arguments itimer args) + (apply function args))) + (set-itimer-function-arguments + itimer + (append (list itimer repeat function) args))) + (set-itimer-function + itimer + (lambda (itimer function &rest args) + (delete-itimer itimer) + (apply function args))) + (set-itimer-function-arguments + itimer + (append (list itimer function) args))))) + 1e-9 (if time (max time 1e-9) 1e-9) + nil t itimers ,repeat ,function ,args)))))) + +(eval-and-compile + (if (featurep 'xemacs) + (progn + (defun pgg-run-at-time (time repeat function &rest args) + "Emulating function run as `run-at-time'. +TIME should be nil meaning now, or a number of seconds from now. +Return an itimer object which can be used in either `delete-itimer' +or `cancel-timer'." + (pgg-run-at-time-1 time repeat function args)) + (defun pgg-cancel-timer (timer) + "Emulate cancel-timer for xemacs." + (let ((delete-itimer 'delete-itimer)) + (funcall delete-itimer timer))) + ) + (defalias 'pgg-run-at-time 'run-at-time) + (defalias 'pgg-cancel-timer 'cancel-timer))) (defmacro pgg-convert-lbt-region (start end lbt) `(let ((pgg-conversion-end (set-marker (make-marker) ,end))) @@ -305,7 +425,7 @@ (pgg-invoke "sign-region" (or pgg-scheme pgg-default-scheme) (point-min) (point-max) (or (interactive-p) cleartext) - passphrase)))) + passphrase)))) (when (interactive-p) (pgg-display-output-buffer start end status)) status)) @@ -329,8 +449,8 @@ (let* ((start (or start (point-min))) (end (or end (point-max))) (status (pgg-sign-region start end - (or (interactive-p) cleartext) - passphrase))) + (or (interactive-p) cleartext) + passphrase))) (when (interactive-p) (pgg-display-output-buffer start end status)) status)) Index: pgg-gpg.el =================================================================== RCS file: /usr/local/cvsroot/gnus/lisp/pgg-gpg.el,v retrieving revision 7.27 retrieving revision 6.23.2.34 diff -u -r7.27 -r6.23.2.34 --- pgg-gpg.el 1 Mar 2007 23:43:33 -0000 7.27 +++ pgg-gpg.el 27 Aug 2007 04:03:54 -0000 6.23.2.34 @@ -4,7 +4,8 @@ ;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: Daiki Ueno -;; Symmetric encryption support added by: Sascha Wilde +;; Symmetric encryption and gpg-agent support added by: +;; Sascha Wilde ;; Created: 1999/10/28 ;; Keywords: PGP, OpenPGP, GnuPG @@ -28,6 +29,7 @@ ;;; Code: (eval-when-compile + (require 'cl) ; for gpg macros (require 'pgg)) (defgroup pgg-gpg () @@ -58,170 +60,110 @@ (defvar pgg-gpg-user-id nil "GnuPG ID of your default identity.") -(defvar pgg-gpg-user-id-alist nil - "An alist mapping from key ID to user ID.") - -(defvar pgg-gpg-read-point nil) -(defvar pgg-gpg-output-file-name nil) -(defvar pgg-gpg-pending-status-list nil) -(defvar pgg-gpg-key-id nil) -(defvar pgg-gpg-passphrase nil) -(defvar pgg-gpg-debug nil) - -(defun pgg-gpg-start-process (args) - (let* ((output-file-name (pgg-make-temp-file "pgg-output")) +(defun pgg-gpg-process-region (start end passphrase program args) + (let* ((use-agent (and (null passphrase) (pgg-gpg-use-agent-p))) + (output-file-name (pgg-make-temp-file "pgg-output")) (args - (append (list "--no-tty" - "--status-fd" "1" - "--command-fd" "0" - "--yes" ; overwrite - "--output" output-file-name) - (if pgg-gpg-use-agent '("--use-agent")) - pgg-gpg-extra-args - args)) - (coding-system-for-write 'binary) - (process-connection-type nil) + `("--status-fd" "2" + ,@(if use-agent '("--use-agent") + (if passphrase '("--passphrase-fd" "0"))) + "--yes" ; overwrite + "--output" ,output-file-name + ,@pgg-gpg-extra-args ,@args)) + (output-buffer pgg-output-buffer) + (errors-buffer pgg-errors-buffer) (orig-mode (default-file-modes)) - (buffer (generate-new-buffer " *pgg-gpg*")) - process) - (with-current-buffer buffer - (make-local-variable 'pgg-gpg-read-point) - (setq pgg-gpg-read-point (point-min)) - (make-local-variable 'pgg-gpg-output-file-name) - (setq pgg-gpg-output-file-name output-file-name) - (make-local-variable 'pgg-gpg-pending-status-list) - (setq pgg-gpg-pending-status-list nil) - (make-local-variable 'pgg-gpg-key-id) - (setq pgg-gpg-key-id nil) - (make-local-variable 'pgg-gpg-passphrase) - (setq pgg-gpg-passphrase nil)) + (process-connection-type nil) + (inhibit-redisplay t) + process status exit-status + passphrase-with-newline + encoded-passphrase-with-new-line) + (with-current-buffer (get-buffer-create errors-buffer) + (buffer-disable-undo) + (erase-buffer)) (unwind-protect (progn (set-default-file-modes 448) - (setq process - (apply #'start-process "pgg-gpg" buffer pgg-gpg-program args))) - (set-default-file-modes orig-mode)) - (set-process-filter process #'pgg-gpg-process-filter) - (set-process-sentinel process #'pgg-gpg-process-sentinel) - process)) - -(defun pgg-gpg-process-filter (process input) - (if pgg-gpg-debug - (save-excursion - (set-buffer (get-buffer-create " *pgg-gpg-debug*")) - (goto-char (point-max)) - (insert input))) - (if (buffer-live-p (process-buffer process)) - (save-excursion - (set-buffer (process-buffer process)) - (goto-char (point-max)) - (insert input) - (goto-char pgg-gpg-read-point) - (beginning-of-line) - (while (looking-at ".*\n") ;the input line is finished - (save-excursion - (if (looking-at "\\[GNUPG:] \\([A-Z_]+\\)\\>.*") - (let* ((status (match-string 1)) - (symbol (intern-soft (concat "pgg-gpg-status-" - status)))) - (if (member status pgg-gpg-pending-status-list) - (setq pgg-gpg-pending-status-list nil)) - (if (and symbol - (fboundp symbol)) - (funcall symbol process (buffer-substring - (match-beginning 1) - (match-end 0))))))) - (forward-line)) - (setq pgg-gpg-read-point (point))))) - -(defun pgg-gpg-process-sentinel (process status) - (if (buffer-live-p (process-buffer process)) - (save-excursion - (set-buffer (process-buffer process)) - (when pgg-gpg-passphrase - (fillarray pgg-gpg-passphrase 0) - (setq pgg-gpg-passphrase nil)) - ;; Copy the contents of process-buffer to pgg-errors-buffer. - (set-buffer (get-buffer-create pgg-errors-buffer)) - (buffer-disable-undo) - (erase-buffer) - (insert-buffer-substring (process-buffer process)) - ;; Read the contents of the output file to pgg-output-buffer. - (set-buffer (get-buffer-create pgg-output-buffer)) - (buffer-disable-undo) - (erase-buffer) - (if (equal status "finished\n") - (let ((output-file-name - (with-current-buffer (process-buffer process) - pgg-gpg-output-file-name))) - (when (file-exists-p output-file-name) + (let ((coding-system-for-write 'binary)) + (setq process + (apply #'start-process "*GnuPG*" errors-buffer + program args))) + (set-process-sentinel process #'ignore) + (when passphrase + (setq passphrase-with-newline (concat passphrase "\n")) + (if pgg-passphrase-coding-system + (progn + (setq encoded-passphrase-with-new-line + (encode-coding-string + passphrase-with-newline + (coding-system-change-eol-conversion + pgg-passphrase-coding-system 'unix))) + (pgg-clear-string passphrase-with-newline)) + (setq encoded-passphrase-with-new-line passphrase-with-newline + passphrase-with-newline nil)) + (process-send-string process encoded-passphrase-with-new-line)) + (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 (get-buffer-create output-buffer) + (buffer-disable-undo) + (erase-buffer) + (if (file-exists-p output-file-name) (let ((coding-system-for-read (if pgg-text-mode 'raw-text 'binary))) - (insert-file-contents output-file-name)) - (delete-file output-file-name)))) - (kill-buffer (process-buffer process))))) - -(defun pgg-gpg-wait-for-status (process status-list) - (with-current-buffer (process-buffer process) - (setq pgg-gpg-pending-status-list status-list) - (while (and (eq (process-status process) 'run) - pgg-gpg-pending-status-list) - (accept-process-output process 1)))) - -(defun pgg-gpg-wait-for-completion (process) - (process-send-eof process) - (while (eq (process-status process) 'run) - ;; We can't use accept-process-output instead of sit-for here - ;; because it may cause an interrupt during the sentinel execution. - (sit-for 0.1))) - -(defun pgg-gpg-status-USERID_HINT (process line) - (if (string-match "\\`USERID_HINT \\([^ ]+\\) \\(.*\\)" line) - (let* ((key-id (match-string 1 line)) - (user-id (match-string 2 line)) - (entry (assoc key-id pgg-gpg-user-id-alist))) - (if entry - (setcdr entry user-id) - (setq pgg-gpg-user-id-alist (cons (cons key-id user-id) - pgg-gpg-user-id-alist)))))) - -(defun pgg-gpg-status-NEED_PASSPHRASE (process line) - (if (string-match "\\`NEED_PASSPHRASE \\([^ ]+\\)" line) - (setq pgg-gpg-key-id (match-string 1 line)))) - -(defun pgg-gpg-status-NEED_PASSPHRASE_SYM (process line) - (setq pgg-gpg-key-id 'SYM)) - -(defun pgg-gpg-status-NEED_PASSPHRASE_PIN (process line) - (setq pgg-gpg-key-id 'PIN)) - -(defun pgg-gpg-status-GET_HIDDEN (process line) - (let ((entry (assoc pgg-gpg-key-id pgg-gpg-user-id-alist))) - (if (setq pgg-gpg-passphrase - (if (eq pgg-gpg-key-id 'SYM) - (pgg-read-passphrase - "GnuPG passphrase for symmetric encryption: ") - (pgg-read-passphrase - (format "GnuPG passphrase for %s: " - (if entry - (cdr entry) - pgg-gpg-key-id)) - (if (eq pgg-gpg-key-id 'PIN) - "PIN" - pgg-gpg-key-id)))) - (process-send-string process (concat pgg-gpg-passphrase "\n"))))) - -(defun pgg-gpg-status-GOOD_PASSPHRASE (process line) - (when (and pgg-gpg-passphrase - (stringp pgg-gpg-key-id)) - (pgg-add-passphrase-to-cache pgg-gpg-key-id pgg-gpg-passphrase) - (setq pgg-gpg-passphrase nil))) - -(defun pgg-gpg-status-BAD_PASSPHRASE (process line) - (when pgg-gpg-passphrase - (fillarray pgg-gpg-passphrase 0) - (setq pgg-gpg-passphrase nil))) + (insert-file-contents output-file-name))) + (set-buffer errors-buffer) + (if (memq status '(stop signal)) + (error "%s exited abnormally: '%s'" program exit-status)) + (if (= 127 exit-status) + (error "%s could not be found" program)))) + (if passphrase-with-newline + (pgg-clear-string passphrase-with-newline)) + (if encoded-passphrase-with-new-line + (pgg-clear-string encoded-passphrase-with-new-line)) + (if (and process (eq 'run (process-status process))) + (interrupt-process process)) + (if (file-exists-p output-file-name) + (delete-file output-file-name)) + (set-default-file-modes orig-mode)))) + +(defun pgg-gpg-possibly-cache-passphrase (passphrase &optional key notruncate) + (if (and passphrase + pgg-cache-passphrase + (progn + (goto-char (point-min)) + (re-search-forward "^\\[GNUPG:] \\(GOOD_PASSPHRASE\\>\\)\\|\\(SIG_CREATED\\)" nil t))) + (pgg-add-passphrase-to-cache + (or key + (progn + (goto-char (point-min)) + (if (re-search-forward + "^\\[GNUPG:] NEED_PASSPHRASE\\(_PIN\\)? \\w+ ?\\w*" nil t) + (substring (match-string 0) -8)))) + passphrase + notruncate))) + +(defvar pgg-gpg-all-secret-keys 'unknown) + +(defun pgg-gpg-lookup-all-secret-keys () + "Return all secret keys present in secret key ring." + (when (eq pgg-gpg-all-secret-keys 'unknown) + (setq pgg-gpg-all-secret-keys '()) + (let ((args (list "--with-colons" "--no-greeting" "--batch" + "--list-secret-keys"))) + (with-temp-buffer + (apply #'call-process pgg-gpg-program nil t nil args) + (goto-char (point-min)) + (while (re-search-forward + "^\\(sec\\|pub\\):[^:]*:[^:]*:[^:]*:\\([^:]*\\)" nil t) + (push (substring (match-string 2) 8) + pgg-gpg-all-secret-keys))))) + pgg-gpg-all-secret-keys) (defun pgg-gpg-lookup-key (string &optional type) "Search keys associated with STRING." @@ -235,15 +177,52 @@ nil t) (substring (match-string 2) 8))))) +(defun pgg-gpg-lookup-key-owner (string &optional all) + "Search keys associated with STRING and return owner of identified key. + +The value may be just the bare key id, or it may be a combination of the +user name associated with the key and the key id, with the key id enclosed +in \"<...>\" angle brackets. + +Optional ALL non-nil means search all keys, including secret keys." + (let ((args (list "--with-colons" "--no-greeting" "--batch" + (if all "--list-secret-keys" "--list-keys") + string)) + (key-regexp (concat "^\\(sec\\|pub\\)" + ":[^:]*:[^:]*:[^:]*:\\([^:]*\\):[^:]*" + ":[^:]*:[^:]*:[^:]*:\\([^:]*\\):"))) + (with-temp-buffer + (apply #'call-process pgg-gpg-program nil t nil args) + (goto-char (point-min)) + (if (re-search-forward key-regexp + nil t) + (match-string 3))))) + +(defun pgg-gpg-key-id-from-key-owner (key-owner) + (cond ((not key-owner) nil) + ;; Extract bare key id from outermost paired angle brackets, if any: + ((string-match "[^<]*<\\(.+\\)>[^>]*" key-owner) + (substring key-owner (match-beginning 1)(match-end 1))) + (key-owner))) + (defun pgg-gpg-encrypt-region (start end recipients &optional sign passphrase) "Encrypt the current region between START and END. -If optional argument SIGN is non-nil, do a combined sign and encrypt." +If optional argument SIGN is non-nil, do a combined sign and encrypt. + +If optional PASSPHRASE is not specified, it will be obtained from the +passphrase cache or user." (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id)) + (passphrase (or passphrase + (when (and sign (not (pgg-gpg-use-agent-p))) + (pgg-read-passphrase + (format "GnuPG passphrase for %s: " + pgg-gpg-user-id) + pgg-gpg-user-id)))) (args (append - '("--armor" "--always-trust" "--encrypt") - (if pgg-text-mode '("--textmode")) + (list "--batch" "--armor" "--always-trust" "--encrypt") + (if pgg-text-mode (list "--textmode")) (if sign (list "--sign" "--local-user" pgg-gpg-user-id)) (if (or recipients pgg-encrypt-for-me) (apply #'nconc @@ -251,101 +230,178 @@ (list pgg-gpg-recipient-argument rcpt)) (append recipients (if pgg-encrypt-for-me - (list pgg-gpg-user-id)))))))) - (process (pgg-gpg-start-process args))) - (if (and sign (not pgg-gpg-use-agent)) - (pgg-gpg-wait-for-status process '("BEGIN_SIGNING" "GOOD_PASSPHRASE"))) - (process-send-region process start end) - (pgg-gpg-wait-for-completion process) - (save-excursion - (set-buffer (get-buffer-create pgg-errors-buffer)) - (goto-char (point-max)) - (not (null (re-search-backward "^\\[GNUPG:] END_ENCRYPTION\\>" - nil t)))))) + (list pgg-gpg-user-id))))))))) + (pgg-gpg-process-region start end passphrase pgg-gpg-program args) + (when sign + (with-current-buffer pgg-errors-buffer + ;; Possibly cache passphrase under, e.g. "jas", for future sign. + (pgg-gpg-possibly-cache-passphrase passphrase pgg-gpg-user-id) + ;; Possibly cache passphrase under, e.g. B565716F, for future decrypt. + (pgg-gpg-possibly-cache-passphrase passphrase))) + (pgg-process-when-success))) (defun pgg-gpg-encrypt-symmetric-region (start end &optional passphrase) - "Encrypt the current region between START and END with symmetric cipher." - (let* ((args - (append '("--armor" "--symmetric") - (if pgg-text-mode '("--textmode")))) - (process (pgg-gpg-start-process args))) - (pgg-gpg-wait-for-status process '("BEGIN_ENCRYPTION")) - (process-send-region process start end) - (pgg-gpg-wait-for-completion process) - (save-excursion - (set-buffer (get-buffer-create pgg-errors-buffer)) - (goto-char (point-max)) - (not (null (re-search-backward "^\\[GNUPG:] END_ENCRYPTION\\>" - nil t)))))) + "Encrypt the current region between START and END with symmetric cipher. + +If optional PASSPHRASE is not specified, it will be obtained from the +passphrase cache or user." + (let* ((passphrase (or passphrase + (when (not (pgg-gpg-use-agent-p)) + (pgg-read-passphrase + "GnuPG passphrase for symmetric encryption: ")))) + (args + (append (list "--batch" "--armor" "--symmetric" ) + (if pgg-text-mode (list "--textmode"))))) + (pgg-gpg-process-region start end passphrase pgg-gpg-program args) + (pgg-process-when-success))) (defun pgg-gpg-decrypt-region (start end &optional passphrase) - "Decrypt the current region between START and END." - (let* ((args '("--decrypt")) - (process (pgg-gpg-start-process args))) - (process-send-region process start end) - (pgg-gpg-wait-for-status process '("BEGIN_DECRYPTION")) - (pgg-gpg-wait-for-completion process) - (save-excursion - (set-buffer (get-buffer-create pgg-errors-buffer)) - (goto-char (point-max)) - (not (null (re-search-backward "^\\[GNUPG:] DECRYPTION_OKAY\\>" - nil t)))))) + "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* ((current-buffer (current-buffer)) + (message-keys (with-temp-buffer + (insert-buffer-substring current-buffer) + (pgg-decode-armor-region (point-min) (point-max)))) + (secret-keys (pgg-gpg-lookup-all-secret-keys)) + ;; XXX the user is stuck if they need to use the passphrase for + ;; any but the first secret key for which the message is + ;; encrypted. ideally, we would incrementally give them a + ;; chance with subsequent keys each time they fail with one. + (key (pgg-gpg-select-matching-key message-keys secret-keys)) + (key-owner (and key (pgg-gpg-lookup-key-owner key t))) + (key-id (pgg-gpg-key-id-from-key-owner key-owner)) + (pgg-gpg-user-id (or key-id key + pgg-gpg-user-id pgg-default-user-id)) + (passphrase (or passphrase + (when (not (pgg-gpg-use-agent-p)) + (pgg-read-passphrase + (format (if (pgg-gpg-symmetric-key-p message-keys) + "Passphrase for symmetric decryption: " + "GnuPG passphrase for %s: ") + (or key-owner "??")) + pgg-gpg-user-id)))) + (args '("--batch" "--decrypt"))) + (pgg-gpg-process-region start end passphrase pgg-gpg-program args) + (with-current-buffer pgg-errors-buffer + (pgg-gpg-possibly-cache-passphrase passphrase pgg-gpg-user-id) + (goto-char (point-min)) + (re-search-forward "^\\[GNUPG:] DECRYPTION_OKAY\\>" nil t)))) + +;;;###autoload +(defun pgg-gpg-symmetric-key-p (message-keys) + "True if decoded armor MESSAGE-KEYS has symmetric encryption indicator." + (let (result) + (dolist (key message-keys result) + (when (and (eq (car key) 3) + (member '(symmetric-key-algorithm) key)) + (setq result key))))) + +(defun pgg-gpg-select-matching-key (message-keys secret-keys) + "Choose a key from MESSAGE-KEYS that matches one of the keys in SECRET-KEYS." + (loop for message-key in message-keys + for message-key-id = (and (equal (car message-key) 1) + (cdr (assq 'key-identifier + (cdr message-key)))) + for key = (and message-key-id (pgg-lookup-key message-key-id 'encrypt)) + when (and key (member key secret-keys)) return key)) (defun pgg-gpg-sign-region (start end &optional cleartext passphrase) "Make detached signature from text between START and END." (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id)) + (passphrase (or passphrase + (when (not (pgg-gpg-use-agent-p)) + (pgg-read-passphrase + (format "GnuPG passphrase for %s: " + pgg-gpg-user-id) + pgg-gpg-user-id)))) (args (append (list (if cleartext "--clearsign" "--detach-sign") - "--armor" "--verbose" + "--armor" "--batch" "--verbose" "--local-user" pgg-gpg-user-id) - (if pgg-text-mode '("--textmode")))) - (process (pgg-gpg-start-process args))) - (unless pgg-gpg-use-agent - (pgg-gpg-wait-for-status process '("BEGIN_SIGNING" "GOOD_PASSPHRASE"))) - (process-send-region process start end) - (pgg-gpg-wait-for-completion process) - (save-excursion - (set-buffer (get-buffer-create pgg-errors-buffer)) - (goto-char (point-max)) - (not (null (re-search-backward "^\\[GNUPG:] SIG_CREATED\\>" - nil t)))))) + (if pgg-text-mode (list "--textmode")))) + (inhibit-read-only t) + buffer-read-only) + (pgg-gpg-process-region start end passphrase pgg-gpg-program args) + (with-current-buffer pgg-errors-buffer + ;; Possibly cache passphrase under, e.g. "jas", for future sign. + (pgg-gpg-possibly-cache-passphrase passphrase pgg-gpg-user-id) + ;; Possibly cache passphrase under, e.g. B565716F, for future decrypt. + (pgg-gpg-possibly-cache-passphrase passphrase)) + (pgg-process-when-success))) (defun pgg-gpg-verify-region (start end &optional signature) "Verify region between START and END as the detached signature SIGNATURE." - (let ((args '("--verify")) - process) + (let ((args '("--batch" "--verify"))) (when (stringp signature) (setq args (append args (list signature)))) - (setq process (pgg-gpg-start-process (append args '("-")))) - (process-send-region process start end) - (pgg-gpg-wait-for-completion process) - (save-excursion - (set-buffer (get-buffer-create pgg-errors-buffer)) - (goto-char (point-max)) - (not (null (re-search-backward "^\\[GNUPG:] GOODSIG\\>" - nil t)))))) + (setq args (append args '("-"))) + (pgg-gpg-process-region start end nil pgg-gpg-program args) + (with-current-buffer pgg-errors-buffer + (goto-char (point-min)) + (while (re-search-forward "^gpg: \\(.*\\)\n" nil t) + (with-current-buffer pgg-output-buffer + (insert-buffer-substring pgg-errors-buffer + (match-beginning 1) (match-end 0))) + (delete-region (match-beginning 0) (match-end 0))) + (goto-char (point-min)) + (re-search-forward "^\\[GNUPG:] GOODSIG\\>" nil t)))) (defun pgg-gpg-insert-key () "Insert public key at point." (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id)) - (args (list "--export" "--armor" - pgg-gpg-user-id)) - (process (pgg-gpg-start-process args))) - (pgg-gpg-wait-for-completion process) + (args (list "--batch" "--export" "--armor" + pgg-gpg-user-id))) + (pgg-gpg-process-region (point)(point) nil pgg-gpg-program args) (insert-buffer-substring pgg-output-buffer))) (defun pgg-gpg-snarf-keys-region (start end) "Add all public keys in region between START and END to the keyring." - (let* ((args '("--import" "-")) - (process (pgg-gpg-start-process args)) - status) - (process-send-region process start end) - (pgg-gpg-wait-for-completion process) - (save-excursion - (set-buffer (get-buffer-create pgg-errors-buffer)) - (goto-char (point-max)) - (not (null (re-search-backward "^\\[GNUPG:] IMPORT_RES\\>" - nil t)))))) + (let ((args '("--import" "--batch" "-")) status) + (pgg-gpg-process-region start end nil pgg-gpg-program args) + (set-buffer pgg-errors-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 (mapcar #'string-to-number (split-string status)))) + (erase-buffer) + (insert (format "Imported %d key(s). +\tArmor contains %d key(s) [%d bad, %d old].\n" + (+ (aref status 2) + (aref status 10)) + (aref status 0) + (aref status 1) + (+ (aref status 4) + (aref status 11))) + (if (zerop (aref status 9)) + "" + "\tSecret keys are imported.\n"))) + (append-to-buffer pgg-output-buffer (point-min)(point-max)) + (pgg-process-when-success))) + +(defun pgg-gpg-update-agent () + "Try to connet to gpg-agent and send UPDATESTARTUPTTY." + (if (fboundp 'make-network-process) + (let* ((agent-info (getenv "GPG_AGENT_INFO")) + (socket (and agent-info + (string-match "^\\([^:]*\\)" agent-info) + (match-string 1 agent-info))) + (conn (and socket + (make-network-process :name "gpg-agent-process" + :host 'local :family 'local + :service socket)))) + (when (and conn (eq (process-status conn) 'open)) + (process-send-string conn "UPDATESTARTUPTTY\n") + (delete-process conn) + t)) + ;; We can't check, so assume gpg-agent is up. + t)) + +(defun pgg-gpg-use-agent-p () + "Return t if `pgg-gpg-use-agent' is t and gpg-agent is available." + (and pgg-gpg-use-agent (pgg-gpg-update-agent))) (provide 'pgg-gpg) --=-=-= (I don't like to do it myself right now, because I'll be on vacation soon so I won't be able to fix problems.) Bye, Reiner. -- ,,, (o o) ---ooO-(_)-Ooo--- | PGP key available | http://rsteib.home.pages.de/ --=-=-=--