GNU bug report logs - #471
pgg-gpg.el - pgg-gpg-process-region timing problem

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 471 in the body.
You can then email your comments to 471 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> emacsbugs.donarmstrong.com (full text, mbox):

From: Thien-Thi Nguyen <ttn <at> gnuvola.org>
To: "ken manheimer" <ken.manheimer <at> gmail.com>
Cc: wilde <at> sha-bang.de, emacs-pretest-bug <at> gnu.org, ueno <at> unixuser.org,
        emacs-devel <emacs-devel <at> gnu.org>
Subject: Re: pgg-gpg.el - pgg-gpg-process-region timing problem
Date: Mon, 23 Jun 2008 15:17:39 +0200

Delving into this, i got a little carried away... full func below.
This adds GOOD_PASSPHRASE checking (necessary for GNUPG 1.4.6, at
least) and some other coding-system related finessing, but removes
the sentinel proposed in the first attempt.  In its place, we zonk
the baleful `process-adaptive-read-buffering' and remove timeout
parameters from `accept-process-output' calls.

With this func things seem to work fine for `pgg-sign' on a small
buffer, and mostly for large buffers (270KB), but sometimes (~10%)
with large buffers, i see a "file error: bad address *GnuPG*".  Hmmm...

thi

______________________________________________________________________
(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
	  `("--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))
	 (inhibit-redisplay t))
    (with-current-buffer (get-buffer-create errors-buffer)
      (buffer-disable-undo)
      (erase-buffer))
    (unwind-protect
	(let* ((coding-system-for-write 'binary)
	       ;; GNUPG 1.4.6 does not terminate on bad passphrase, eg:
	       ;;   [GNUPG:] BAD_PASSPHRASE (long hex # here)
	       ;;   gpg: skipped "ttn": bad passphrase
	       ;;   gpg: [stdin]: clearsign failed: bad passphrase
	       ;; so we need to check that condition ourselves and bail out.
	       ;;
	       ;; To check if the passphrase is accepted, we need to parse the
	       ;; errors-buffer, but `process-adaptive-read-buffering' non-nil
	       ;; sometimes prevents it from filling.  So turn it off.
	       (process-adaptive-read-buffering (not passphrase))
	       (process (progn
			  (set-default-file-modes 448)
			  (apply #'start-process "*GnuPG*"
				 errors-buffer program args)))
	       (status (process-status process))

	       exit-status)
	  (set-process-sentinel process nil)
	  (when passphrase
	    (let ((coding-system-for-write (or pgg-passphrase-coding-system
					       'binary)))
	      (process-send-string process passphrase))
	    (process-send-string process "\n")
	    ;; Bail out if passphrase is not accepted.
	    ;; MAINTAIN ME: Tested against GNUPG 1.4.6.
	    (let (result)
	      (while (not result)
		(accept-process-output process)
		(with-current-buffer errors-buffer
		  (save-excursion
		    (goto-char (point-min))
		    (when (re-search-forward
			   ;; BGM: BAD, GOOD, MISSING.
			   "^.GNUPG:. \\([BGM][A-Z]+\\)_PASSPHRASE"
			   nil t)
		      (setq result (match-string 1))))))
	      (unless (string= "GOOD" result)
		(error "Passphrase no good"))))
	  (process-send-region process start end)
	  (process-send-eof process)
	  ;; TODO: Re-enable `process-adaptive-read-buffering' here.
	  (while (eq 'run (setq status (process-status process)))
	    (accept-process-output process))
	  (delete-process process)
	  (setq exit-status (process-exit-status 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)))
	    (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 (file-exists-p output-file-name)
	  (delete-file output-file-name))
      (when (get-process "*GnuPG*")
	(kill-process "*GnuPG*"))
      (set-default-file-modes orig-mode))))

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.