]> code.delx.au - gnu-emacs/blobdiff - lisp/pgg-gpg.el
(calendar-dst-check-each-year-flag): Avoid
[gnu-emacs] / lisp / pgg-gpg.el
index eefc569fd047f74ce718b32881a4d0a798509c0d..4b8b79b068e86370c66602bd7c10d1a42c42a345 100644 (file)
         (errors-buffer pgg-errors-buffer)
         (orig-mode (default-file-modes))
         (process-connection-type nil)
-        exit-status)
+        (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)
-         (let ((coding-system-for-write 'binary)
-               (input (buffer-substring-no-properties start end))
-               (default-enable-multibyte-characters nil))
-           (with-temp-buffer
-             (when passphrase
-               (insert passphrase "\n"))
-             (insert input)
-             (setq exit-status
-                   (apply #'call-process-region (point-min) (point-max) program
-                          nil errors-buffer nil args))))
+         (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
+                                             pgg-passphrase-coding-system))
+                 (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)
                                                'binary)))
                  (insert-file-contents output-file-name)))
            (set-buffer errors-buffer)
-           (if (not (equal exit-status 0))
-               (insert (format "\n%s exited abnormally: '%s'\n"
-                               program exit-status)))))
+           (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))))
@@ -358,18 +381,21 @@ passphrase cache or user."
 
 (defun pgg-gpg-update-agent ()
   "Try to connet to gpg-agent and send UPDATESTARTUPTTY."
-  (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)))
+  (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."