X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=pgg-pgp.el;h=28e48cb925601d9b00a8a174ff33087f15cfba4d;hb=7ee365ea5c860b4f375939347c91dc2836d39843;hp=1b6f29818dfdafb6b70cc2a4e294a557d003a9f7;hpb=64a3c8ec4fac33a768ffdea0e4003ed1e1004875;p=elisp%2Fsemi.git diff --git a/pgg-pgp.el b/pgg-pgp.el index 1b6f298..28e48cb 100644 --- a/pgg-pgp.el +++ b/pgg-pgp.el @@ -37,7 +37,13 @@ :type 'string) (defcustom pgg-pgp-shell-file-name "/bin/sh" - "The GnuPG executable." + "File name to load inferior shells from. Bourne shell or its equivalent +\(not tcsh) is needed for \"2>\"." + :group 'pgg-pgp + :type 'string) + +(defcustom pgg-pgp-shell-command-switch "-c" + "Switch used to have the shell execute its command line argument." :group 'pgg-pgp :type 'string) @@ -70,6 +76,7 @@ pgg-pgp-extra-args (list (concat "2>" errors-file-name)))) (shell-file-name pgg-pgp-shell-file-name) + (shell-command-switch pgg-pgp-shell-command-switch) (output-buffer pgg-output-buffer) (errors-buffer pgg-errors-buffer) (process-connection-type nil) @@ -77,12 +84,14 @@ (with-current-buffer (get-buffer-create output-buffer) (buffer-disable-undo) (erase-buffer)) - (setq process - (apply #'start-process-shell-command "*PGP*" output-buffer - program args)) + (when passphrase + (setenv "PGPPASSFD" "0")) + (as-binary-process + (setq process + (apply #'start-process-shell-command "*PGP*" output-buffer + program args))) (set-process-sentinel process 'ignore) (when passphrase - (setenv "PGPPASSFD" "0") (process-send-string process (concat passphrase "\n"))) (process-send-region process start end) (process-send-eof process) @@ -92,9 +101,8 @@ exit-status (process-exit-status process)) (delete-process process) (with-current-buffer output-buffer - (goto-char (point-min)) - (while (search-forward "\r$" nil t) - (replace-match "")) + (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) @@ -114,9 +122,10 @@ (luna-define-method lookup-key-string ((scheme pgg-scheme-pgp) string &optional type) (let ((args (list "+batchmode" "+language=en" "-kv" string))) - (pgg-pgp-process-region (point)(point) nil - pgg-pgp-program args) - (with-current-buffer pgg-output-buffer + (with-current-buffer (get-buffer-create pgg-output-buffer) + (buffer-disable-undo) + (erase-buffer) + (apply #'call-process pgg-pgp-program nil t args) (goto-char (point-min)) (cond ((re-search-forward "^pub\\s +[0-9]+/" nil t);PGP 2.* @@ -134,28 +143,18 @@ (luna-define-method encrypt-region ((scheme pgg-scheme-pgp) start end recipients) (let* ((pgg-pgp-user-id pgg-default-user-id) - (passphrase - (pgg-read-passphrase - (format "PGP passphrase for %s: " pgg-pgp-user-id) - (luna-send scheme 'lookup-key-string - scheme pgg-pgp-user-id 'encrypt))) (args `("+encrypttoself=off +verbose=1" "+batchmode" "+language=us" "-fate" ,@(if recipients (mapcar (lambda (rcpt) (concat "\"" rcpt "\"")) - recipients))))) - (pgg-pgp-process-region start end passphrase + (append recipients + (if pgg-encrypt-for-me + (list pgg-pgp-user-id)))))) + )) + (pgg-pgp-process-region start end nil pgg-pgp-program args) - (with-current-buffer pgg-output-buffer - (if (zerop (buffer-size)) - (insert-buffer-substring pgg-errors-buffer) - (let ((packet - (cdr (assq 1 (pgg-parse-armor-region - (point-min)(point-max)))))) - (pgg-add-passphrase-cache - (cdr (assq 'key-identifier packet)) - passphrase)))) + (pgg-process-when-success nil) )) (luna-define-method decrypt-region ((scheme pgg-scheme-pgp) @@ -170,13 +169,11 @@ '("+verbose=1" "+batchmode" "+language=us" "-f"))) (pgg-pgp-process-region start end passphrase pgg-pgp-program args) - (with-current-buffer pgg-output-buffer - (when (zerop (buffer-size)) - (insert-buffer-substring pgg-errors-buffer))) + (pgg-process-when-success nil) )) (luna-define-method sign-region ((scheme pgg-scheme-pgp) - start end) + start end &optional clearsign) (let* ((pgg-pgp-user-id pgg-default-user-id) (passphrase (pgg-read-passphrase @@ -184,16 +181,19 @@ (luna-send scheme 'lookup-key-string scheme pgg-pgp-user-id 'sign))) (args - (list "-fbast" "+verbose=1" "+language=us" "+batchmode" + (list (if clearsign "-fast" "-fbast") + "+verbose=1" "+language=us" "+batchmode" "-u" pgg-pgp-user-id))) (pgg-pgp-process-region start end passphrase - pgg-pgp-program args) - (with-current-buffer pgg-output-buffer - (if (zerop (buffer-size)) - (insert-buffer-substring pgg-errors-buffer) + pgg-pgp-program args) + (pgg-process-when-success + (goto-char (point-min)) + (when (re-search-forward "^-+BEGIN PGP" nil t);XXX (let ((packet (cdr (assq 2 (pgg-parse-armor-region - (point-min)(point-max)))))) + (progn (beginning-of-line 2) + (point)) + (point-max)))))) (pgg-add-passphrase-cache (cdr (assq 'key-identifier packet)) passphrase)))) @@ -212,11 +212,18 @@ (pgg-pgp-process-region (point-min)(point-max) nil pgg-pgp-program args) (delete-file orig-file) - (delete-file signature) - (set-buffer pgg-output-buffer) - (with-current-buffer pgg-output-buffer - (when (zerop (buffer-size)) - (insert-buffer-substring pgg-errors-buffer))) + (if signature (delete-file signature)) + (pgg-process-when-success + (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))))) + (goto-char (point-min)) + (when (re-search-forward "^\\.$" nil t) + (delete-region (point-min) + (progn (beginning-of-line 2) + (point))))) )) (luna-define-method insert-key ((scheme pgg-scheme-pgp)) @@ -241,6 +248,7 @@ (pgg-pgp-process-region start end nil pgg-pgp-program args) (delete-file key-file) + (pgg-process-when-success nil) )) (provide 'pgg-pgp)