[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))
	 default-enable-multibyte-characters
	 (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 (buffer-live-p (process-buffer process))
      (save-excursion
	(if pgg-gpg-debug
	    (save-excursion
	      (set-buffer (get-buffer-create  " *pgg-gpg-debug*"))
	      (goto-char (point-max))
	      (insert input)))
	(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)
  (set-process-filter process nil)
  (save-excursion
    ;; Copy the contents of process-buffer to pgg-errors-buffer.
    (set-buffer (get-buffer-create pgg-errors-buffer))
    (buffer-disable-undo)
    (erase-buffer)
    (when (buffer-live-p (process-buffer process))
      (insert-buffer-substring (process-buffer process))
      (goto-char (point-min))
      ;(delete-matching-lines "^\\[GNUPG:] ")
      (goto-char (point-min))
      (while (re-search-forward "^gpg: " nil t)
	(replace-match "")))
    ;; 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 (and (equal status "finished\n")
	     (buffer-live-p (process-buffer process)))
	(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))))))

(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 &optional status-list)
  (process-send-eof process)
  (while (eq (process-status process) 'run)
    (sit-for 0.1))
  (if (buffer-live-p (process-buffer process))
      (save-excursion
	(set-buffer (process-buffer process))
	(setq status-list (copy-sequence status-list))
	(let ((pointer status-list))
	  (while pointer
	    (goto-char (point-min))
	    (unless (re-search-forward
		     (concat "^\\[GNUPG:] " (car pointer) "\\>")
		     nil t)
	      (setq status-list (delq (car pointer) status-list)))
	    (setq pointer (cdr pointer))))
	(kill-buffer (process-buffer process))
	status-list)))

