* pgg-gpg.el: Fix author's mailing address.
authorueno <ueno>
Thu, 13 Apr 2000 01:42:04 +0000 (01:42 +0000)
committerueno <ueno>
Thu, 13 Apr 2000 01:42:04 +0000 (01:42 +0000)
(pgg-gpg-process-region): Add --output option; set status fd to 2.
(pgg-gpg-possibly-cache-passphrase): New function.
(pgg-gpg-shell-file-name): Abolish.
(pgg-gpg-shell-command-switch): Abolish.
(pgg-scheme-lookup-key): Work on temp buffer.

ChangeLog
pgg-gpg.el

index 6c40469..426d773 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2000-04-13   Daiki Ueno  <ueno@unixuser.org>
+
+       * pgg-gpg.el: Fix author's mailing address.
+       (pgg-gpg-process-region): Add --output option; set status fd to 2.
+       (pgg-gpg-possibly-cache-passphrase): New function.
+       (pgg-gpg-shell-file-name): Abolish.
+       (pgg-gpg-shell-command-switch): Abolish.
+       (pgg-scheme-lookup-key): Work on temp buffer.
+
 2000-03-01  Yoshiki Hayashi <yoshiki@xemacs.org>
 
        * mime-image.el (mime-display-image): Don't wait for redisplay.
index 0a715db..154263c 100644 (file)
@@ -2,7 +2,7 @@
 
 ;; Copyright (C) 1999,2000 Daiki Ueno
 
-;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; Author: Daiki Ueno <ueno@unixuser.org>
 ;; Created: 1999/10/28
 ;; Keywords: PGP, OpenPGP, GnuPG
 
   :group 'pgg-gpg
   :type 'string)
 
