X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=pgg-gpg.el;h=b47501683e73a3d9d19d55b08172fe87b36e1ec6;hb=93e111fd538a46e30073c2d2d8f8fcfc4ac1aea4;hp=62b2483dc15a0fda373082e4f8b8b748f56e0453;hpb=d19acb5115b1b81b7a157e25799465a973b31da3;p=elisp%2Fsemi.git diff --git a/pgg-gpg.el b/pgg-gpg.el index 62b2483..b475016 100644 --- a/pgg-gpg.el +++ b/pgg-gpg.el @@ -2,7 +2,7 @@ ;; Copyright (C) 1999,2000 Daiki Ueno -;; Author: Daiki Ueno +;; Author: Daiki Ueno ;; Created: 1999/10/28 ;; Keywords: PGP, OpenPGP, GnuPG @@ -31,22 +31,11 @@ "GnuPG interface" :group 'pgg) -(defcustom pgg-gpg-program "gpg" +(defcustom pgg-gpg-program "gpg" "The GnuPG executable." :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,84 +56,80 @@ 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" - ,@(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) + `("--status-fd" "2" + ,@(if passphrase '("--passphrase-fd" "0")) + "--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)) - (as-binary-process - (setq process - (apply #'start-process-shell-command "*GnuPG*" output-buffer - program args))) - (set-process-sentinel process #'ignore) - (when passphrase - (process-send-string process (concat passphrase "\n"))) - (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 output-buffer - (pgg-convert-lbt-region (point-min)(point-max) 'LF) - - (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) - (delete-file errors-file-name) - - (set-buffer (get-buffer-create status-buffer)) - (buffer-disable-undo) - (erase-buffer) - (insert-file-contents status-file-name) - (delete-file status-file-name) - + (unwind-protect + (progn + (set-default-file-modes 448) + (as-binary-process + (setq process + (apply #'start-process "*GnuPG*" errors-buffer program args))) + (set-process-sentinel process #'ignore) + (when passphrase + (process-send-string process (concat passphrase "\n"))) + (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) + (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)))) (if (and process (eq 'run (process-status process))) - (interrupt-process process))))) + (interrupt-process process)) + (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) @@ -152,17 +137,15 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." (args `("--batch" "--armor" "--always-trust" "--encrypt" ,@(if recipients - (apply #'append + (apply #'nconc (mapcar (lambda (rcpt) - (list "--remote-user" - (concat "\"" rcpt "\""))) + (list "--remote-user" rcpt)) (append recipients (if pgg-encrypt-for-me (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) @@ -173,7 +156,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) @@ -190,18 +176,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) @@ -209,24 +186,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)) @@ -239,14 +208,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" @@ -259,9 +226,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)