From: hayashi Date: Thu, 13 Apr 2000 05:32:01 +0000 (+0000) Subject: Incorporate pgg-gpg.el changes from EMIKO. X-Git-Tag: emy-1_13_5~2 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=efda8de99fbd1e820ef02535d8efcc40fb77724c;p=elisp%2Fsemi.git Incorporate pgg-gpg.el changes from EMIKO. --- diff --git a/pgg-gpg.el b/pgg-gpg.el index 0a715db..154263c 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 @@ -36,17 +36,6 @@ :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)