-(defcustom pgg-gpg-shell-file-name "/bin/sh"
-  "File name to load inferior shells from.
-Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
-  :group 'pgg-gpg
-  :type 'string)
-
-(defcustom pgg-gpg-shell-command-switch "-c"
-  "Switch used to have the shell execute its command line argument."
-  :group 'pgg-gpg
-  :type 'string)
-
 (defcustom pgg-gpg-extra-args nil
   "Extra arguments for every GnuPG invocation."
   :group 'pgg-gpg
@@ -67,36 +56,28 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
            (luna-make-entity 'pgg-scheme-gpg))))
 
 (defun pgg-gpg-process-region (start end passphrase program args)
-  (let* ((errors-file-name
-         (concat temporary-file-directory
-                 (make-temp-name "pgg-errors")))
-        (status-file-name
-         (concat temporary-file-directory
-                 (make-temp-name "pgg-status")))
+  (let* ((output-file-name
+         (concat temporary-file-directory (make-temp-name "pgg-output")))
         (args
-         (append
-          `("--status-fd" "3"
+         (nconc
+          `("--status-fd" "2"
             ,@(if passphrase '("--passphrase-fd" "0"))
-            ,@pgg-gpg-extra-args)
-          args
-          (list (concat "2>" errors-file-name)
-                (concat "3>" status-file-name))))
-        (shell-file-name pgg-gpg-shell-file-name)
-        (shell-command-switch pgg-gpg-shell-command-switch)
+            "--output" ,output-file-name ,@pgg-gpg-extra-args)
+          args))
         (output-buffer pgg-output-buffer)
         (errors-buffer pgg-errors-buffer)
-        (status-buffer pgg-status-buffer)
+        (orig-mode (default-file-modes))
         (process-connection-type nil)
         process status exit-status)
-    (with-current-buffer (get-buffer-create output-buffer)
+    (with-current-buffer (get-buffer-create errors-buffer)
       (buffer-disable-undo)
       (erase-buffer))
     (unwind-protect
        (progn
+         (set-default-file-modes 448)
          (as-binary-process
           (setq process
-                (apply #'start-process-shell-command "*GnuPG*" output-buffer
-                       program args)))
+                (apply #'start-process "*GnuPG*" errors-buffer program args)))
          (set-process-sentinel process #'ignore)
          (when passphrase
            (process-send-string process (concat passphrase "\n")))
@@ -107,48 +88,49 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
          (setq status (process-status process)
                exit-status (process-exit-status process))
          (delete-process process)
-         (with-current-buffer output-buffer
-           (pgg-convert-lbt-region (point-min)(point-max) 'LF)
-
+         (with-current-buffer (get-buffer-create output-buffer)
+           (buffer-disable-undo)
+           (erase-buffer)
+           (if (file-exists-p output-file-name)
+               (insert-file-contents-as-raw-text-CRLF 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))
-
-           (set-buffer (get-buffer-create errors-buffer))
-           (buffer-disable-undo)
-           (erase-buffer)
-           (insert-file-contents errors-file-name)
-      
-           (set-buffer (get-buffer-create status-buffer))
-           (buffer-disable-undo)
-           (erase-buffer)
-           (insert-file-contents status-file-name)))
+               (error "%s could not be found" program))))
       (if (and process (eq 'run (process-status process)))
          (interrupt-process process))
-      (condition-case nil
-         (progn
-           (delete-file status-file-name)
-           (delete-file errors-file-name))
-       (file-error nil)))))
+      (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)
+  (if (and pgg-cache-passphrase
+          (progn
+            (goto-char (point-min))
+            (re-search-forward "^\\[GNUPG:] GOOD_PASSPHRASE\\>" nil t)))
+      (pgg-add-passphrase-cache
+       (progn
+        (goto-char (point-min))
+        (if (re-search-forward
+             "^\\[GNUPG:] NEED_PASSPHRASE \\w+ ?\\w*" nil t)
+            (substring (match-string 0) -8)))
+       passphrase)))
 
 (luna-define-method pgg-scheme-lookup-key ((scheme pgg-scheme-gpg)
                                           string &optional type)
   (let ((args (list "--with-colons" "--no-greeting" "--batch"
                    (if type "--list-secret-keys" "--list-keys")
                    string)))
-    (with-current-buffer (get-buffer-create pgg-output-buffer)
-      (buffer-disable-undo)
-      (erase-buffer)
+    (with-temp-buffer
       (apply #'call-process pgg-gpg-program nil t nil args)
       (goto-char (point-min))
-      (when (re-search-forward "^\\(sec\\|pub\\):"  nil t)
-       (substring
-        (nth 3 (split-string
-                (buffer-substring (match-end 0)
-                                  (progn (end-of-line)(point)))
-                ":"))
-        8)))))
+      (if (re-search-forward "^\\(sec\\|pub\\):"  nil t)
+         (substring
+          (nth 3 (split-string
+                  (buffer-substring (match-end 0)
+                                    (progn (end-of-line)(point)))
+                  ":")) 8)))))
 
 (luna-define-method pgg-scheme-encrypt-region ((scheme pgg-scheme-gpg)
                                               start end recipients)
@@ -165,8 +147,7 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
                                             (list pgg-gpg-user-id)))))))))
     (pgg-as-lbt start end 'CRLF
       (pgg-gpg-process-region start end nil pgg-gpg-program args))
-    (pgg-process-when-success
-      (pgg-convert-lbt-region (point-min)(point-max) 'LF))))
+    (pgg-process-when-success)))
 
 (luna-define-method pgg-scheme-decrypt-region ((scheme pgg-scheme-gpg)
                                               start end)
@@ -177,7 +158,10 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
           (pgg-scheme-lookup-key scheme pgg-gpg-user-id 'encrypt)))
         (args '("--batch" "--decrypt")))
     (pgg-gpg-process-region start end passphrase pgg-gpg-program args)
-    (pgg-process-when-success nil)))
+    (with-current-buffer pgg-errors-buffer
+      (pgg-gpg-possibly-cache-passphrase passphrase)
+      (goto-char (point-min))
+      (re-search-forward "^\\[GNUPG:] DECRYPTION_OKAY\\>" nil t))))
 
 (luna-define-method pgg-scheme-sign-region ((scheme pgg-scheme-gpg)
                                            start end &optional cleartext)
@@ -194,18 +178,9 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
         buffer-read-only)
     (pgg-as-lbt start end 'CRLF
       (pgg-gpg-process-region start end passphrase pgg-gpg-program args))
