[bpt/emacs.git] / lisp / pgg-gpg.el

;;; pgg-gpg.el --- GnuPG support for PGG.

;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
;;   2005, 2006 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

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; 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., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Code:

(eval-when-compile
  (require 'pgg))

(defgroup pgg-gpg ()
  "GnuPG interface."
  :group 'pgg)

(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 '(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 nil
  "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.")

(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
	  (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)
	 (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)
	  (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)))
		       (entry (member status pgg-gpg-pending-status-list)))
		  (if entry
		      (setq pgg-gpg-pending-status-list
			    (delq (car entry)
				  pgg-gpg-pending-status-list)))
		  (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."
  (let ((args (list "--with-colons" "--no-greeting" "--batch"
		    (if type "--list-secret-keys" "--list-keys")
		    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 (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))
	 (args
	  (append
	   '("--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 pgg-gpg-recipient-argument rcpt))
			      (append recipients
				      (if pgg-encrypt-for-me
					  (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* ((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 passphrase)
  "Make detached signature from text between START and END."
  (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
	 (args
	  (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 '("--verify"))
	process)
    (when (stringp signature)
      (setq args (append args (list signature))))
    (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 "--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" "-"))
	 (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
Commit	Line	Data
23f87bed MB	1	;;; pgg-gpg.el --- GnuPG support for PGG.
23f87bed MB	2
e84b4b86	3	;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
aaef169d	4	;; 2005, 2006 Free Software Foundation, Inc.
23f87bed MB	5
23f87bed MB	6	;; Author: Daiki Ueno <ueno@unixuser.org>
276e2740	7	;; Symmetric encryption support added by: Sascha Wilde <wilde@sha-bang.de>
23f87bed MB	8	;; Created: 1999/10/28
	9	;; Keywords: PGP, OpenPGP, GnuPG
	10
	11	;; This file is part of GNU Emacs.
	12
	13	;; GNU Emacs is free software; you can redistribute it and/or modify
	14	;; it under the terms of the GNU General Public License as published by
	15	;; the Free Software Foundation; either version 2, or (at your option)
	16	;; any later version.
	17
	18	;; GNU Emacs is distributed in the hope that it will be useful,
	19	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	20	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	21	;; GNU General Public License for more details.
	22
	23	;; You should have received a copy of the GNU General Public License
	24	;; along with GNU Emacs; see the file COPYING. If not, write to the
3a35cf56 LK	25	;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
3a35cf56 LK	26	;; Boston, MA 02110-1301, USA.
23f87bed MB	27
	28	;;; Code:
	29
	30	(eval-when-compile
23f87bed MB	31	(require 'pgg))
	32
	33	(defgroup pgg-gpg ()
4a836a63	34	"GnuPG interface."
23f87bed MB	35	:group 'pgg)
	36
	37	(defcustom pgg-gpg-program "gpg"
	38	"The GnuPG executable."
	39	:group 'pgg-gpg
	40	:type 'string)
	41
	42	(defcustom pgg-gpg-extra-args nil
	43	"Extra arguments for every GnuPG invocation."
	44	:group 'pgg-gpg
	45	:type '(repeat (string :tag "Argument")))
	46
	47	(defcustom pgg-gpg-recipient-argument "--recipient"
	48	"GnuPG option to specify recipient."
	49	:group 'pgg-gpg
	50	:type '(choice (const :tag "New `--recipient' option" "--recipient")
	51	(const :tag "Old `--remote-user' option" "--remote-user")))
	52
4803386d SJ	53	(defcustom pgg-gpg-use-agent nil
4803386d SJ	54	"Whether to use gnupg agent for key caching."
e563e53b SJ	55	:group 'pgg-gpg
	56	:type 'boolean)
	57
23f87bed MB	58	(defvar pgg-gpg-user-id nil
	59	"GnuPG ID of your default identity.")
	60
276e2740 SJ	61	(defvar pgg-gpg-user-id-alist nil
	62	"An alist mapping from key ID to user ID.")
	63
	64	(defvar pgg-gpg-read-point nil)
	65	(defvar pgg-gpg-output-file-name nil)
	66	(defvar pgg-gpg-pending-status-list nil)
	67	(defvar pgg-gpg-key-id nil)
	68	(defvar pgg-gpg-passphrase nil)
	69	(defvar pgg-gpg-debug nil)
	70
	71	(defun pgg-gpg-start-process (args)
	72	(let* ((output-file-name (pgg-make-temp-file "pgg-output"))
23f87bed	73	(args
276e2740 SJ	74	(append (list "--no-tty"
	75	"--status-fd" "1"
	76	"--command-fd" "0"
	77	"--yes" ; overwrite
	78	"--output" output-file-name)
	79	(if pgg-gpg-use-agent '("--use-agent"))
	80	pgg-gpg-extra-args
	81	args))
	82	(coding-system-for-write 'binary)
23f87bed	83	(process-connection-type nil)
276e2740	84	(orig-mode (default-file-modes))
276e2740 SJ	85	(buffer (generate-new-buffer " pgg-gpg"))
	86	process)
	87	(with-current-buffer buffer
	88	(make-local-variable 'pgg-gpg-read-point)
	89	(setq pgg-gpg-read-point (point-min))
	90	(make-local-variable 'pgg-gpg-output-file-name)
	91	(setq pgg-gpg-output-file-name output-file-name)
	92	(make-local-variable 'pgg-gpg-pending-status-list)
	93	(setq pgg-gpg-pending-status-list nil)
	94	(make-local-variable 'pgg-gpg-key-id)
	95	(setq pgg-gpg-key-id nil)
	96	(make-local-variable 'pgg-gpg-passphrase)
	97	(setq pgg-gpg-passphrase nil))
23f87bed MB	98	(unwind-protect
	99	(progn
	100	(set-default-file-modes 448)
276e2740 SJ	101	(setq process
	102	(apply #'start-process "pgg-gpg" buffer pgg-gpg-program args)))
	103	(set-default-file-modes orig-mode))
	104	(set-process-filter process #'pgg-gpg-process-filter)
	105	(set-process-sentinel process #'pgg-gpg-process-sentinel)
	106	process))
	107
	108	(defun pgg-gpg-process-filter (process input)
bd707233 SJ	109	(if pgg-gpg-debug
	110	(save-excursion
	111	(set-buffer (get-buffer-create " pgg-gpg-debug"))
	112	(goto-char (point-max))
	113	(insert input)))
7db4c10a	114	(if (buffer-live-p (process-buffer process))
276e2740	115	(save-excursion
7db4c10a SJ	116	(set-buffer (process-buffer process))
	117	(goto-char (point-max))
	118	(insert input)
	119	(goto-char pgg-gpg-read-point)
	120	(beginning-of-line)
	121	(while (looking-at ".*\n") ;the input line is finished
	122	(save-excursion
	123	(if (looking-at "\\[GNUPG:] \\([A-Z_]+\\)\\>.*")
	124	(let* ((status (match-string 1))
	125	(symbol (intern-soft (concat "pgg-gpg-status-" status)))
	126	(entry (member status pgg-gpg-pending-status-list)))
	127	(if entry
	128	(setq pgg-gpg-pending-status-list
	129	(delq (car entry)
	130	pgg-gpg-pending-status-list)))
	131	(if (and symbol
	132	(fboundp symbol))
bd707233 SJ	133	(funcall symbol process (buffer-substring
	134	(match-beginning 1)
	135	(match-end 0)))))))
7db4c10a SJ	136	(forward-line))
7db4c10a SJ	137	(setq pgg-gpg-read-point (point)))))
276e2740 SJ	138
276e2740 SJ	139	(defun pgg-gpg-process-sentinel (process status)
bd707233 SJ	140	(if (buffer-live-p (process-buffer process))
	141	(save-excursion
	142	(set-buffer (process-buffer process))
	143	(when pgg-gpg-passphrase
	144	(fillarray pgg-gpg-passphrase 0)
	145	(setq pgg-gpg-passphrase nil))
	146	;; Copy the contents of process-buffer to pgg-errors-buffer.
	147	(set-buffer (get-buffer-create pgg-errors-buffer))
	148	(buffer-disable-undo)
	149	(erase-buffer)
	150	(insert-buffer-substring (process-buffer process))
	151	;; Read the contents of the output file to pgg-output-buffer.
	152	(set-buffer (get-buffer-create pgg-output-buffer))
	153	(buffer-disable-undo)
	154	(erase-buffer)
	155	(if (equal status "finished\n")
	156	(let ((output-file-name
	157	(with-current-buffer (process-buffer process)
	158	pgg-gpg-output-file-name)))
	159	(when (file-exists-p output-file-name)
	160	(let ((coding-system-for-read (if pgg-text-mode
	161	'raw-text
	162	'binary)))
	163	(insert-file-contents output-file-name))
	164	(delete-file output-file-name))))
	165	(kill-buffer (process-buffer process)))))
276e2740 SJ	166
	167	(defun pgg-gpg-wait-for-status (process status-list)
	168	(with-current-buffer (process-buffer process)
	169	(setq pgg-gpg-pending-status-list status-list)
	170	(while (and (eq (process-status process) 'run)
	171	pgg-gpg-pending-status-list)
	172	(accept-process-output process 1))))
	173
bd707233	174	(defun pgg-gpg-wait-for-completion (process)
276e2740 SJ	175	(process-send-eof process)
276e2740 SJ	176	(while (eq (process-status process) 'run)
bd707233 SJ	177	;; We can't use accept-process-output instead of sit-for here
	178	;; because it may cause an interrupt during the sentinel execution.
	179	(sit-for 0.1)))
276e2740 SJ	180
	181	(defun pgg-gpg-status-USERID_HINT (process line)
	182	(if (string-match "\\`USERID_HINT \\([^ ]+\\) \\(.*\\)" line)
	183	(let* ((key-id (match-string 1 line))
	184	(user-id (match-string 2 line))
	185	(entry (assoc key-id pgg-gpg-user-id-alist)))
	186	(if entry
	187	(setcdr entry user-id)
	188	(setq pgg-gpg-user-id-alist (cons (cons key-id user-id)
	189	pgg-gpg-user-id-alist))))))
	190
	191	(defun pgg-gpg-status-NEED_PASSPHRASE (process line)
	192	(if (string-match "\\`NEED_PASSPHRASE \\([^ ]+\\)" line)
	193	(setq pgg-gpg-key-id (match-string 1 line))))
	194
	195	(defun pgg-gpg-status-NEED_PASSPHRASE_SYM (process line)
	196	(setq pgg-gpg-key-id 'SYM))
	197
	198	(defun pgg-gpg-status-NEED_PASSPHRASE_PIN (process line)
	199	(setq pgg-gpg-key-id 'PIN))
	200
	201	(defun pgg-gpg-status-GET_HIDDEN (process line)
	202	(let ((entry (assoc pgg-gpg-key-id pgg-gpg-user-id-alist)))
	203	(if (setq pgg-gpg-passphrase
	204	(if (eq pgg-gpg-key-id 'SYM)
	205	(pgg-read-passphrase
	206	"GnuPG passphrase for symmetric encryption: ")
	207	(pgg-read-passphrase
	208	(format "GnuPG passphrase for %s: "
	209	(if entry
	210	(cdr entry)
	211	pgg-gpg-key-id))
	212	(if (eq pgg-gpg-key-id 'PIN)
	213	"PIN"
	214	pgg-gpg-key-id))))
	215	(process-send-string process (concat pgg-gpg-passphrase "\n")))))
	216
	217	(defun pgg-gpg-status-GOOD_PASSPHRASE (process line)
	218	(when (and pgg-gpg-passphrase
	219	(stringp pgg-gpg-key-id))
	220	(pgg-add-passphrase-to-cache pgg-gpg-key-id pgg-gpg-passphrase)
	221	(setq pgg-gpg-passphrase nil)))
	222
	223	(defun pgg-gpg-status-BAD_PASSPHRASE (process line)
	224	(when pgg-gpg-passphrase
	225	(fillarray pgg-gpg-passphrase 0)
	226	(setq pgg-gpg-passphrase nil)))
23f87bed MB	227
	228	(defun pgg-gpg-lookup-key (string &optional type)
	229	"Search keys associated with STRING."
	230	(let ((args (list "--with-colons" "--no-greeting" "--batch"
	231	(if type "--list-secret-keys" "--list-keys")
	232	string)))
	233	(with-temp-buffer
	234	(apply #'call-process pgg-gpg-program nil t nil args)
	235	(goto-char (point-min))
	236	(if (re-search-forward "^\\(sec\\\|pub\\):[^:]:[^:]:[^:]:\\([^:]\\)"
	237	nil t)
	238	(substring (match-string 2) 8)))))
	239
df570e6f	240	(defun pgg-gpg-encrypt-region (start end recipients &optional sign passphrase)
23f87bed	241	"Encrypt the current region between START and END.
df570e6f	242
276e2740	243	If optional argument SIGN is non-nil, do a combined sign and encrypt."
23f87bed	244	(let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
23f87bed MB	245	(args
23f87bed MB	246	(append
276e2740 SJ	247	'("--armor" "--always-trust" "--encrypt")
276e2740 SJ	248	(if pgg-text-mode '("--textmode"))
23f87bed MB	249	(if sign (list "--sign" "--local-user" pgg-gpg-user-id))
	250	(if recipients
	251	(apply #'nconc
	252	(mapcar (lambda (rcpt)
	253	(list pgg-gpg-recipient-argument rcpt))
	254	(append recipients
	255	(if pgg-encrypt-for-me
276e2740 SJ	256	(list pgg-gpg-user-id))))))))
	257	(process (pgg-gpg-start-process args)))
	258	(if (and sign (not pgg-gpg-use-agent))
39a270b1	259	(pgg-gpg-wait-for-status process '("BEGIN_SIGNING" "GOOD_PASSPHRASE")))
276e2740	260	(process-send-region process start end)
bd707233 SJ	261	(pgg-gpg-wait-for-completion process)
	262	(save-excursion
	263	(set-buffer (get-buffer-create pgg-errors-buffer))
	264	(goto-char (point-max))
	265	(not (null (re-search-backward "^\\[GNUPG:] END_ENCRYPTION\\>"
	266	nil t))))))
23f87bed	267
df570e6f	268	(defun pgg-gpg-encrypt-symmetric-region (start end &optional passphrase)
276e2740 SJ	269	"Encrypt the current region between START and END with symmetric cipher."
	270	(let* ((args
	271	(append '("--armor" "--symmetric")
	272	(if pgg-text-mode '("--textmode"))))
	273	(process (pgg-gpg-start-process args)))
	274	(pgg-gpg-wait-for-status process '("BEGIN_ENCRYPTION"))
	275	(process-send-region process start end)
bd707233 SJ	276	(pgg-gpg-wait-for-completion process)
	277	(save-excursion
	278	(set-buffer (get-buffer-create pgg-errors-buffer))
	279	(goto-char (point-max))
	280	(not (null (re-search-backward "^\\[GNUPG:] END_ENCRYPTION\\>"
	281	nil t))))))
df570e6f EZ	282
df570e6f EZ	283	(defun pgg-gpg-decrypt-region (start end &optional passphrase)
276e2740 SJ	284	"Decrypt the current region between START and END."
	285	(let* ((args '("--decrypt"))
	286	(process (pgg-gpg-start-process args)))
	287	(process-send-region process start end)
	288	(pgg-gpg-wait-for-status process '("BEGIN_DECRYPTION"))
bd707233 SJ	289	(pgg-gpg-wait-for-completion process)
	290	(save-excursion
	291	(set-buffer (get-buffer-create pgg-errors-buffer))
	292	(goto-char (point-max))
	293	(not (null (re-search-backward "^\\[GNUPG:] DECRYPTION_OKAY\\>"
	294	nil t))))))
23f87bed	295
df570e6f	296	(defun pgg-gpg-sign-region (start end &optional cleartext passphrase)
23f87bed MB	297	"Make detached signature from text between START and END."
23f87bed MB	298	(let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
23f87bed	299	(args
34128042	300	(append (list (if cleartext "--clearsign" "--detach-sign")
276e2740	301	"--armor" "--verbose"
34128042	302	"--local-user" pgg-gpg-user-id)
276e2740 SJ	303	(if pgg-text-mode '("--textmode"))))
	304	(process (pgg-gpg-start-process args)))
	305	(unless pgg-gpg-use-agent
39a270b1	306	(pgg-gpg-wait-for-status process '("BEGIN_SIGNING" "GOOD_PASSPHRASE")))
276e2740	307	(process-send-region process start end)
bd707233 SJ	308	(pgg-gpg-wait-for-completion process)
	309	(save-excursion
	310	(set-buffer (get-buffer-create pgg-errors-buffer))
	311	(goto-char (point-max))
	312	(not (null (re-search-backward "^\\[GNUPG:] SIG_CREATED\\>"
	313	nil t))))))
23f87bed MB	314
	315	(defun pgg-gpg-verify-region (start end &optional signature)
	316	"Verify region between START and END as the detached signature SIGNATURE."
276e2740 SJ	317	(let ((args '("--verify"))
276e2740 SJ	318	process)
23f87bed MB	319	(when (stringp signature)
23f87bed MB	320	(setq args (append args (list signature))))
276e2740 SJ	321	(setq process (pgg-gpg-start-process (append args '("-"))))
276e2740 SJ	322	(process-send-region process start end)
bd707233 SJ	323	(pgg-gpg-wait-for-completion process)
	324	(save-excursion
	325	(set-buffer (get-buffer-create pgg-errors-buffer))
	326	(goto-char (point-max))
	327	(not (null (re-search-backward "^\\[GNUPG:] GOODSIG\\>"
	328	nil t))))))
23f87bed MB	329
	330	(defun pgg-gpg-insert-key ()
	331	"Insert public key at point."
	332	(let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
276e2740 SJ	333	(args (list "--export" "--armor"
	334	pgg-gpg-user-id))
	335	(process (pgg-gpg-start-process args)))
	336	(pgg-gpg-wait-for-completion process)
23f87bed MB	337	(insert-buffer-substring pgg-output-buffer)))
	338
	339	(defun pgg-gpg-snarf-keys-region (start end)
	340	"Add all public keys in region between START and END to the keyring."
276e2740 SJ	341	(let* ((args '("--import" "-"))
	342	(process (pgg-gpg-start-process args))
	343	status)
	344	(process-send-region process start end)
bd707233 SJ	345	(pgg-gpg-wait-for-completion process)
	346	(save-excursion
	347	(set-buffer (get-buffer-create pgg-errors-buffer))
	348	(goto-char (point-max))
	349	(not (null (re-search-backward "^\\[GNUPG:] IMPORT_RES\\>"
	350	nil t))))))
4803386d	351
23f87bed MB	352	(provide 'pgg-gpg)
	353
	354	;;; arch-tag: 2aa5d5d8-93a0-4865-9312-33e29830e000
	355	;;; pgg-gpg.el ends here