X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=pgg-gpg.el;h=104dad0f5dc17b013cc11b83697e351981e69db6;hb=fff5c762e017a3919fdfedd93c7bf90f1adfc9a5;hp=873cff4a7c07119e4c858c49c49a4c8c056e36c3;hpb=bf7e08bd7cfe04654f724a049282365e3244d306;p=elisp%2Fsemi.git diff --git a/pgg-gpg.el b/pgg-gpg.el index 873cff4..104dad0 100644 --- a/pgg-gpg.el +++ b/pgg-gpg.el @@ -20,8 +20,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Code: @@ -48,6 +48,9 @@ (defvar pgg-gpg-user-id nil "GnuPG ID of your default identity.") +(defvar pgg-gpg-messages-locale pgg-messages-locale + "Locale set before running a GnuPG external process.") + (defvar pgg-scheme-gpg-instance nil) ;;;###autoload @@ -57,24 +60,29 @@ (luna-make-entity 'pgg-scheme-gpg)))) (defun pgg-gpg-process-region (start end passphrase program args) - (let* ((output-file-name - (concat temporary-file-directory (make-temp-name "pgg-output"))) + (let* ((output-file-name (make-temp-file + (expand-file-name "pgg-output" + temporary-file-directory))) (args `("--status-fd" "2" ,@(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)) (process-connection-type nil) + (process-environment process-environment) process status exit-status) + (when pgg-gpg-messages-locale + (setq process-environment (copy-sequence process-environment)) + (setenv "LC_ALL" pgg-gpg-messages-locale) + (setenv "LANGUAGE" pgg-gpg-messages-locale)) (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)) (setq process (apply #'start-process "*GnuPG*" errors-buffer @@ -103,8 +111,7 @@ (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)))) + (delete-file output-file-name))))) (defun pgg-gpg-possibly-cache-passphrase (passphrase) (if (and pgg-cache-passphrase @@ -127,16 +134,14 @@ (with-temp-buffer (apply #'call-process pgg-gpg-program nil t nil args) (goto-char (point-min)) - (if (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 (match-string 2) 8))))) (luna-define-method pgg-scheme-encrypt-region ((scheme pgg-scheme-gpg) start end recipients) - (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id)) + (let* ((user-id (or pgg-overriding-user-id pgg-gpg-user-id + pgg-default-user-id)) (args `("--batch" "--armor" "--always-trust" "--encrypt" ,@(if recipients @@ -145,18 +150,19 @@ (list "--remote-user" rcpt)) (append recipients (if pgg-encrypt-for-me - (list pgg-gpg-user-id))))))))) + (list user-id))))))))) (pgg-as-lbt start end 'CRLF (pgg-gpg-process-region start end nil pgg-gpg-program args)) (pgg-process-when-success))) (luna-define-method pgg-scheme-decrypt-region ((scheme pgg-scheme-gpg) start end) - (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id)) + (let* ((user-id (or pgg-overriding-user-id pgg-gpg-user-id + pgg-default-user-id)) (passphrase (pgg-read-passphrase (format "GnuPG passphrase for %s: " pgg-gpg-user-id) - (pgg-scheme-lookup-key scheme pgg-gpg-user-id 'encrypt))) + (pgg-scheme-lookup-key scheme user-id 'encrypt))) (args '("--batch" "--decrypt"))) (pgg-gpg-process-region start end passphrase pgg-gpg-program args) (with-current-buffer pgg-errors-buffer @@ -166,15 +172,16 @@ (luna-define-method pgg-scheme-sign-region ((scheme pgg-scheme-gpg) start end &optional cleartext) - (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id)) + (let* ((user-id (or pgg-overriding-user-id pgg-gpg-user-id + pgg-default-user-id)) (passphrase (pgg-read-passphrase - (format "GnuPG passphrase for %s: " pgg-gpg-user-id) - (pgg-scheme-lookup-key scheme pgg-gpg-user-id 'sign))) + (format "GnuPG passphrase for %s: " user-id) + (pgg-scheme-lookup-key scheme user-id 'sign))) (args (list (if cleartext "--clearsign" "--detach-sign") "--armor" "--batch" "--verbose" - "--local-user" pgg-gpg-user-id)) + "--local-user" user-id)) (inhibit-read-only t) buffer-read-only) (pgg-as-lbt start end 'CRLF @@ -197,14 +204,17 @@ (goto-char (point-min)) (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))))) + (delete-matching-lines "^\\[GNUPG:] ") + ;; XXX: copy contents of pgg-errors-buffer into + ;; pgg-output-buffer for backward compatibility. + (with-current-buffer pgg-output-buffer + (set-buffer-multibyte t) + (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)) - (args (list "--batch" "--export" "--armor" - pgg-gpg-user-id))) + (let* ((user-id (or pgg-overriding-user-id pgg-gpg-user-id + pgg-default-user-id)) + (args (list "--batch" "--export" "--armor" user-id))) (pgg-gpg-process-region (point)(point) nil pgg-gpg-program args) (insert-buffer-substring pgg-output-buffer))) @@ -229,9 +239,13 @@ (aref status 11))) (if (zerop (aref status 9)) "" - "\tSecret keys are imported.\n"))) - (append-to-buffer pgg-output-buffer (point-min)(point-max)) - (pgg-process-when-success))) + "\tSecret keys are imported.\n")) + ;; XXX: copy contents of pgg-errors-buffer into + ;; pgg-output-buffer for backward compatibility. + (with-current-buffer pgg-output-buffer + (set-buffer-multibyte t) + (insert-buffer-substring pgg-errors-buffer)) + t))) (provide 'pgg-gpg)