-    (pgg-process-when-success
-      (pgg-convert-lbt-region (point-min)(point-max) 'LF)
-      (when (re-search-forward "^-+BEGIN PGP SIGNATURE" nil t);XXX
-       (let ((packet
-              (cdr (assq 2 (pgg-parse-armor-region
-                            (progn (beginning-of-line 2)
-                                   (point))
-                            (point-max))))))
-         (if pgg-cache-passphrase
-             (pgg-add-passphrase-cache
-              (cdr (assq 'key-identifier packet))
-              passphrase)))))))
+    (with-current-buffer pgg-errors-buffer
+      (pgg-gpg-possibly-cache-passphrase passphrase))
+    (pgg-process-when-success)))
 
 (luna-define-method pgg-scheme-verify-region ((scheme pgg-scheme-gpg)
                                              start end &optional signature)
@@ -213,24 +188,16 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
     (when (stringp signature)
       (setq args (append args (list signature))))
     (pgg-gpg-process-region start end nil pgg-gpg-program args)
-    (save-excursion
-      (set-buffer pgg-errors-buffer)
+    (with-current-buffer pgg-errors-buffer
       (goto-char (point-min))
       (while (re-search-forward "^gpg: " nil t)
        (replace-match ""))
       (goto-char (point-min))
-      (let ((case-fold-search t))
-       (while (re-search-forward "^warning: " nil t)
-         (delete-region (match-beginning 0)
-                        (progn (beginning-of-line 2) (point)))))
-      (set-buffer pgg-status-buffer)
-      (goto-char (point-min))
-      (if (re-search-forward "^\\[GNUPG:] +GOODSIG +" nil t)
-         (progn
-           (set-buffer pgg-output-buffer)
-           (insert-buffer-substring pgg-errors-buffer)
-           t)
-       nil))))
+      (prog1 (re-search-forward "^\\[GNUPG:] GOODSIG\\>" nil t)
+       (goto-char (point-min))
+       (delete-matching-lines "^warning\\|\\[GNUPG:]")
+       (set-buffer pgg-output-buffer)
+       (insert-buffer-substring pgg-errors-buffer)))))
 
 (luna-define-method pgg-scheme-insert-key ((scheme pgg-scheme-gpg))
   (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
@@ -243,14 +210,12 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
                                                  start end)
   (let ((args '("--import" "--batch" "-")) status)
     (pgg-gpg-process-region start end nil pgg-gpg-program args)
-    (set-buffer pgg-status-buffer)
+    (set-buffer pgg-errors-buffer)
     (goto-char (point-min))
-    (when (re-search-forward "^\\[GNUPG:] +IMPORT_RES +" nil t)
+    (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-int
-                                   (split-string status))))
+                                    (progn (end-of-line)(point)))
+           status (vconcat (mapcar #'string-to-int (split-string status))))
       (erase-buffer)
       (insert (format "Imported %d key(s).
 \tArmor contains %d key(s) [%d bad, %d old].\n"
@@ -263,9 +228,8 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
              (if (zerop (aref status 9))
                  ""
                "\tSecret keys are imported.\n")))
-    (append-to-buffer pgg-output-buffer
-                     (point-min)(point-max))
-    (pgg-process-when-success nil)))
+    (append-to-buffer pgg-output-buffer (point-min)(point-max))
+    (pgg-process-when-success)))
 
 (provide 'pgg-gpg)