bug#471: pgg-gpg.el - pgg-gpg-process-region timing problem

[Thien-Thi Nguyen <ttn@gnuvola.org>]

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))))