aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorSimon Josefsson2006-03-27 09:36:18 +0000
committerSimon Josefsson2006-03-27 09:36:18 +0000
commit276e274075547bc7e4c733b7c601fa47b066342e (patch)
tree1eba31709878b0377ca4fd7111beb834f2653d44
parent05e4f54ccad590488027c95cedb7cce7509312fb (diff)
downloademacs-276e274075547bc7e4c733b7c601fa47b066342e.tar.gz
emacs-276e274075547bc7e4c733b7c601fa47b066342e.zip
2006-03-27 Daiki Ueno <ueno@unixuser.org>
* pgg-gpg.el: Invoke gpg asynchronous, to avoid querying for passphrases when it is not needed. (pgg-gpg-use-agent): Add, to hard code that pgg shouldn't wait for passphrase stuff from gpg, should only be necessary when you use gpg with a smartcard.
-rw-r--r--lisp/ChangeLog8
-rw-r--r--lisp/pgg-gpg.el480
2 files changed, 224 insertions, 264 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 6b5009b31e8..5acfa3096b8 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,11 @@
12006-03-27 Daiki Ueno <ueno@unixuser.org>
2
3 * pgg-gpg.el: Invoke gpg asynchronous, to avoid querying for
4 passphrases when it is not needed.
5 (pgg-gpg-use-agent): Add, to hard code that pgg shouldn't wait for
6 passphrase stuff from gpg, should only be necessary when you use
7 gpg with a smartcard.
8
12006-03-27 Nick Roberts <nickrob@snap.net.nz> 92006-03-27 Nick Roberts <nickrob@snap.net.nz>
2 10
3 * comint.el (comint-dynamic-list-completions): Allow user to 11 * comint.el (comint-dynamic-list-completions): Allow user to
diff --git a/lisp/pgg-gpg.el b/lisp/pgg-gpg.el
index ab91471a619..b171929ad41 100644
--- a/lisp/pgg-gpg.el
+++ b/lisp/pgg-gpg.el
@@ -4,8 +4,7 @@
4;; 2005, 2006 Free Software Foundation, Inc. 4;; 2005, 2006 Free Software Foundation, Inc.
5 5
6;; Author: Daiki Ueno <ueno@unixuser.org> 6;; Author: Daiki Ueno <ueno@unixuser.org>
7;; Symmetric encryption and gpg-agent support added by: 7;; Symmetric encryption support added by: Sascha Wilde <wilde@sha-bang.de>
8;; Sascha Wilde <wilde@sha-bang.de>
9;; Created: 1999/10/28 8;; Created: 1999/10/28
10;; Keywords: PGP, OpenPGP, GnuPG 9;; Keywords: PGP, OpenPGP, GnuPG
11 10
@@ -29,7 +28,6 @@
29;;; Code: 28;;; Code:
30 29
31(eval-when-compile 30(eval-when-compile
32 (require 'cl) ; for gpg macros
33 (require 'pgg)) 31 (require 'pgg))
34 32
35(defgroup pgg-gpg () 33(defgroup pgg-gpg ()
@@ -60,85 +58,183 @@
60(defvar pgg-gpg-user-id nil 58(defvar pgg-gpg-user-id nil
61 "GnuPG ID of your default identity.") 59 "GnuPG ID of your default identity.")
62 60
63(defun pgg-gpg-process-region (start end passphrase program args) 61(defvar pgg-gpg-user-id-alist nil
64 (let* ((use-agent (pgg-gpg-use-agent-p)) 62 "An alist mapping from key ID to user ID.")
65 (output-file-name (pgg-make-temp-file "pgg-output")) 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"))
66 (args 73 (args
67 `("--status-fd" "2" 74 (append (list "--no-tty"
68 ,@(if use-agent '("--use-agent") 75 "--status-fd" "1"
69 (if passphrase '("--passphrase-fd" "0"))) 76 "--command-fd" "0"
70 "--yes" ; overwrite 77 "--yes" ; overwrite
71 "--output" ,output-file-name 78 "--output" output-file-name)
72 ,@pgg-gpg-extra-args ,@args)) 79 (if pgg-gpg-use-agent '("--use-agent"))
73 (output-buffer pgg-output-buffer) 80 pgg-gpg-extra-args
74 (errors-buffer pgg-errors-buffer) 81 args))
75 (orig-mode (default-file-modes)) 82 (coding-system-for-write 'binary)
76 (process-connection-type nil) 83 (process-connection-type nil)
77 exit-status) 84 (orig-mode (default-file-modes))
78 (with-current-buffer (get-buffer-create errors-buffer) 85 default-enable-multibyte-characters
79 (buffer-disable-undo) 86 (buffer (generate-new-buffer " *pgg-gpg*"))
80 (erase-buffer)) 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))
81 (unwind-protect 99 (unwind-protect
82 (progn 100 (progn
83 (set-default-file-modes 448) 101 (set-default-file-modes 448)
84 (let ((coding-system-for-write 'binary) 102 (setq process
85 (input (buffer-substring-no-properties start end)) 103 (apply #'start-process "pgg-gpg" buffer pgg-gpg-program args)))
86 (default-enable-multibyte-characters nil)) 104 (set-default-file-modes orig-mode))
87 (with-temp-buffer 105 (set-process-filter process #'pgg-gpg-process-filter)
88 (when passphrase 106 (set-process-sentinel process #'pgg-gpg-process-sentinel)
89 (insert passphrase "\n")) 107 process))
90 (insert input) 108
91 (setq exit-status 109(defun pgg-gpg-process-filter (process input)
92 (apply #'call-process-region (point-min) (point-max) program 110 (save-excursion
93 nil errors-buffer nil args)))) 111 (if pgg-gpg-debug
94 (with-current-buffer (get-buffer-create output-buffer) 112 (save-excursion
95 (buffer-disable-undo) 113 (set-buffer (get-buffer-create " *pgg-gpg-debug*"))
96 (erase-buffer) 114 (goto-char (point-max))
97 (if (file-exists-p output-file-name) 115 (insert input)))
98 (let ((coding-system-for-read (if pgg-text-mode 116 (set-buffer (process-buffer process))
99 'raw-text 117 (goto-char (point-max))
100 'binary))) 118 (insert input)
101 (insert-file-contents output-file-name))) 119 (goto-char pgg-gpg-read-point)
102 (set-buffer errors-buffer) 120 (beginning-of-line)
103 (if (not (equal exit-status 0)) 121 (while (looking-at ".*\n") ;the input line is finished
104 (insert (format "\n%s exited abnormally: '%s'\n" 122 (save-excursion
105 program exit-status))))) 123 (if (looking-at "\\[GNUPG:] \\([A-Z_]+\\)\\>.*")
106 (if (file-exists-p output-file-name) 124 (let* ((status (match-string 1))
107 (delete-file output-file-name)) 125 (symbol (intern-soft (concat "pgg-gpg-status-" status)))
108 (set-default-file-modes orig-mode)))) 126 (entry (member status pgg-gpg-pending-status-list)))
109 127 (if entry
110(defun pgg-gpg-possibly-cache-passphrase (passphrase &optional key notruncate) 128 (setq pgg-gpg-pending-status-list
111 (if (and passphrase 129 (delq (car entry)
112 pgg-cache-passphrase 130 pgg-gpg-pending-status-list)))
113 (progn 131 (if (and symbol
114 (goto-char (point-min)) 132 (fboundp symbol))
115 (re-search-forward "^\\[GNUPG:] \\(GOOD_PASSPHRASE\\>\\)\\|\\(SIG_CREATED\\)" nil t))) 133 (funcall symbol process (buffer-substring (match-beginning 1)
116 (pgg-add-passphrase-to-cache 134 (match-end 0)))))))
117 (or key 135 (forward-line))
118 (progn 136 (setq pgg-gpg-read-point (point))))
119 (goto-char (point-min)) 137
120 (if (re-search-forward 138(defun pgg-gpg-process-sentinel (process status)
121 "^\\[GNUPG:] NEED_PASSPHRASE\\(_PIN\\)? \\w+ ?\\w*" nil t) 139 (set-process-filter process nil)
122 (substring (match-string 0) -8)))) 140 (save-excursion
123 passphrase 141 ;; Copy the contents of process-buffer to pgg-errors-buffer.
124 notruncate))) 142 (set-buffer (get-buffer-create pgg-errors-buffer))
125 143 (buffer-disable-undo)
126(defvar pgg-gpg-all-secret-keys 'unknown) 144 (erase-buffer)
127 145 (when (buffer-live-p (process-buffer process))
128(defun pgg-gpg-lookup-all-secret-keys () 146 (insert-buffer-substring (process-buffer process))
129 "Return all secret keys present in secret key ring." 147 (goto-char (point-min))
130 (when (eq pgg-gpg-all-secret-keys 'unknown) 148 (delete-matching-lines "^\\[GNUPG:] ")
131 (setq pgg-gpg-all-secret-keys '()) 149 (goto-char (point-min))
132 (let ((args (list "--with-colons" "--no-greeting" "--batch" 150 (while (re-search-forward "^gpg: " nil t)
133 "--list-secret-keys"))) 151 (replace-match "")))
134 (with-temp-buffer 152 ;; Read the contents of the output file to pgg-output-buffer.
135 (apply #'call-process pgg-gpg-program nil t nil args) 153 (set-buffer (get-buffer-create pgg-output-buffer))
154 (buffer-disable-undo)
155 (erase-buffer)
156 (if (and (equal status "finished\n")
157 (buffer-live-p (process-buffer process)))
158 (let ((output-file-name (with-current-buffer (process-buffer process)
159 pgg-gpg-output-file-name)))
160 (when (file-exists-p output-file-name)
161 (let ((coding-system-for-read (if pgg-text-mode
162 'raw-text
163 'binary)))
164 (insert-file-contents output-file-name))
165 (delete-file output-file-name))))))
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
174(defun pgg-gpg-wait-for-completion (process &optional status-list)
175 (process-send-eof process)
176 (while (eq (process-status process) 'run)
177 (sit-for 0.1))
178 (save-excursion
179 (set-buffer (process-buffer process))
180 (setq status-list (copy-sequence status-list))
181 (let ((pointer status-list))
182 (while pointer
136 (goto-char (point-min)) 183 (goto-char (point-min))
137 (while (re-search-forward 184 (unless (re-search-forward
138 "^\\(sec\\|pub\\):[^:]*:[^:]*:[^:]*:\\([^:]*\\)" nil t) 185 (concat "^\\[GNUPG:] " (car pointer) "\\>")
139 (push (substring (match-string 2) 8) 186 nil t)
140 pgg-gpg-all-secret-keys))))) 187 (setq status-list (delq (car pointer) status-list)))
141 pgg-gpg-all-secret-keys) 188 (setq pointer (cdr pointer))))
189 (kill-buffer (process-buffer process))
190 status-list))
191
192(defun pgg-gpg-status-USERID_HINT (process line)
193 (if (string-match "\\`USERID_HINT \\([^ ]+\\) \\(.*\\)" line)
194 (let* ((key-id (match-string 1 line))
195 (user-id (match-string 2 line))
196 (entry (assoc key-id pgg-gpg-user-id-alist)))
197 (if entry
198 (setcdr entry user-id)
199 (setq pgg-gpg-user-id-alist (cons (cons key-id user-id)
200 pgg-gpg-user-id-alist))))))
201
202(defun pgg-gpg-status-NEED_PASSPHRASE (process line)
203 (if (string-match "\\`NEED_PASSPHRASE \\([^ ]+\\)" line)
204 (setq pgg-gpg-key-id (match-string 1 line))))
205
206(defun pgg-gpg-status-NEED_PASSPHRASE_SYM (process line)
207 (setq pgg-gpg-key-id 'SYM))
208
209(defun pgg-gpg-status-NEED_PASSPHRASE_PIN (process line)
210 (setq pgg-gpg-key-id 'PIN))
211
212(defun pgg-gpg-status-GET_HIDDEN (process line)
213 (let ((entry (assoc pgg-gpg-key-id pgg-gpg-user-id-alist)))
214 (if (setq pgg-gpg-passphrase
215 (if (eq pgg-gpg-key-id 'SYM)
216 (pgg-read-passphrase
217 "GnuPG passphrase for symmetric encryption: ")
218 (pgg-read-passphrase
219 (format "GnuPG passphrase for %s: "
220 (if entry
221 (cdr entry)
222 pgg-gpg-key-id))
223 (if (eq pgg-gpg-key-id 'PIN)
224 "PIN"
225 pgg-gpg-key-id))))
226 (process-send-string process (concat pgg-gpg-passphrase "\n")))))
227
228(defun pgg-gpg-status-GOOD_PASSPHRASE (process line)
229 (when (and pgg-gpg-passphrase
230 (stringp pgg-gpg-key-id))
231 (pgg-add-passphrase-to-cache pgg-gpg-key-id pgg-gpg-passphrase)
232 (setq pgg-gpg-passphrase nil)))
233
234(defun pgg-gpg-status-BAD_PASSPHRASE (process line)
235 (when pgg-gpg-passphrase
236 (fillarray pgg-gpg-passphrase 0)
237 (setq pgg-gpg-passphrase nil)))
142 238
143(defun pgg-gpg-lookup-key (string &optional type) 239(defun pgg-gpg-lookup-key (string &optional type)
144 "Search keys associated with STRING." 240 "Search keys associated with STRING."
@@ -152,52 +248,15 @@
152 nil t) 248 nil t)
153 (substring (match-string 2) 8))))) 249 (substring (match-string 2) 8)))))
154 250
155(defun pgg-gpg-lookup-key-owner (string &optional all)
156 "Search keys associated with STRING and return owner of identified key.
157
158The value may be just the bare key id, or it may be a combination of the
159user name associated with the key and the key id, with the key id enclosed
160in \"<...>\" angle brackets.
161
162Optional 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))
166 (key-regexp (concat "^\\(sec\\|pub\\)"
167 ":[^:]*:[^:]*:[^:]*:\\([^:]*\\):[^:]*"
168 ":[^:]*:[^:]*:[^:]*:\\([^:]*\\):")))
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
173 nil t)
174 (match-string 3)))))
175
176(defun pgg-gpg-key-id-from-key-owner (key-owner)
177 (cond ((not key-owner) nil)
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)))
182
183(defun pgg-gpg-encrypt-region (start end recipients &optional sign passphrase) 251(defun pgg-gpg-encrypt-region (start end recipients &optional sign passphrase)
184 "Encrypt the current region between START and END. 252 "Encrypt the current region between START and END.
185 253
186If optional argument SIGN is non-nil, do a combined sign and encrypt. 254If optional argument SIGN is non-nil, do a combined sign and encrypt."
187
188If optional PASSPHRASE is not specified, it will be obtained from the
189passphrase cache or user."
190 (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id)) 255 (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
191 (passphrase (or passphrase
192 (when (and sign (not (pgg-gpg-use-agent-p)))
193 (pgg-read-passphrase
194 (format "GnuPG passphrase for %s: "
195 pgg-gpg-user-id)
196 pgg-gpg-user-id))))
197 (args 256 (args
198 (append 257 (append
199 (list "--batch" "--armor" "--always-trust" "--encrypt") 258 '("--armor" "--always-trust" "--encrypt")
200 (if pgg-text-mode (list "--textmode")) 259 (if pgg-text-mode '("--textmode"))
201 (if sign (list "--sign" "--local-user" pgg-gpg-user-id)) 260 (if sign (list "--sign" "--local-user" pgg-gpg-user-id))
202 (if recipients 261 (if recipients
203 (apply #'nconc 262 (apply #'nconc
@@ -205,178 +264,71 @@ passphrase cache or user."
205 (list pgg-gpg-recipient-argument rcpt)) 264 (list pgg-gpg-recipient-argument rcpt))
206 (append recipients 265 (append recipients
207 (if pgg-encrypt-for-me 266 (if pgg-encrypt-for-me
208 (list pgg-gpg-user-id))))))))) 267 (list pgg-gpg-user-id))))))))
209 (pgg-gpg-process-region start end passphrase pgg-gpg-program args) 268 (process (pgg-gpg-start-process args)))
210 (when sign 269 (if (and sign (not pgg-gpg-use-agent))
211 (with-current-buffer pgg-errors-buffer 270 (pgg-gpg-wait-for-status process '("GOOD_PASSPHRASE")))
212 ;; Possibly cache passphrase under, e.g. "jas", for future sign. 271 (process-send-region process start end)
213 (pgg-gpg-possibly-cache-passphrase passphrase pgg-gpg-user-id) 272 (pgg-gpg-wait-for-completion process '("SIG_CREATED" "END_ENCRYPTION"))))
214 ;; Possibly cache passphrase under, e.g. B565716F, for future decrypt.
215 (pgg-gpg-possibly-cache-passphrase passphrase)))
216 (pgg-process-when-success)))
217 273
218(defun pgg-gpg-encrypt-symmetric-region (start end &optional passphrase) 274(defun pgg-gpg-encrypt-symmetric-region (start end &optional passphrase)
219 "Encrypt the current region between START and END with symmetric cipher. 275 "Encrypt the current region between START and END with symmetric cipher."
220 276 (let* ((args
221If optional PASSPHRASE is not specified, it will be obtained from the 277 (append '("--armor" "--symmetric")
222passphrase cache or user." 278 (if pgg-text-mode '("--textmode"))))
223 (let* ((passphrase (or passphrase 279 (process (pgg-gpg-start-process args)))
224 (when (not (pgg-gpg-use-agent-p)) 280 (pgg-gpg-wait-for-status process '("BEGIN_ENCRYPTION"))
225 (pgg-read-passphrase 281 (process-send-region process start end)
226 "GnuPG passphrase for symmetric encryption: ")))) 282 (pgg-gpg-wait-for-completion process '("END_ENCRYPTION"))))
227 (args
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)
231 (pgg-process-when-success)))
232 283
233(defun pgg-gpg-decrypt-region (start end &optional passphrase) 284(defun pgg-gpg-decrypt-region (start end &optional passphrase)
234 "Decrypt the current region between START and END. 285 "Decrypt the current region between START and END."
235 286 (let* ((args '("--decrypt"))
236If optional PASSPHRASE is not specified, it will be obtained from the 287 (process (pgg-gpg-start-process args)))
237passphrase cache or user." 288 (process-send-region process start end)
238 (let* ((current-buffer (current-buffer)) 289 (pgg-gpg-wait-for-status process '("BEGIN_DECRYPTION"))
239 (message-keys (with-temp-buffer 290 (pgg-gpg-wait-for-completion process '("GOODSIG" "DECRYPTION_OKAY"))))
240 (insert-buffer-substring current-buffer)
241 (pgg-decode-armor-region (point-min) (point-max))))
242 (secret-keys (pgg-gpg-lookup-all-secret-keys))
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.
247 (key (pgg-gpg-select-matching-key message-keys secret-keys))
248 (key-owner (and key (pgg-gpg-lookup-key-owner key t)))
249 (key-id (pgg-gpg-key-id-from-key-owner key-owner))
250 (pgg-gpg-user-id (or key-id key
251 pgg-gpg-user-id pgg-default-user-id))
252 (passphrase (or passphrase
253 (when (not (pgg-gpg-use-agent-p))
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))))
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
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
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)
280 (cdr (assq 'key-identifier
281 (cdr message-key))))
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 291
285(defun pgg-gpg-sign-region (start end &optional cleartext passphrase) 292(defun pgg-gpg-sign-region (start end &optional cleartext passphrase)
286 "Make detached signature from text between START and END." 293 "Make detached signature from text between START and END."
287 (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id)) 294 (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
288 (passphrase (or passphrase
289 (when (not (pgg-gpg-use-agent-p))
290 (pgg-read-passphrase
291 (format "GnuPG passphrase for %s: "
292 pgg-gpg-user-id)
293 pgg-gpg-user-id))))
294 (args 295 (args
295 (append (list (if cleartext "--clearsign" "--detach-sign") 296 (append (list (if cleartext "--clearsign" "--detach-sign")
296 "--armor" "--batch" "--verbose" 297 "--armor" "--verbose"
297 "--local-user" pgg-gpg-user-id) 298 "--local-user" pgg-gpg-user-id)
298 (if pgg-text-mode (list "--textmode")))) 299 (if pgg-text-mode '("--textmode"))))
299 (inhibit-read-only t) 300 (process (pgg-gpg-start-process args)))
300 buffer-read-only) 301 (unless pgg-gpg-use-agent
301 (pgg-gpg-process-region start end passphrase pgg-gpg-program args) 302 (pgg-gpg-wait-for-status process '("GOOD_PASSPHRASE")))
302 (with-current-buffer pgg-errors-buffer 303 (process-send-region process start end)
303 ;; Possibly cache passphrase under, e.g. "jas", for future sign. 304 (pgg-gpg-wait-for-completion process '("SIG_CREATED"))))
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 305
309(defun pgg-gpg-verify-region (start end &optional signature) 306(defun pgg-gpg-verify-region (start end &optional signature)
310 "Verify region between START and END as the detached signature SIGNATURE." 307 "Verify region between START and END as the detached signature SIGNATURE."
311 (let ((args '("--batch" "--verify"))) 308 (let ((args '("--verify"))
309 process)
312 (when (stringp signature) 310 (when (stringp signature)
313 (setq args (append args (list signature)))) 311 (setq args (append args (list signature))))
314 (setq args (append args '("-"))) 312 (setq process (pgg-gpg-start-process (append args '("-"))))
315 (pgg-gpg-process-region start end nil pgg-gpg-program args) 313 (process-send-region process start end)
316 (with-current-buffer pgg-errors-buffer 314 (pgg-gpg-wait-for-completion process '("GOODSIG"))))
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 315
326(defun pgg-gpg-insert-key () 316(defun pgg-gpg-insert-key ()
327 "Insert public key at point." 317 "Insert public key at point."
328 (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id)) 318 (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
329 (args (list "--batch" "--export" "--armor" 319 (args (list "--export" "--armor"
330 pgg-gpg-user-id))) 320 pgg-gpg-user-id))
331 (pgg-gpg-process-region (point)(point) nil pgg-gpg-program args) 321 (process (pgg-gpg-start-process args)))
322 (pgg-gpg-wait-for-completion process)
332 (insert-buffer-substring pgg-output-buffer))) 323 (insert-buffer-substring pgg-output-buffer)))
333 324
334(defun pgg-gpg-snarf-keys-region (start end) 325(defun pgg-gpg-snarf-keys-region (start end)
335 "Add all public keys in region between START and END to the keyring." 326 "Add all public keys in region between START and END to the keyring."
336 (let ((args '("--import" "--batch" "-")) status) 327 (let* ((args '("--import" "-"))
337 (pgg-gpg-process-region start end nil pgg-gpg-program args) 328 (process (pgg-gpg-start-process args))
338 (set-buffer pgg-errors-buffer) 329 status)
339 (goto-char (point-min)) 330 (process-send-region process start end)
340 (when (re-search-forward "^\\[GNUPG:] IMPORT_RES\\>" nil t) 331 (pgg-gpg-wait-for-completion process '("IMPORT_RES"))))
341 (setq status (buffer-substring (match-end 0)
342 (progn (end-of-line)(point)))
343 status (vconcat (mapcar #'string-to-number (split-string status))))
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(defun pgg-gpg-update-agent ()
360 "Try to connet to gpg-agent and send UPDATESTARTUPTTY."
361 (if (fboundp 'make-network-process)
362 (let* ((agent-info (getenv "GPG_AGENT_INFO"))
363 (socket (and agent-info
364 (string-match "^\\([^:]*\\)" agent-info)
365 (match-string 1 agent-info)))
366 (conn (and socket
367 (make-network-process :name "gpg-agent-process"
368 :host 'local :family 'local
369 :service socket))))
370 (when (and conn (eq (process-status conn) 'open))
371 (process-send-string conn "UPDATESTARTUPTTY\n")
372 (delete-process conn)
373 t))
374 ;; We can't check, so assume gpg-agent is up.
375 t))
376
377(defun pgg-gpg-use-agent-p ()
378 "Return t if `pgg-gpg-use-agent' is t and gpg-agent is available."
379 (and pgg-gpg-use-agent (pgg-gpg-update-agent)))
380 332
381(provide 'pgg-gpg) 333(provide 'pgg-gpg)
382 334