[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 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 'cl)				; for gpg macros
  (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 (if (getenv "GPG_AGENT_INFO") t nil)
  "Whether to use gnupg agent for key caching.
By default, it will be enabled iff the environment variable
\"GPG_AGENT_INFO\" is set."
  :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 (pgg-make-temp-file "pgg-output"))
	 (args
	  `("--status-fd" "2"
	    ,@(if pgg-gpg-use-agent '("--use-agent")
		(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)
	 exit-status)
    (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)
		(input (buffer-substring-no-properties start end))
		(default-enable-multibyte-characters nil))
	    (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 (if pgg-text-mode
						  'raw-text
						'binary)))
		  (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 &optional key notruncate)
  (if (and passphrase
	   pgg-cache-passphrase
	   (progn
	     (goto-char (point-min))
	     (re-search-forward "^\\[GNUPG:] \\(GOOD_PASSPHRASE\\>\\)\\|\\(SIG_CREATED\\)" nil t)))
      (pgg-add-passphrase-to-cache
       (or key
	   (progn
	     (goto-char (point-min))
	     (if (re-search-forward
		  "^\\[GNUPG:] NEED_PASSPHRASE\\(_PIN\\)? \\w+ ?\\w*" nil t)
		 (substring (match-string 0) -8))))
       passphrase
       notruncate)))

(defvar pgg-gpg-all-secret-keys 'unknown)

(defun pgg-gpg-lookup-all-secret-keys ()
  "Return all secret keys present in secret key ring."
  (when (eq pgg-gpg-all-secret-keys 'unknown)
    (setq pgg-gpg-all-secret-keys '())
    (let ((args (list "--with-colons" "--no-greeting" "--batch"
		      "--list-secret-keys")))
      (with-temp-buffer
	(apply #'call-process pgg-gpg-program nil t nil args)
	(goto-char (point-min))
	(while (re-search-forward
		"^\\(sec\\|pub\\):[^:]*:[^:]*:[^:]*:\\([^:]*\\)" nil t)
	  (push (substring (match-string 2) 8)
		pgg-gpg-all-secret-keys)))))
  pgg-gpg-all-secret-keys)

(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-lookup-key-owner (string &optional all)
  "Search keys associated with STRING and return owner of identified key.

The value may be just the bare key id, or it may be a combination of the
user name associated with the key and the key id, with the key id enclosed
in \"<...>\" angle brackets.

Optional ALL non-nil means search all keys, including secret keys."
  (let ((args (list "--with-colons" "--no-greeting" "--batch"
		    (if all "--list-secret-keys" "--list-keys")
		    string))
	(key-regexp (concat "^\\(sec\\|pub\\)"
			    ":[^:]*:[^:]*:[^:]*:\\([^:]*\\):[^:]*"
			    ":[^:]*:[^:]*:[^:]*:\\([^:]*\\):")))
    (with-temp-buffer
      (apply #'call-process pgg-gpg-program nil t nil args)
      (goto-char (point-min))
      (if (re-search-forward key-regexp
			     nil t)
	  (match-string 3)))))

(defun pgg-gpg-key-id-from-key-owner (key-owner)
  (cond ((not key-owner) nil)
	;; Extract bare key id from outermost paired angle brackets, if any:
	((string-match "[^<]*<\\(.+\\)>[^>]*" key-owner)
	 (substring key-owner (match-beginning 1)(match-end 1)))
	(key-owner)))

(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.

If optional PASSPHRASE is not specified, it will be obtained from the
passphrase cache or user."
  (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
	 (passphrase (or passphrase
			 (when (and sign (not pgg-gpg-use-agent))
			   (pgg-read-passphrase
			    (format "GnuPG passphrase for %s: "
				    pgg-gpg-user-id)
			    pgg-gpg-user-id))))
	 (args
	  (append
	   (list "--batch" "--armor" "--always-trust" "--encrypt")
	   (if pgg-text-mode (list "--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)))))))))
    (pgg-gpg-process-region start end passphrase pgg-gpg-program args)
    (when sign
      (with-current-buffer pgg-errors-buffer
	;; Possibly cache passphrase under, e.g. "jas", for future sign.
	(pgg-gpg-possibly-cache-passphrase passphrase pgg-gpg-user-id)
	;; Possibly cache passphrase under, e.g. B565716F, for future decrypt.
	(pgg-gpg-possibly-cache-passphrase passphrase)))
    (pgg-process-when-success)))

(defun pgg-gpg-encrypt-symmetric-region (start end &optional passphrase)
  "Encrypt the current region between START and END with symmetric cipher.

If optional PASSPHRASE is not specified, it will be obtained from the
passphrase cache or user."
  (let* ((passphrase (or passphrase
			 (when (not pgg-gpg-use-agent)
			   (pgg-read-passphrase
			    "GnuPG passphrase for symmetric encryption: "))))
	 (args
	  (append (list "--batch" "--armor" "--symmetric" )
		  (if pgg-text-mode (list "--textmode")))))
    (pgg-gpg-process-region start end passphrase pgg-gpg-program args)
    (pgg-process-when-success)))

(defun pgg-gpg-decrypt-region (start end &optional passphrase)
  "Decrypt the current region between START and END.

If optional PASSPHRASE is not specified, it will be obtained from the
passphrase cache or user."
  (let* ((current-buffer (current-buffer))
	 (message-keys (with-temp-buffer
			 (insert-buffer-substring current-buffer)
			 (pgg-decode-armor-region (point-min) (point-max))))
	 (secret-keys (pgg-gpg-lookup-all-secret-keys))
	 ;; XXX the user is stuck if they need to use the passphrase for
	 ;;     any but the first secret key for which the message is
	 ;;     encrypted.  ideally, we would incrementally give them a
	 ;;     chance with subsequent keys each time they fail with one.
	 (key (pgg-gpg-select-matching-key message-keys secret-keys))
	 (key-owner (and key (pgg-gpg-lookup-key-owner key t)))
	 (key-id (pgg-gpg-key-id-from-key-owner key-owner))
	 (pgg-gpg-user-id (or key-id key
			      pgg-gpg-user-id pgg-default-user-id))
	 (passphrase (or passphrase
			 (when (not pgg-gpg-use-agent)
			   (pgg-read-passphrase
			    (format (if (pgg-gpg-symmetric-key-p message-keys)
					"Passphrase for symmetric decryption: "
				      "GnuPG passphrase for %s: ")
				    (or key-owner "??"))
			    pgg-gpg-user-id))))
	 (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 pgg-gpg-user-id)
      (goto-char (point-min))
      (re-search-forward "^\\[GNUPG:] DECRYPTION_OKAY\\>" nil t))))

;;;###autoload
(defun pgg-gpg-symmetric-key-p (message-keys)
  "True if decoded armor MESSAGE-KEYS has symmetric encryption indicator."
  (let (result)
    (dolist (key message-keys result)
      (when (and (eq (car key) 3)
		 (member '(symmetric-key-algorithm) key))
	(setq result key)))))

(defun pgg-gpg-select-matching-key (message-keys secret-keys)
  "Choose a key from MESSAGE-KEYS that matches one of the keys in SECRET-KEYS."
  (loop for message-key in message-keys
	for message-key-id = (and (equal (car message-key) 1)
				  (cdr (assq 'key-identifier
					     (cdr message-key))))
	for key = (and message-key-id (pgg-lookup-key message-key-id 'encrypt))
	when (and key (member key secret-keys)) return key))

(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 (or passphrase
			 (when (not pgg-gpg-use-agent)
			   (pgg-read-passphrase
			    (format "GnuPG passphrase for %s: "
				    pgg-gpg-user-id)
			    pgg-gpg-user-id))))
	 (args
	  (append (list (if cleartext "--clearsign" "--detach-sign")
			"--armor" "--batch" "--verbose"
			"--local-user" pgg-gpg-user-id)
		  (if pgg-text-mode (list "--textmode"))))
	 (inhibit-read-only t)
	 buffer-read-only)
    (pgg-gpg-process-region start end passphrase pgg-gpg-program args)
    (with-current-buffer pgg-errors-buffer
      ;; Possibly cache passphrase under, e.g. "jas", for future sign.
      (pgg-gpg-possibly-cache-passphrase passphrase pgg-gpg-user-id)
      ;; Possibly cache passphrase under, e.g. B565716F, for future decrypt.
      (pgg-gpg-possibly-cache-passphrase passphrase))
    (pgg-process-when-success)))

(defun pgg-gpg-verify-region (start end &optional signature)
  "Verify region between START and END as the detached signature SIGNATURE."
  (let ((args '("--batch" "--verify")))
    (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))))

(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)
    (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-number (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)))

(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>
df570e6f	7	;; Symmetric encryption 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
	31	(require 'cl) ; for gpg macros
	32	(require 'pgg))
	33
	34	(defgroup pgg-gpg ()
4a836a63	35	"GnuPG interface."
23f87bed MB	36	:group 'pgg)
	37
	38	(defcustom pgg-gpg-program "gpg"
	39	"The GnuPG executable."
	40	:group 'pgg-gpg
	41	:type 'string)
	42
	43	(defcustom pgg-gpg-extra-args nil
	44	"Extra arguments for every GnuPG invocation."
	45	:group 'pgg-gpg
	46	:type '(repeat (string :tag "Argument")))
	47
	48	(defcustom pgg-gpg-recipient-argument "--recipient"
	49	"GnuPG option to specify recipient."
	50	:group 'pgg-gpg
	51	:type '(choice (const :tag "New `--recipient' option" "--recipient")
	52	(const :tag "Old `--remote-user' option" "--remote-user")))
	53