(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 '("GOOD_PASSPHRASE")))
    (process-send-region process start end)
    (pgg-gpg-wait-for-completion process '("SIG_CREATED" "END_ENCRYPTION"))))

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

(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 '("GOODSIG" "DECRYPTION_OKAY"))))

(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 '("GOOD_PASSPHRASE")))
    (process-send-region process start end)
    (pgg-gpg-wait-for-completion process '("SIG_CREATED"))))

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

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

(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 SJ	84	(orig-mode (default-file-modes))
	85	default-enable-multibyte-characters
	86	(buffer (generate-new-buffer " pgg-gpg"))
	87	process)
	88	(with-current-buffer buffer
	89	(make-local-variable 'pgg-gpg-read-point)
	90	(setq pgg-gpg-read-point (point-min))
	91	(make-local-variable 'pgg-gpg-output-file-name)
	92	(setq pgg-gpg-output-file-name output-file-name)
	93	(make-local-variable 'pgg-gpg-pending-status-list)
	94	(setq pgg-gpg-pending-status-list nil)
	95	(make-local-variable 'pgg-gpg-key-id)
	96	(setq pgg-gpg-key-id nil)
	97	(make-local-variable 'pgg-gpg-passphrase)
	98	(setq pgg-gpg-passphrase nil))
23f87bed MB	99	(unwind-protect
	100	(progn
	101	(set-default-file-modes 448)
276e2740 SJ	102	(setq process
	103	(apply #'start-process "pgg-gpg" buffer pgg-gpg-program args)))
	104	(set-default-file-modes orig-mode))
	105	(set-process-filter process #'pgg-gpg-process-filter)
	106	(set-process-sentinel process #'pgg-gpg-process-sentinel)
	107	process))
	108
	109	(defun pgg-gpg-process-filter (process input)
7db4c10a	110	(if (buffer-live-p (process-buffer process))
276e2740	111	(save-excursion
7db4c10a SJ	112	(if pgg-gpg-debug
	113	(save-excursion
	114	(set-buffer (get-buffer-create " pgg-gpg-debug"))
	115	(goto-char (point-max))
	116	(insert input)))
	117	(set-buffer (process-buffer process))
	118	(goto-char (point-max))
	119	(insert input)
	120	(goto-char pgg-gpg-read-point)
	121	(beginning-of-line)
	122	(while (looking-at ".*\n") ;the input line is finished
	123	(save-excursion
	124	(if (looking-at "\\[GNUPG:] \\([A-Z_]+\\)\\>.*")
	125	(let* ((status (match-string 1))
	126	(symbol (intern-soft (concat "pgg-gpg-status-" status)))
	127	(entry (member status pgg-gpg-pending-status-list)))
	128	(if entry
	129	(setq pgg-gpg-pending-status-list
	130	(delq (car entry)
	131	pgg-gpg-pending-status-list)))
	132	(if (and symbol
	133	(fboundp symbol))
	134	(funcall symbol process (buffer-substring (match-beginning 1)
	135	(match-end 0)))))))
	136	(forward-line))
	137	(setq pgg-gpg-read-point (point)))))
276e2740 SJ	138
	139	(defun pgg-gpg-process-sentinel (process status)
	140	(set-process-filter process nil)
	141	(save-excursion
	142	;; Copy the contents of process-buffer to pgg-errors-buffer.
	143	(set-buffer (get-buffer-create pgg-errors-buffer))
	144	(buffer-disable-undo)
	145	(erase-buffer)
	146	(when (buffer-live-p (process-buffer process))
	147	(insert-buffer-substring (process-buffer process))
	148	(goto-char (point-min))
7db4c10a	149	;(delete-matching-lines "^\\[GNUPG:] ")
276e2740 SJ	150	(goto-char (point-min))
	151	(while (re-search-forward "^gpg: " nil t)
	152	(replace-match "")))
	153	;; Read the contents of the output file to pgg-output-buffer.
	154	(set-buffer (get-buffer-create pgg-output-buffer))
	155	(buffer-disable-undo)
	156	(erase-buffer)
	157	(if (and (equal status "finished\n")
	158	(buffer-live-p (process-buffer process)))
	159	(let ((output-file-name (with-current-buffer (process-buffer process)
	160	pgg-gpg-output-file-name)))
	161	(when (file-exists-p output-file-name)
	162	(let ((coding-system-for-read (if pgg-text-mode
	163	'raw-text
	164	'binary)))
	165	(insert-file-contents output-file-name))
	166	(delete-file output-file-name))))))
	167
	168	(defun pgg-gpg-wait-for-status (process status-list)
	169	(with-current-buffer (process-buffer process)
	170	(setq pgg-gpg-pending-status-list status-list)
	171	(while (and (eq (process-status process) 'run)
	172	pgg-gpg-pending-status-list)
	173	(accept-process-output process 1))))
	174
	175	(defun pgg-gpg-wait-for-completion (process &optional status-list)
	176	(process-send-eof process)
	177	(while (eq (process-status process) 'run)
	178	(sit-for 0.1))
7db4c10a SJ	179	(if (buffer-live-p (process-buffer process))
	180	(save-excursion
	181	(set-buffer (process-buffer process))
	182	(setq status-list (copy-sequence status-list))
	183	(let ((pointer status-list))
	184	(while pointer
	185	(goto-char (point-min))
	186	(unless (re-search-forward
	187	(concat "^\\[GNUPG:] " (car pointer) "\\>")
	188	nil t)
	189	(setq status-list (delq (car pointer) status-list)))
	190	(setq pointer (cdr pointer))))
	191	(kill-buffer (process-buffer process))
	192	status-list)))
276e2740 SJ	193
	194	(defun pgg-gpg-status-USERID_HINT (process line)
	195	(if (string-match "\\`USERID_HINT \\([^ ]+\\) \\(.*\\)" line)
	196	(let* ((key-id (match-string 1 line))
	197	(user-id (match-string 2 line))
	198	(entry (assoc key-id pgg-gpg-user-id-alist)))
	199	(if entry
	200	(setcdr entry user-id)
	201	(setq pgg-gpg-user-id-alist (cons (cons key-id user-id)
	202	pgg-gpg-user-id-alist))))))
	203
	204	(defun pgg-gpg-status-NEED_PASSPHRASE (process line)
	205	(if (string-match "\\`NEED_PASSPHRASE \\([^ ]+\\)" line)
	206	(setq pgg-gpg-key-id (match-string 1 line))))
	207
	208	(defun pgg-gpg-status-NEED_PASSPHRASE_SYM (process line)
	209	(setq pgg-gpg-key-id 'SYM))
	210
	211	(defun pgg-gpg-status-NEED_PASSPHRASE_PIN (process line)
	212	(setq pgg-gpg-key-id 'PIN))
	213
	214	(defun pgg-gpg-status-GET_HIDDEN (process line)
	215	(let ((entry (assoc pgg-gpg-key-id pgg-gpg-user-id-alist)))
	216	(if (setq pgg-gpg-passphrase
	217	(if (eq pgg-gpg-key-id 'SYM)
	218	(pgg-read-passphrase
	219	"GnuPG passphrase for symmetric encryption: ")
	220	(pgg-read-passphrase
	221	(format "GnuPG passphrase for %s: "
	222	(if entry
	223	(cdr entry)
	224	pgg-gpg-key-id))
	225	(if (eq pgg-gpg-key-id 'PIN)
	226	"PIN"
	227	pgg-gpg-key-id))))
	228	(process-send-string process (concat pgg-gpg-passphrase "\n")))))
	229
	230	(defun pgg-gpg-status-GOOD_PASSPHRASE (process line)
	231	(when (and pgg-gpg-passphrase
	232	(stringp pgg-gpg-key-id))
	233	(pgg-add-passphrase-to-cache pgg-gpg-key-id pgg-gpg-passphrase)
	234	(setq pgg-gpg-passphrase nil)))
	235
	236	(defun pgg-gpg-status-BAD_PASSPHRASE (process line)
	237	(when pgg-gpg-passphrase
	238	(fillarray pgg-gpg-passphrase 0)
	239	(setq pgg-gpg-passphrase nil)))
23f87bed MB	240
	241	(defun pgg-gpg-lookup-key (string &optional type)
	242	"Search keys associated with STRING."
	243	(let ((args (list "--with-colons" "--no-greeting" "--batch"
	244	(if type "--list-secret-keys" "--list-keys")
	245	string)))
	246	(with-temp-buffer
	247	(apply #'call-process pgg-gpg-program nil t nil args)
	248	(goto-char (point-min))
	249	(if (re-search-forward "^\\(sec\\\|pub\\):[^:]:[^:]:[^:]:\\([^:]\\)"
	250	nil t)
	251	(substring (match-string 2) 8)))))
	252
df570e6f	253	(defun pgg-gpg-encrypt-region (start end recipients &optional sign passphrase)
23f87bed	254	"Encrypt the current region between START and END.
df570e6f	255
276e2740	256	If optional argument SIGN is non-nil, do a combined sign and encrypt."
23f87bed	257	(let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
23f87bed MB	258	(args
23f87bed MB	259	(append
276e2740 SJ	260	'("--armor" "--always-trust" "--encrypt")
276e2740 SJ	261	(if pgg-text-mode '("--textmode"))
23f87bed MB	262	(if sign (list "--sign" "--local-user" pgg-gpg-user-id))
	263	(if recipients
	264	(apply #'nconc
	265	(mapcar (lambda (rcpt)
	266	(list pgg-gpg-recipient-argument rcpt))
	267	(append recipients
	268	(if pgg-encrypt-for-me
276e2740 SJ	269	(list pgg-gpg-user-id))))))))
	270	(process (pgg-gpg-start-process args)))
	271	(if (and sign (not pgg-gpg-use-agent))
	272	(pgg-gpg-wait-for-status process '("GOOD_PASSPHRASE")))
	273	(process-send-region process start end)
	274	(pgg-gpg-wait-for-completion process '("SIG_CREATED" "END_ENCRYPTION"))))
23f87bed	275
df570e6f	276	(defun pgg-gpg-encrypt-symmetric-region (start end &optional passphrase)
276e2740 SJ	277	"Encrypt the current region between START and END with symmetric cipher."
	278	(let* ((args
	279	(append '("--armor" "--symmetric")
	280	(if pgg-text-mode '("--textmode"))))
	281	(process (pgg-gpg-start-process args)))
	282	(pgg-gpg-wait-for-status process '("BEGIN_ENCRYPTION"))
	283	(process-send-region process start end)
	284	(pgg-gpg-wait-for-completion process '("END_ENCRYPTION"))))
df570e6f EZ	285
df570e6f EZ	286	(defun pgg-gpg-decrypt-region (start end &optional passphrase)
276e2740 SJ	287	"Decrypt the current region between START and END."
	288	(let* ((args '("--decrypt"))
	289	(process (pgg-gpg-start-process args)))
	290	(process-send-region process start end)
	291	(pgg-gpg-wait-for-status process '("BEGIN_DECRYPTION"))
	292	(pgg-gpg-wait-for-completion process '("GOODSIG" "DECRYPTION_OKAY"))))
23f87bed	293
df570e6f	294	(defun pgg-gpg-sign-region (start end &optional cleartext passphrase)
23f87bed MB	295	"Make detached signature from text between START and END."
23f87bed MB	296	(let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
23f87bed	297	(args
34128042	298	(append (list (if cleartext "--clearsign" "--detach-sign")
276e2740	299	"--armor" "--verbose"
34128042	300	"--local-user" pgg-gpg-user-id)
276e2740 SJ	301	(if pgg-text-mode '("--textmode"))))
	302	(process (pgg-gpg-start-process args)))
	303	(unless pgg-gpg-use-agent
	304	(pgg-gpg-wait-for-status process '("GOOD_PASSPHRASE")))
	305	(process-send-region process start end)
	306	(pgg-gpg-wait-for-completion process '("SIG_CREATED"))))
23f87bed MB	307
	308	(defun pgg-gpg-verify-region (start end &optional signature)
	309	"Verify region between START and END as the detached signature SIGNATURE."
276e2740 SJ	310	(let ((args '("--verify"))
276e2740 SJ	311	process)
23f87bed MB	312	(when (stringp signature)
23f87bed MB	313	(setq args (append args (list signature))))
276e2740 SJ	314	(setq process (pgg-gpg-start-process (append args '("-"))))
	315	(process-send-region process start end)
	316	(pgg-gpg-wait-for-completion process '("GOODSIG"))))
23f87bed MB	317
	318	(defun pgg-gpg-insert-key ()
	319	"Insert public key at point."
	320	(let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
276e2740 SJ	321	(args (list "--export" "--armor"
	322	pgg-gpg-user-id))
	323	(process (pgg-gpg-start-process args)))
	324	(pgg-gpg-wait-for-completion process)
23f87bed MB	325	(insert-buffer-substring pgg-output-buffer)))
	326
	327	(defun pgg-gpg-snarf-keys-region (start end)
	328	"Add all public keys in region between START and END to the keyring."
276e2740 SJ	329	(let* ((args '("--import" "-"))
	330	(process (pgg-gpg-start-process args))
	331	status)
	332	(process-send-region process start end)
	333	(pgg-gpg-wait-for-completion process '("IMPORT_RES"))))
4803386d	334
23f87bed MB	335	(provide 'pgg-gpg)
	336
	337	;;; arch-tag: 2aa5d5d8-93a0-4865-9312-33e29830e000
	338	;;; pgg-gpg.el ends here