;;; pgg-gpg.el --- GnuPG support for PGG.
-;; Copyright (C) 1999, 2000, 2003 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
+;; 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Symmetric encryption support added by: Sascha Wilde <wilde@sha-bang.de>
;; Created: 1999/10/28
;; Keywords: PGP, OpenPGP, GnuPG
;; 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:
-(eval-when-compile (require 'pgg))
+(eval-when-compile
+ (require 'pgg))
(defgroup pgg-gpg ()
- "GnuPG interface"
+ "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-extra-args nil
"Extra arguments for every GnuPG invocation."
:group 'pgg-gpg
- :type '(choice
- (const :tag "None" nil)
- (string :tag "Arguments")))
+ :type '(repeat (string :tag "Argument")))
+
+(defcustom pgg-gpg-recipient-argument "--recipient"
+ "GnuPG option to specify recipient."
+ :group 'pgg-gpg
+ :type '(choice (const :tag "New `--recipient' option" "--recipient")
+ (const :tag "Old `--remote-user' option" "--remote-user")))
+
+(defcustom pgg-gpg-use-agent t
+ "Whether to use gnupg agent for key caching."
+ :group 'pgg-gpg
+ :type 'boolean)
(defvar pgg-gpg-user-id nil
"GnuPG ID of your default identity.")
-(defun pgg-gpg-process-region (start end passphrase program args)
- (let* ((output-file-name
- (expand-file-name (make-temp-name "pgg-output")
- pgg-temporary-file-directory))
+(defvar pgg-gpg-user-id-alist nil
+ "An alist mapping from key ID to user ID.")
+
+(defvar pgg-gpg-read-point nil)
+(defvar pgg-gpg-output-file-name nil)
+(defvar pgg-gpg-pending-status-list nil)
+(defvar pgg-gpg-key-id nil)
+(defvar pgg-gpg-passphrase nil)
+(defvar pgg-gpg-debug nil)
+
+(defun pgg-gpg-start-process (args)
+ (let* ((output-file-name (pgg-make-temp-file "pgg-output"))
(args
- `("--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)
- (orig-mode (default-file-modes))
+ (append (list "--no-tty"
+ "--status-fd" "1"
+ "--command-fd" "0"
+ "--yes" ; overwrite
+ "--output" output-file-name)
+ (if pgg-gpg-use-agent '("--use-agent"))
+ pgg-gpg-extra-args
+ args))
+ (coding-system-for-write 'binary)
(process-connection-type nil)
- exit-status)
- (with-current-buffer (get-buffer-create errors-buffer)
- (buffer-disable-undo)
- (erase-buffer))
+ (orig-mode (default-file-modes))
+ (buffer (generate-new-buffer " *pgg-gpg*"))
+ process)
+ (with-current-buffer buffer
+ (make-local-variable 'pgg-gpg-read-point)
+ (setq pgg-gpg-read-point (point-min))
+ (make-local-variable 'pgg-gpg-output-file-name)
+ (setq pgg-gpg-output-file-name output-file-name)
+ (make-local-variable 'pgg-gpg-pending-status-list)
+ (setq pgg-gpg-pending-status-list nil)
+ (make-local-variable 'pgg-gpg-key-id)
+ (setq pgg-gpg-key-id nil)
+ (make-local-variable 'pgg-gpg-passphrase)
+ (setq pgg-gpg-passphrase nil))
(unwind-protect
(progn
(set-default-file-modes 448)
- (let* ((coding-system-for-write 'binary)
- (input (buffer-substring-no-properties start end)))
- (with-temp-buffer
- (when passphrase
- (insert passphrase "\n"))
- (insert input)
- (setq exit-status
- (apply #'call-process-region (point-min) (point-max) program
- nil errors-buffer nil args))))
- (with-current-buffer (get-buffer-create output-buffer)
- (buffer-disable-undo)
- (erase-buffer)
- (if (file-exists-p output-file-name)
- (let ((coding-system-for-read 'raw-text-dos))
- (insert-file-contents output-file-name)))
- (set-buffer errors-buffer)
- (if (not (equal exit-status 0))
- (insert (format "\n%s exited abnormally: '%s'\n"
- program exit-status)))))
- (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)))
+ (setq process
+ (apply #'start-process "pgg-gpg" buffer pgg-gpg-program args)))
+ (set-default-file-modes orig-mode))
+ (set-process-filter process #'pgg-gpg-process-filter)
+ (set-process-sentinel process #'pgg-gpg-process-sentinel)
+ process))
+
+(defun pgg-gpg-process-filter (process input)
+ (if pgg-gpg-debug
+ (save-excursion
+ (set-buffer (get-buffer-create " *pgg-gpg-debug*"))
+ (goto-char (point-max))
+ (insert input)))
+ (if (buffer-live-p (process-buffer process))
+ (save-excursion
+ (set-buffer (process-buffer process))
+ (goto-char (point-max))
+ (insert input)
+ (goto-char pgg-gpg-read-point)
+ (beginning-of-line)
+ (while (looking-at ".*\n") ;the input line is finished
+ (save-excursion
+ (if (looking-at "\\[GNUPG:] \\([A-Z_]+\\)\\>.*")
+ (let* ((status (match-string 1))
+ (symbol (intern-soft (concat "pgg-gpg-status-"
+ status))))
+ (if (member status pgg-gpg-pending-status-list)
+ (setq pgg-gpg-pending-status-list nil))
+ (if (and symbol
+ (fboundp symbol))
+ (funcall symbol process (buffer-substring
+ (match-beginning 1)
+ (match-end 0)))))))
+ (forward-line))
+ (setq pgg-gpg-read-point (point)))))
+
+(defun pgg-gpg-process-sentinel (process status)
+ (if (buffer-live-p (process-buffer process))
+ (save-excursion
+ (set-buffer (process-buffer process))
+ (when pgg-gpg-passphrase
+ (fillarray pgg-gpg-passphrase 0)
+ (setq pgg-gpg-passphrase nil))
+ ;; Copy the contents of process-buffer to pgg-errors-buffer.
+ (set-buffer (get-buffer-create pgg-errors-buffer))
+ (buffer-disable-undo)
+ (erase-buffer)
+ (insert-buffer-substring (process-buffer process))
+ ;; Read the contents of the output file to pgg-output-buffer.
+ (set-buffer (get-buffer-create pgg-output-buffer))
+ (buffer-disable-undo)
+ (erase-buffer)
+ (if (equal status "finished\n")
+ (let ((output-file-name
+ (with-current-buffer (process-buffer process)
+ pgg-gpg-output-file-name)))
+ (when (file-exists-p output-file-name)
+ (let ((coding-system-for-read (if pgg-text-mode
+ 'raw-text
+ 'binary)))
+ (insert-file-contents output-file-name))
+ (delete-file output-file-name))))
+ (kill-buffer (process-buffer process)))))
+
+(defun pgg-gpg-wait-for-status (process status-list)
+ (with-current-buffer (process-buffer process)
+ (setq pgg-gpg-pending-status-list status-list)
+ (while (and (eq (process-status process) 'run)
+ pgg-gpg-pending-status-list)
+ (accept-process-output process 1))))
+
+(defun pgg-gpg-wait-for-completion (process)
+ (process-send-eof process)
+ (while (eq (process-status process) 'run)
+ ;; We can't use accept-process-output instead of sit-for here
+ ;; because it may cause an interrupt during the sentinel execution.
+ (sit-for 0.1)))
+
+(defun pgg-gpg-status-USERID_HINT (process line)
+ (if (string-match "\\`USERID_HINT \\([^ ]+\\) \\(.*\\)" line)
+ (let* ((key-id (match-string 1 line))
+ (user-id (match-string 2 line))
+ (entry (assoc key-id pgg-gpg-user-id-alist)))
+ (if entry
+ (setcdr entry user-id)
+ (setq pgg-gpg-user-id-alist (cons (cons key-id user-id)
+ pgg-gpg-user-id-alist))))))
+
+(defun pgg-gpg-status-NEED_PASSPHRASE (process line)
+ (if (string-match "\\`NEED_PASSPHRASE \\([^ ]+\\)" line)
+ (setq pgg-gpg-key-id (match-string 1 line))))
+
+(defun pgg-gpg-status-NEED_PASSPHRASE_SYM (process line)
+ (setq pgg-gpg-key-id 'SYM))
+
+(defun pgg-gpg-status-NEED_PASSPHRASE_PIN (process line)
+ (setq pgg-gpg-key-id 'PIN))
+
+(defun pgg-gpg-status-GET_HIDDEN (process line)
+ (let ((entry (assoc pgg-gpg-key-id pgg-gpg-user-id-alist)))
+ (if (setq pgg-gpg-passphrase
+ (if (eq pgg-gpg-key-id 'SYM)
+ (pgg-read-passphrase
+ "GnuPG passphrase for symmetric encryption: ")
+ (pgg-read-passphrase
+ (format "GnuPG passphrase for %s: "
+ (if entry
+ (cdr entry)
+ pgg-gpg-key-id))
+ (if (eq pgg-gpg-key-id 'PIN)
+ "PIN"
+ pgg-gpg-key-id))))
+ (process-send-string process (concat pgg-gpg-passphrase "\n")))))
+
+(defun pgg-gpg-status-GOOD_PASSPHRASE (process line)
+ (when (and pgg-gpg-passphrase
+ (stringp pgg-gpg-key-id))
+ (pgg-add-passphrase-to-cache pgg-gpg-key-id pgg-gpg-passphrase)
+ (setq pgg-gpg-passphrase nil)))
+
+(defun pgg-gpg-status-BAD_PASSPHRASE (process line)
+ (when pgg-gpg-passphrase
+ (fillarray pgg-gpg-passphrase 0)
+ (setq pgg-gpg-passphrase nil)))
(defun pgg-gpg-lookup-key (string &optional type)
"Search keys associated with STRING."
(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)))))
-
-(defun pgg-gpg-encrypt-region (start end recipients &optional sign)
+ (if (re-search-forward "^\\(sec\\|pub\\):[^:]*:[^:]*:[^:]*:\\([^:]*\\)"
+ nil t)
+ (substring (match-string 2) 8)))))
+
+(defun pgg-gpg-encrypt-region (start end recipients &optional sign passphrase)
"Encrypt the current region between START and END.
+
If optional argument SIGN is non-nil, do a combined sign and encrypt."
(let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
- (passphrase
- (when sign
- (pgg-read-passphrase
- (format "GnuPG passphrase for %s: " pgg-gpg-user-id)
- (pgg-gpg-lookup-key pgg-gpg-user-id 'encrypt))))
(args
(append
- (list "--batch" "--armor" "--always-trust" "--encrypt")
+ '("--armor" "--always-trust" "--encrypt")
+ (if pgg-text-mode '("--textmode"))
(if sign (list "--sign" "--local-user" pgg-gpg-user-id))
(if recipients
(apply #'nconc
(mapcar (lambda (rcpt)
- (list "--remote-user" rcpt))
+ (list pgg-gpg-recipient-argument 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 passphrase pgg-gpg-program args))
- (when sign
- (with-current-buffer pgg-errors-buffer
- (pgg-gpg-possibly-cache-passphrase passphrase)))
- (pgg-process-when-success)))
-
-(defun pgg-gpg-decrypt-region (start end)
+ (list pgg-gpg-user-id))))))))
+ (process (pgg-gpg-start-process args)))
+ (if (and sign (not pgg-gpg-use-agent))
+ (pgg-gpg-wait-for-status process '("BEGIN_SIGNING" "GOOD_PASSPHRASE")))
+ (process-send-region process start end)
+ (pgg-gpg-wait-for-completion process)
+ (save-excursion
+ (set-buffer (get-buffer-create pgg-errors-buffer))
+ (goto-char (point-max))
+ (not (null (re-search-backward "^\\[GNUPG:] END_ENCRYPTION\\>"
+ nil t))))))
+
+(defun pgg-gpg-encrypt-symmetric-region (start end &optional passphrase)
+ "Encrypt the current region between START and END with symmetric cipher."
+ (let* ((args
+ (append '("--armor" "--symmetric")
+ (if pgg-text-mode '("--textmode"))))
+ (process (pgg-gpg-start-process args)))
+ (pgg-gpg-wait-for-status process '("BEGIN_ENCRYPTION"))
+ (process-send-region process start end)
+ (pgg-gpg-wait-for-completion process)
+ (save-excursion
+ (set-buffer (get-buffer-create pgg-errors-buffer))
+ (goto-char (point-max))
+ (not (null (re-search-backward "^\\[GNUPG:] END_ENCRYPTION\\>"
+ nil t))))))
+
+(defun pgg-gpg-decrypt-region (start end &optional passphrase)
"Decrypt the current region between START and END."
- (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
- (passphrase
- (pgg-read-passphrase
- (format "GnuPG passphrase for %s: " pgg-gpg-user-id)
- (pgg-gpg-lookup-key pgg-gpg-user-id 'encrypt)))
- (args '("--batch" "--decrypt")))
- (pgg-gpg-process-region start end passphrase pgg-gpg-program args)
- (with-current-buffer pgg-errors-buffer
- (pgg-gpg-possibly-cache-passphrase passphrase)
- (goto-char (point-min))
- (re-search-forward "^\\[GNUPG:] DECRYPTION_OKAY\\>" nil t))))
+ (let* ((args '("--decrypt"))
+ (process (pgg-gpg-start-process args)))
+ (process-send-region process start end)
+ (pgg-gpg-wait-for-status process '("BEGIN_DECRYPTION"))
+ (pgg-gpg-wait-for-completion process)
+ (save-excursion
+ (set-buffer (get-buffer-create pgg-errors-buffer))
+ (goto-char (point-max))
+ (not (null (re-search-backward "^\\[GNUPG:] DECRYPTION_OKAY\\>"
+ nil t))))))
-(defun pgg-gpg-sign-region (start end &optional cleartext)
+(defun pgg-gpg-sign-region (start end &optional cleartext passphrase)
"Make detached signature from text between START and END."
(let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
- (passphrase
- (pgg-read-passphrase
- (format "GnuPG passphrase for %s: " pgg-gpg-user-id)
- (pgg-gpg-lookup-key pgg-gpg-user-id 'sign)))
(args
- (list (if cleartext "--clearsign" "--detach-sign")
- "--armor" "--batch" "--verbose"
- "--local-user" pgg-gpg-user-id))
- (inhibit-read-only t)
- buffer-read-only)
- (pgg-as-lbt start end 'CRLF
- (pgg-gpg-process-region start end passphrase pgg-gpg-program args))
- (with-current-buffer pgg-errors-buffer
- (pgg-gpg-possibly-cache-passphrase passphrase))
- (pgg-process-when-success)))
+ (append (list (if cleartext "--clearsign" "--detach-sign")
+ "--armor" "--verbose"
+ "--local-user" pgg-gpg-user-id)
+ (if pgg-text-mode '("--textmode"))))
+ (process (pgg-gpg-start-process args)))
+ (unless pgg-gpg-use-agent
+ (pgg-gpg-wait-for-status process '("BEGIN_SIGNING" "GOOD_PASSPHRASE")))
+ (process-send-region process start end)
+ (pgg-gpg-wait-for-completion process)
+ (save-excursion
+ (set-buffer (get-buffer-create pgg-errors-buffer))
+ (goto-char (point-max))
+ (not (null (re-search-backward "^\\[GNUPG:] SIG_CREATED\\>"
+ nil t))))))
(defun pgg-gpg-verify-region (start end &optional signature)
"Verify region between START and END as the detached signature SIGNATURE."
- (let ((args '("--batch" "--verify")))
+ (let ((args '("--verify"))
+ process)
(when (stringp signature)
(setq args (append args (list signature))))
- (setq args (append args '("-")))
- (pgg-gpg-process-region start end nil pgg-gpg-program args)
- (with-current-buffer pgg-errors-buffer
- (goto-char (point-min))
- (while (re-search-forward "^gpg: \\(.*\\)\n" nil t)
- (with-current-buffer pgg-output-buffer
- (insert-buffer-substring pgg-errors-buffer
- (match-beginning 1) (match-end 0)))
- (delete-region (match-beginning 0) (match-end 0)))
- (goto-char (point-min))
- (re-search-forward "^\\[GNUPG:] GOODSIG\\>" nil t))))
+ (setq process (pgg-gpg-start-process (append args '("-"))))
+ (process-send-region process start end)
+ (pgg-gpg-wait-for-completion process)
+ (save-excursion
+ (set-buffer (get-buffer-create pgg-errors-buffer))
+ (goto-char (point-max))
+ (not (null (re-search-backward "^\\[GNUPG:] GOODSIG\\>"
+ nil t))))))
(defun pgg-gpg-insert-key ()
"Insert public key at point."
(let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
- (args (list "--batch" "--export" "--armor"
- pgg-gpg-user-id)))
- (pgg-gpg-process-region (point)(point) nil pgg-gpg-program args)
+ (args (list "--export" "--armor"
+ pgg-gpg-user-id))
+ (process (pgg-gpg-start-process args)))
+ (pgg-gpg-wait-for-completion process)
(insert-buffer-substring pgg-output-buffer)))
(defun pgg-gpg-snarf-keys-region (start end)
"Add all public keys in region between START and END to the keyring."
- (let ((args '("--import" "--batch" "-")) status)
- (pgg-gpg-process-region start end nil pgg-gpg-program args)
- (set-buffer pgg-errors-buffer)
- (goto-char (point-min))
- (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))))
- (erase-buffer)
- (insert (format "Imported %d key(s).
-\tArmor contains %d key(s) [%d bad, %d old].\n"
- (+ (aref status 2)
- (aref status 10))
- (aref status 0)
- (aref status 1)
- (+ (aref status 4)
- (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)))
+ (let* ((args '("--import" "-"))
+ (process (pgg-gpg-start-process args))
+ status)
+ (process-send-region process start end)
+ (pgg-gpg-wait-for-completion process)
+ (save-excursion
+ (set-buffer (get-buffer-create pgg-errors-buffer))
+ (goto-char (point-max))
+ (not (null (re-search-backward "^\\[GNUPG:] IMPORT_RES\\>"
+ nil t))))))
(provide 'pgg-gpg)
+;;; arch-tag: 2aa5d5d8-93a0-4865-9312-33e29830e000
;;; pgg-gpg.el ends here
projects / gnus / blobdiff