e563e53b SJ	54	(defcustom pgg-gpg-use-agent (if (getenv "GPG_AGENT_INFO") t nil)
	55	"Whether to use gnupg agent for key caching.
	56	By default, it will be enabled iff the environment variable
	57	\"GPG_AGENT_INFO\" is set."
	58	:group 'pgg-gpg
	59	:type 'boolean)
	60
23f87bed MB	61	(defvar pgg-gpg-user-id nil
	62	"GnuPG ID of your default identity.")
	63
	64	(defun pgg-gpg-process-region (start end passphrase program args)
	65	(let* ((output-file-name (pgg-make-temp-file "pgg-output"))
	66	(args
	67	`("--status-fd" "2"
e563e53b SJ	68	,@(if pgg-gpg-use-agent '("--use-agent")
e563e53b SJ	69	(if passphrase '("--passphrase-fd" "0")))
23f87bed MB	70	"--yes" ; overwrite
	71	"--output" ,output-file-name
	72	,@pgg-gpg-extra-args ,@args))
	73	(output-buffer pgg-output-buffer)
	74	(errors-buffer pgg-errors-buffer)
	75	(orig-mode (default-file-modes))
	76	(process-connection-type nil)
	77	exit-status)
	78	(with-current-buffer (get-buffer-create errors-buffer)
	79	(buffer-disable-undo)
	80	(erase-buffer))
	81	(unwind-protect
	82	(progn
	83	(set-default-file-modes 448)
	84	(let ((coding-system-for-write 'binary)
	85	(input (buffer-substring-no-properties start end))
	86	(default-enable-multibyte-characters nil))
	87	(with-temp-buffer
	88	(when passphrase
	89	(insert passphrase "\n"))
	90	(insert input)
	91	(setq exit-status
	92	(apply #'call-process-region (point-min) (point-max) program
	93	nil errors-buffer nil args))))
	94	(with-current-buffer (get-buffer-create output-buffer)
	95	(buffer-disable-undo)
	96	(erase-buffer)
	97	(if (file-exists-p output-file-name)
34128042 MB	98	(let ((coding-system-for-read (if pgg-text-mode
	99	'raw-text
	100	'binary)))
23f87bed MB	101	(insert-file-contents output-file-name)))
	102	(set-buffer errors-buffer)
	103	(if (not (equal exit-status 0))
	104	(insert (format "\n%s exited abnormally: '%s'\n"
	105	program exit-status)))))
	106	(if (file-exists-p output-file-name)
	107	(delete-file output-file-name))
	108	(set-default-file-modes orig-mode))))
	109
df570e6f	110	(defun pgg-gpg-possibly-cache-passphrase (passphrase &optional key notruncate)
e563e53b SJ	111	(if (and passphrase
e563e53b SJ	112	pgg-cache-passphrase
23f87bed MB	113	(progn
23f87bed MB	114	(goto-char (point-min))
82259e50	115	(re-search-forward "^\\[GNUPG:] \\(GOOD_PASSPHRASE\\>\\)\\\|\\(SIG_CREATED\\)" nil t)))
df570e6f	116	(pgg-add-passphrase-to-cache
23f87bed MB	117	(or key
	118	(progn
	119	(goto-char (point-min))
	120	(if (re-search-forward
82259e50	121	"^\\[GNUPG:] NEED_PASSPHRASE\\(_PIN\\)? \\w+ ?\\w*" nil t)
23f87bed	122	(substring (match-string 0) -8))))
df570e6f EZ	123	passphrase
df570e6f EZ	124	notruncate)))
23f87bed MB	125
	126	(defvar pgg-gpg-all-secret-keys 'unknown)
	127
	128	(defun pgg-gpg-lookup-all-secret-keys ()
	129	"Return all secret keys present in secret key ring."
	130	(when (eq pgg-gpg-all-secret-keys 'unknown)
	131	(setq pgg-gpg-all-secret-keys '())
	132	(let ((args (list "--with-colons" "--no-greeting" "--batch"
	133	"--list-secret-keys")))
	134	(with-temp-buffer
	135	(apply #'call-process pgg-gpg-program nil t nil args)
	136	(goto-char (point-min))
	137	(while (re-search-forward
	138	"^\\(sec\\\|pub\\):[^:]:[^:]:[^:]:\\([^:]\\)" nil t)
	139	(push (substring (match-string 2) 8)
	140	pgg-gpg-all-secret-keys)))))
	141	pgg-gpg-all-secret-keys)
	142
	143	(defun pgg-gpg-lookup-key (string &optional type)
	144	"Search keys associated with STRING."
	145	(let ((args (list "--with-colons" "--no-greeting" "--batch"
	146	(if type "--list-secret-keys" "--list-keys")
	147	string)))
	148	(with-temp-buffer
	149	(apply #'call-process pgg-gpg-program nil t nil args)
	150	(goto-char (point-min))
	151	(if (re-search-forward "^\\(sec\\\|pub\\):[^:]:[^:]:[^:]:\\([^:]\\)"
	152	nil t)
	153	(substring (match-string 2) 8)))))
	154
df570e6f EZ	155	(defun pgg-gpg-lookup-key-owner (string &optional all)
	156	"Search keys associated with STRING and return owner of identified key.
	157
	158	The value may be just the bare key id, or it may be a combination of the
	159	user name associated with the key and the key id, with the key id enclosed
	160	in \"<...>\" angle brackets.
	161
	162	Optional ALL non-nil means search all keys, including secret keys."
	163	(let ((args (list "--with-colons" "--no-greeting" "--batch"
	164	(if all "--list-secret-keys" "--list-keys")
	165	string))
7b97a7a5 RS	166	(key-regexp (concat "^\\(sec\\\|pub\\)"
	167	":[^:]:[^:]:[^:]:\\([^:]\\):[^:]*"
	168	":[^:]:[^:]:[^:]:\\([^:]\\):")))
df570e6f EZ	169	(with-temp-buffer
	170	(apply #'call-process pgg-gpg-program nil t nil args)
	171	(goto-char (point-min))
	172	(if (re-search-forward key-regexp
7b97a7a5 RS	173	nil t)
7b97a7a5 RS	174	(match-string 3)))))
df570e6f EZ	175
	176	(defun pgg-gpg-key-id-from-key-owner (key-owner)
	177	(cond ((not key-owner) nil)
7b97a7a5 RS	178	;; Extract bare key id from outermost paired angle brackets, if any:
	179	((string-match "[^<]<\\(.+\\)>[^>]" key-owner)
	180	(substring key-owner (match-beginning 1)(match-end 1)))
	181	(key-owner)))
df570e6f EZ	182
df570e6f EZ	183	(defun pgg-gpg-encrypt-region (start end recipients &optional sign passphrase)
23f87bed	184	"Encrypt the current region between START and END.
df570e6f EZ	185
	186	If optional argument SIGN is non-nil, do a combined sign and encrypt.
	187
	188	If optional PASSPHRASE is not specified, it will be obtained from the
	189	passphrase cache or user."
23f87bed	190	(let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
df570e6f	191	(passphrase (or passphrase
e563e53b SJ	192	(when (and sign (not pgg-gpg-use-agent))
	193	(pgg-read-passphrase
	194	(format "GnuPG passphrase for %s: "
	195	pgg-gpg-user-id)
	196	pgg-gpg-user-id))))
23f87bed MB	197	(args
23f87bed MB	198	(append
34128042 MB	199	(list "--batch" "--armor" "--always-trust" "--encrypt")
34128042 MB	200	(if pgg-text-mode (list "--textmode"))
23f87bed MB	201	(if sign (list "--sign" "--local-user" pgg-gpg-user-id))
	202	(if recipients
	203	(apply #'nconc
	204	(mapcar (lambda (rcpt)
	205	(list pgg-gpg-recipient-argument rcpt))
	206	(append recipients
	207	(if pgg-encrypt-for-me
	208	(list pgg-gpg-user-id)))))))))
34128042	209	(pgg-gpg-process-region start end passphrase pgg-gpg-program args)
23f87bed MB	210	(when sign
	211	(with-current-buffer pgg-errors-buffer
	212	;; Possibly cache passphrase under, e.g. "jas", for future sign.
	213	(pgg-gpg-possibly-cache-passphrase passphrase pgg-gpg-user-id)
	214	;; Possibly cache passphrase under, e.g. B565716F, for future decrypt.
	215	(pgg-gpg-possibly-cache-passphrase passphrase)))
	216	(pgg-process-when-success)))
	217
df570e6f EZ	218	(defun pgg-gpg-encrypt-symmetric-region (start end &optional passphrase)
	219	"Encrypt the current region between START and END with symmetric cipher.
	220
	221	If optional PASSPHRASE is not specified, it will be obtained from the
	222	passphrase cache or user."
	223	(let* ((passphrase (or passphrase
e563e53b SJ	224	(when (not pgg-gpg-use-agent)
	225	(pgg-read-passphrase
	226	"GnuPG passphrase for symmetric encryption: "))))
df570e6f	227	(args
34128042 MB	228	(append (list "--batch" "--armor" "--symmetric" )
	229	(if pgg-text-mode (list "--textmode")))))
	230	(pgg-gpg-process-region start end passphrase pgg-gpg-program args)
df570e6f EZ	231	(pgg-process-when-success)))
	232
	233	(defun pgg-gpg-decrypt-region (start end &optional passphrase)
	234	"Decrypt the current region between START and END.
	235
	236	If optional PASSPHRASE is not specified, it will be obtained from the
	237	passphrase cache or user."
23f87bed MB	238	(let* ((current-buffer (current-buffer))
	239	(message-keys (with-temp-buffer
	240	(insert-buffer-substring current-buffer)
	241	(pgg-decode-armor-region (point-min) (point-max))))
	242	(secret-keys (pgg-gpg-lookup-all-secret-keys))
7b97a7a5 RS	243	;; XXX the user is stuck if they need to use the passphrase for
	244	;; any but the first secret key for which the message is
	245	;; encrypted. ideally, we would incrementally give them a
	246	;; chance with subsequent keys each time they fail with one.
23f87bed	247	(key (pgg-gpg-select-matching-key message-keys secret-keys))
7b97a7a5	248	(key-owner (and key (pgg-gpg-lookup-key-owner key t)))
df570e6f EZ	249	(key-id (pgg-gpg-key-id-from-key-owner key-owner))
df570e6f EZ	250	(pgg-gpg-user-id (or key-id key
7b97a7a5	251	pgg-gpg-user-id pgg-default-user-id))
df570e6f	252	(passphrase (or passphrase
e563e53b SJ	253	(when (not pgg-gpg-use-agent)
	254	(pgg-read-passphrase
	255	(format (if (pgg-gpg-symmetric-key-p message-keys)
	256	"Passphrase for symmetric decryption: "
	257	"GnuPG passphrase for %s: ")
	258	(or key-owner "??"))
	259	pgg-gpg-user-id))))
23f87bed MB	260	(args '("--batch" "--decrypt")))
	261	(pgg-gpg-process-region start end passphrase pgg-gpg-program args)
	262	(with-current-buffer pgg-errors-buffer
	263	(pgg-gpg-possibly-cache-passphrase passphrase pgg-gpg-user-id)
	264	(goto-char (point-min))
	265	(re-search-forward "^\\[GNUPG:] DECRYPTION_OKAY\\>" nil t))))
	266
df570e6f EZ	267	;;;###autoload
	268	(defun pgg-gpg-symmetric-key-p (message-keys)
	269	"True if decoded armor MESSAGE-KEYS has symmetric encryption indicator."
	270	(let (result)
	271	(dolist (key message-keys result)
	272	(when (and (eq (car key) 3)
	273	(member '(symmetric-key-algorithm) key))
	274	(setq result key)))))
	275
23f87bed MB	276	(defun pgg-gpg-select-matching-key (message-keys secret-keys)
	277	"Choose a key from MESSAGE-KEYS that matches one of the keys in SECRET-KEYS."
	278	(loop for message-key in message-keys
	279	for message-key-id = (and (equal (car message-key) 1)
df570e6f	280	(cdr (assq 'key-identifier
7b97a7a5	281	(cdr message-key))))
23f87bed MB	282	for key = (and message-key-id (pgg-lookup-key message-key-id 'encrypt))
	283	when (and key (member key secret-keys)) return key))
	284
df570e6f	285	(defun pgg-gpg-sign-region (start end &optional cleartext passphrase)
23f87bed MB	286	"Make detached signature from text between START and END."
23f87bed MB	287	(let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
df570e6f	288	(passphrase (or passphrase
e563e53b SJ	289	(when (not pgg-gpg-use-agent)
	290	(pgg-read-passphrase
	291	(format "GnuPG passphrase for %s: "
	292	pgg-gpg-user-id)
	293	pgg-gpg-user-id))))
23f87bed	294	(args
34128042 MB	295	(append (list (if cleartext "--clearsign" "--detach-sign")
	296	"--armor" "--batch" "--verbose"
	297	"--local-user" pgg-gpg-user-id)
	298	(if pgg-text-mode (list "--textmode"))))
23f87bed MB	299	(inhibit-read-only t)
23f87bed MB	300	buffer-read-only)
34128042	301	(pgg-gpg-process-region start end passphrase pgg-gpg-program args)
23f87bed MB	302	(with-current-buffer pgg-errors-buffer
	303	;; Possibly cache passphrase under, e.g. "jas", for future sign.
	304	(pgg-gpg-possibly-cache-passphrase passphrase pgg-gpg-user-id)
	305	;; Possibly cache passphrase under, e.g. B565716F, for future decrypt.
	306	(pgg-gpg-possibly-cache-passphrase passphrase))
	307	(pgg-process-when-success)))
	308
	309	(defun pgg-gpg-verify-region (start end &optional signature)
	310	"Verify region between START and END as the detached signature SIGNATURE."
	311	(let ((args '("--batch" "--verify")))
	312	(when (stringp signature)
	313	(setq args (append args (list signature))))
	314	(setq args (append args '("-")))
	315	(pgg-gpg-process-region start end nil pgg-gpg-program args)
	316	(with-current-buffer pgg-errors-buffer
	317	(goto-char (point-min))
	318	(while (re-search-forward "^gpg: \\(.*\\)\n" nil t)
	319	(with-current-buffer pgg-output-buffer
	320	(insert-buffer-substring pgg-errors-buffer
	321	(match-beginning 1) (match-end 0)))
	322	(delete-region (match-beginning 0) (match-end 0)))
	323	(goto-char (point-min))
	324	(re-search-forward "^\\[GNUPG:] GOODSIG\\>" nil t))))
	325
	326	(defun pgg-gpg-insert-key ()
	327	"Insert public key at point."
	328	(let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
	329	(args (list "--batch" "--export" "--armor"
	330	pgg-gpg-user-id)))
	331	(pgg-gpg-process-region (point)(point) nil pgg-gpg-program args)
	332	(insert-buffer-substring pgg-output-buffer)))
	333
	334	(defun pgg-gpg-snarf-keys-region (start end)
	335	"Add all public keys in region between START and END to the keyring."
	336	(let ((args '("--import" "--batch" "-")) status)
	337	(pgg-gpg-process-region start end nil pgg-gpg-program args)
	338	(set-buffer pgg-errors-buffer)
	339	(goto-char (point-min))
	340	(when (re-search-forward "^\\[GNUPG:] IMPORT_RES\\>" nil t)
	341	(setq status (buffer-substring (match-end 0)
	342	(progn (end-of-line)(point)))
e9bd5782	343	status (vconcat (mapcar #'string-to-number (split-string status))))
23f87bed MB	344	(erase-buffer)
	345	(insert (format "Imported %d key(s).
	346	\tArmor contains %d key(s) [%d bad, %d old].\n"
	347	(+ (aref status 2)
	348	(aref status 10))
	349	(aref status 0)
	350	(aref status 1)
	351	(+ (aref status 4)
	352	(aref status 11)))
	353	(if (zerop (aref status 9))
	354	""
	355	"\tSecret keys are imported.\n")))
	356	(append-to-buffer pgg-output-buffer (point-min)(point-max))
	357	(pgg-process-when-success)))
	358
	359	(provide 'pgg-gpg)
	360
	361	;;; arch-tag: 2aa5d5d8-93a0-4865-9312-33e29830e000
	362	;;; pgg-gpg.el ends here