Re: pgg-gpg.el - pgg-gpg-process-region timing problem

[Thien-Thi Nguyen]

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