aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRomain Francoise2006-04-06 18:01:16 +0000
committerRomain Francoise2006-04-06 18:01:16 +0000
commit30ceaa687f97c99e17b6854ef5d85f15b61c7d90 (patch)
treedf249a91718649bfc1b5b8798ce4a2927584fd87
parent6c07f4d42a4619442d56daffc62ac8e7343eb891 (diff)
downloademacs-30ceaa687f97c99e17b6854ef5d85f15b61c7d90.tar.gz
emacs-30ceaa687f97c99e17b6854ef5d85f15b61c7d90.zip
2006-04-06 Romain Francoise <romain@orebokech.com>
* pgg-gpg.el: Sync back with Gnus 5.10, reverting changes that add symmetric encryption features and a new asynchronous interface to GnuPG. This new version is version 1.4, plus whitespace changes.
-rw-r--r--lisp/ChangeLog6
-rw-r--r--lisp/pgg-gpg.el468
2 files changed, 237 insertions, 237 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 78a9090e802..13ea0be22eb 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
12006-04-06 Romain Francoise <romain@orebokech.com>
2
3 * pgg-gpg.el: Sync back with Gnus 5.10, reverting changes that add
4 symmetric encryption features and a new asynchronous interface to
5 GnuPG. This new version is version 1.4, plus whitespace changes.
6
12006-04-06 Reiner Steib <Reiner.Steib@gmx.de> 72006-04-06 Reiner Steib <Reiner.Steib@gmx.de>
2 8
3 * files.el: Move some `safe-local-variable' declarations to the 9 * files.el: Move some `safe-local-variable' declarations to the
diff --git a/lisp/pgg-gpg.el b/lisp/pgg-gpg.el
index d8ceeabc25f..78db15787c0 100644
--- a/lisp/pgg-gpg.el
+++ b/lisp/pgg-gpg.el
@@ -4,7 +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 support added by: Sascha Wilde <wilde@sha-bang.de> 7;; Symmetric encryption added by: Sascha Wilde <wilde@sha-bang.de>
8;; Created: 1999/10/28 8;; Created: 1999/10/28
9;; Keywords: PGP, OpenPGP, GnuPG 9;; Keywords: PGP, OpenPGP, GnuPG
10 10
@@ -28,6 +28,7 @@
28;;; Code: 28;;; Code:
29 29
30(eval-when-compile 30(eval-when-compile
31 (require 'cl) ; for gpg macros
31 (require 'pgg)) 32 (require 'pgg))
32 33
33(defgroup pgg-gpg () 34(defgroup pgg-gpg ()
@@ -50,180 +51,85 @@
50 :type '(choice (const :tag "New `--recipient' option" "--recipient") 51 :type '(choice (const :tag "New `--recipient' option" "--recipient")
51 (const :tag "Old `--remote-user' option" "--remote-user"))) 52 (const :tag "Old `--remote-user' option" "--remote-user")))
52 53
53(defcustom pgg-gpg-use-agent nil
54 "Whether to use gnupg agent for key caching."
55 :group 'pgg-gpg
56 :type 'boolean)
57
58(defvar pgg-gpg-user-id nil 54(defvar pgg-gpg-user-id nil
59 "GnuPG ID of your default identity.") 55 "GnuPG ID of your default identity.")
60 56
61(defvar pgg-gpg-user-id-alist nil 57(defun pgg-gpg-process-region (start end passphrase program args)
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")) 58 (let* ((output-file-name (pgg-make-temp-file "pgg-output"))
73 (args 59 (args
74 (append (list "--no-tty" 60 `("--status-fd" "2"
75 "--status-fd" "1" 61 ,@(if passphrase '("--passphrase-fd" "0"))
76 "--command-fd" "0" 62 "--yes" ; overwrite
77 "--yes" ; overwrite 63 "--output" ,output-file-name
78 "--output" output-file-name) 64 ,@pgg-gpg-extra-args ,@args))
79 (if pgg-gpg-use-agent '("--use-agent")) 65 (output-buffer pgg-output-buffer)
80 pgg-gpg-extra-args 66 (errors-buffer pgg-errors-buffer)
81 args))
82 (coding-system-for-write 'binary)
83 (process-connection-type nil)
84 (orig-mode (default-file-modes)) 67 (orig-mode (default-file-modes))
85 (buffer (generate-new-buffer " *pgg-gpg*")) 68 (process-connection-type nil)
86 process) 69 exit-status)
87 (with-current-buffer buffer 70 (with-current-buffer (get-buffer-create errors-buffer)
88 (make-local-variable 'pgg-gpg-read-point) 71 (buffer-disable-undo)
89 (setq pgg-gpg-read-point (point-min)) 72 (erase-buffer))
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))
98 (unwind-protect 73 (unwind-protect
99 (progn 74 (progn
100 (set-default-file-modes 448) 75 (set-default-file-modes 448)
101 (setq process 76 (let ((coding-system-for-write 'binary)
102 (apply #'start-process "pgg-gpg" buffer pgg-gpg-program args))) 77 (input (buffer-substring-no-properties start end))
103 (set-default-file-modes orig-mode)) 78 (default-enable-multibyte-characters nil))
104 (set-process-filter process #'pgg-gpg-process-filter) 79 (with-temp-buffer
105 (set-process-sentinel process #'pgg-gpg-process-sentinel) 80 (when passphrase
106 process)) 81 (insert passphrase "\n"))
107 82 (insert input)
108(defun pgg-gpg-process-filter (process input) 83 (setq exit-status
109 (if pgg-gpg-debug 84 (apply #'call-process-region (point-min) (point-max) program
110 (save-excursion 85 nil errors-buffer nil args))))
111 (set-buffer (get-buffer-create " *pgg-gpg-debug*")) 86 (with-current-buffer (get-buffer-create output-buffer)
112 (goto-char (point-max)) 87 (buffer-disable-undo)
113 (insert input))) 88 (erase-buffer)
114 (if (buffer-live-p (process-buffer process)) 89 (if (file-exists-p output-file-name)
115 (save-excursion
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))
133 (funcall symbol process (buffer-substring
134 (match-beginning 1)
135 (match-end 0)))))))
136 (forward-line))
137 (setq pgg-gpg-read-point (point)))))
138
139(defun pgg-gpg-process-sentinel (process status)
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 90 (let ((coding-system-for-read (if pgg-text-mode
161 'raw-text 91 'raw-text
162 'binary))) 92 'binary)))
163 (insert-file-contents output-file-name)) 93 (insert-file-contents output-file-name)))
164 (delete-file output-file-name)))) 94 (set-buffer errors-buffer)
165 (kill-buffer (process-buffer process))))) 95 (if (not (equal exit-status 0))
166 96 (insert (format "\n%s exited abnormally: '%s'\n"
167(defun pgg-gpg-wait-for-status (process status-list) 97 program exit-status)))))
168 (with-current-buffer (process-buffer process) 98 (if (file-exists-p output-file-name)
169 (setq pgg-gpg-pending-status-list status-list) 99 (delete-file output-file-name))
170 (while (and (eq (process-status process) 'run) 100 (set-default-file-modes orig-mode))))
171 pgg-gpg-pending-status-list) 101
172 (accept-process-output process 1)))) 102(defun pgg-gpg-possibly-cache-passphrase (passphrase &optional key notruncate)
173 103 (if (and pgg-cache-passphrase
174(defun pgg-gpg-wait-for-completion (process) 104 (progn
175 (process-send-eof process) 105 (goto-char (point-min))
176 (while (eq (process-status process) 'run) 106 (re-search-forward "^\\[GNUPG:] \\(GOOD_PASSPHRASE\\>\\)\\|\\(SIG_CREATED\\)" nil t)))
177 ;; We can't use accept-process-output instead of sit-for here 107 (pgg-add-passphrase-to-cache
178 ;; because it may cause an interrupt during the sentinel execution. 108 (or key
179 (sit-for 0.1))) 109 (progn
180 110 (goto-char (point-min))
181(defun pgg-gpg-status-USERID_HINT (process line) 111 (if (re-search-forward
182 (if (string-match "\\`USERID_HINT \\([^ ]+\\) \\(.*\\)" line) 112 "^\\[GNUPG:] NEED_PASSPHRASE\\(_PIN\\)? \\w+ ?\\w*" nil t)
183 (let* ((key-id (match-string 1 line)) 113 (substring (match-string 0) -8))))
184 (user-id (match-string 2 line)) 114 passphrase
185 (entry (assoc key-id pgg-gpg-user-id-alist))) 115 notruncate)))
186 (if entry 116
187 (setcdr entry user-id) 117(defvar pgg-gpg-all-secret-keys 'unknown)
188 (setq pgg-gpg-user-id-alist (cons (cons key-id user-id) 118
189 pgg-gpg-user-id-alist)))))) 119(defun pgg-gpg-lookup-all-secret-keys ()
190 120 "Return all secret keys present in secret key ring."
191(defun pgg-gpg-status-NEED_PASSPHRASE (process line) 121 (when (eq pgg-gpg-all-secret-keys 'unknown)
192 (if (string-match "\\`NEED_PASSPHRASE \\([^ ]+\\)" line) 122 (setq pgg-gpg-all-secret-keys '())
193 (setq pgg-gpg-key-id (match-string 1 line)))) 123 (let ((args (list "--with-colons" "--no-greeting" "--batch"
194 124 "--list-secret-keys")))
195(defun pgg-gpg-status-NEED_PASSPHRASE_SYM (process line) 125 (with-temp-buffer
196 (setq pgg-gpg-key-id 'SYM)) 126 (apply #'call-process pgg-gpg-program nil t nil args)
197 127 (goto-char (point-min))
198(defun pgg-gpg-status-NEED_PASSPHRASE_PIN (process line) 128 (while (re-search-forward
199 (setq pgg-gpg-key-id 'PIN)) 129 "^\\(sec\\|pub\\):[^:]*:[^:]*:[^:]*:\\([^:]*\\)" nil t)
200 130 (push (substring (match-string 2) 8)
201(defun pgg-gpg-status-GET_HIDDEN (process line) 131 pgg-gpg-all-secret-keys)))))
202 (let ((entry (assoc pgg-gpg-key-id pgg-gpg-user-id-alist))) 132 pgg-gpg-all-secret-keys)
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)))
227 133
228(defun pgg-gpg-lookup-key (string &optional type) 134(defun pgg-gpg-lookup-key (string &optional type)
229 "Search keys associated with STRING." 135 "Search keys associated with STRING."
@@ -237,15 +143,52 @@
237 nil t) 143 nil t)
238 (substring (match-string 2) 8))))) 144 (substring (match-string 2) 8)))))
239 145
146(defun pgg-gpg-lookup-key-owner (string &optional all)
147 "Search keys associated with STRING and return owner of identified key.
148
149The value may be just the bare key id, or it may be a combination of the
150user name associated with the key and the key id, with the key id enclosed
151in \"<...>\" angle brackets.
152
153Optional ALL non-nil means search all keys, including secret keys."
154 (let ((args (list "--with-colons" "--no-greeting" "--batch"
155 (if all "--list-secret-keys" "--list-keys")
156 string))
157 (key-regexp (concat "^\\(sec\\|pub\\)"
158 ":[^:]*:[^:]*:[^:]*:\\([^:]*\\):[^:]*"
159 ":[^:]*:[^:]*:[^:]*:\\([^:]*\\):")))
160 (with-temp-buffer
161 (apply #'call-process pgg-gpg-program nil t nil args)
162 (goto-char (point-min))
163 (if (re-search-forward key-regexp
164 nil t)
165 (match-string 3)))))
166
167(defun pgg-gpg-key-id-from-key-owner (key-owner)
168 (cond ((not key-owner) nil)
169 ;; Extract bare key id from outermost paired angle brackets, if any:
170 ((string-match "[^<]*<\\(.+\\)>[^>]*" key-owner)
171 (substring key-owner (match-beginning 1)(match-end 1)))
172 (key-owner)))
173
240(defun pgg-gpg-encrypt-region (start end recipients &optional sign passphrase) 174(defun pgg-gpg-encrypt-region (start end recipients &optional sign passphrase)
241 "Encrypt the current region between START and END. 175 "Encrypt the current region between START and END.
242 176
243If optional argument SIGN is non-nil, do a combined sign and encrypt." 177If optional argument SIGN is non-nil, do a combined sign and encrypt.
178
179If optional PASSPHRASE is not specified, it will be obtained from the
180passphrase cache or user."
244 (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id)) 181 (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
182 (passphrase (or passphrase
183 (when sign
184 (pgg-read-passphrase
185 (format "GnuPG passphrase for %s: "
186 pgg-gpg-user-id)
187 pgg-gpg-user-id))))
245 (args 188 (args
246 (append 189 (append
247 '("--armor" "--always-trust" "--encrypt") 190 (list "--batch" "--armor" "--always-trust" "--encrypt")
248 (if pgg-text-mode '("--textmode")) 191 (if pgg-text-mode (list "--textmode"))
249 (if sign (list "--sign" "--local-user" pgg-gpg-user-id)) 192 (if sign (list "--sign" "--local-user" pgg-gpg-user-id))
250 (if recipients 193 (if recipients
251 (apply #'nconc 194 (apply #'nconc
@@ -253,101 +196,152 @@ If optional argument SIGN is non-nil, do a combined sign and encrypt."
253 (list pgg-gpg-recipient-argument rcpt)) 196 (list pgg-gpg-recipient-argument rcpt))
254 (append recipients 197 (append recipients
255 (if pgg-encrypt-for-me 198 (if pgg-encrypt-for-me
256 (list pgg-gpg-user-id)))))))) 199 (list pgg-gpg-user-id)))))))))
257 (process (pgg-gpg-start-process args))) 200 (pgg-gpg-process-region start end passphrase pgg-gpg-program args)
258 (if (and sign (not pgg-gpg-use-agent)) 201 (when sign
259 (pgg-gpg-wait-for-status process '("BEGIN_SIGNING" "GOOD_PASSPHRASE"))) 202 (with-current-buffer pgg-errors-buffer
260 (process-send-region process start end) 203 ;; Possibly cache passphrase under, e.g. "jas", for future sign.
261 (pgg-gpg-wait-for-completion process) 204 (pgg-gpg-possibly-cache-passphrase passphrase pgg-gpg-user-id)
262 (save-excursion 205 ;; Possibly cache passphrase under, e.g. B565716F, for future decrypt.
263 (set-buffer (get-buffer-create pgg-errors-buffer)) 206 (pgg-gpg-possibly-cache-passphrase passphrase)))
264 (goto-char (point-max)) 207 (pgg-process-when-success)))
265 (not (null (re-search-backward "^\\[GNUPG:] END_ENCRYPTION\\>"
266 nil t))))))
267 208
268(defun pgg-gpg-encrypt-symmetric-region (start end &optional passphrase) 209(defun pgg-gpg-encrypt-symmetric-region (start end &optional passphrase)
269 "Encrypt the current region between START and END with symmetric cipher." 210 "Encrypt the current region between START and END with symmetric cipher.
270 (let* ((args 211
271 (append '("--armor" "--symmetric") 212If optional PASSPHRASE is not specified, it will be obtained from the
272 (if pgg-text-mode '("--textmode")))) 213passphrase cache or user."
273 (process (pgg-gpg-start-process args))) 214 (let* ((passphrase (or passphrase
274 (pgg-gpg-wait-for-status process '("BEGIN_ENCRYPTION")) 215 (pgg-read-passphrase
275 (process-send-region process start end) 216 "GnuPG passphrase for symmetric encryption: ")))
276 (pgg-gpg-wait-for-completion process) 217 (args
277 (save-excursion 218 (append (list "--batch" "--armor" "--symmetric" )
278 (set-buffer (get-buffer-create pgg-errors-buffer)) 219 (if pgg-text-mode (list "--textmode")))))
279 (goto-char (point-max)) 220 (pgg-gpg-process-region start end passphrase pgg-gpg-program args)
280 (not (null (re-search-backward "^\\[GNUPG:] END_ENCRYPTION\\>" 221 (pgg-process-when-success)))
281 nil t))))))
282 222
283(defun pgg-gpg-decrypt-region (start end &optional passphrase) 223(defun pgg-gpg-decrypt-region (start end &optional passphrase)
284 "Decrypt the current region between START and END." 224 "Decrypt the current region between START and END.
285 (let* ((args '("--decrypt")) 225
286 (process (pgg-gpg-start-process args))) 226If optional PASSPHRASE is not specified, it will be obtained from the
287 (process-send-region process start end) 227passphrase cache or user."
288 (pgg-gpg-wait-for-status process '("BEGIN_DECRYPTION")) 228 (let* ((current-buffer (current-buffer))
289 (pgg-gpg-wait-for-completion process) 229 (message-keys (with-temp-buffer
290 (save-excursion 230 (insert-buffer-substring current-buffer)
291 (set-buffer (get-buffer-create pgg-errors-buffer)) 231 (pgg-decode-armor-region (point-min) (point-max))))
292 (goto-char (point-max)) 232 (secret-keys (pgg-gpg-lookup-all-secret-keys))
293 (not (null (re-search-backward "^\\[GNUPG:] DECRYPTION_OKAY\\>" 233 ;; XXX the user is stuck if they need to use the passphrase for
294 nil t)))))) 234 ;; any but the first secret key for which the message is
235 ;; encrypted. ideally, we would incrementally give them a
236 ;; chance with subsequent keys each time they fail with one.
237 (key (pgg-gpg-select-matching-key message-keys secret-keys))
238 (key-owner (and key (pgg-gpg-lookup-key-owner key t)))
239 (key-id (pgg-gpg-key-id-from-key-owner key-owner))
240 (pgg-gpg-user-id (or key-id key
241 pgg-gpg-user-id pgg-default-user-id))
242 (passphrase (or passphrase
243 (pgg-read-passphrase
244 (format (if (pgg-gpg-symmetric-key-p message-keys)
245 "Passphrase for symmetric decryption: "
246 "GnuPG passphrase for %s: ")
247 (or key-owner "??"))
248 pgg-gpg-user-id)))
249 (args '("--batch" "--decrypt")))
250 (pgg-gpg-process-region start end passphrase pgg-gpg-program args)
251 (with-current-buffer pgg-errors-buffer
252 (pgg-gpg-possibly-cache-passphrase passphrase pgg-gpg-user-id)
253 (goto-char (point-min))
254 (re-search-forward "^\\[GNUPG:] DECRYPTION_OKAY\\>" nil t))))
255
256;;;###autoload
257(defun pgg-gpg-symmetric-key-p (message-keys)
258 "True if decoded armor MESSAGE-KEYS has symmetric encryption indicator."
259 (let (result)
260 (dolist (key message-keys result)
261 (when (and (eq (car key) 3)
262 (member '(symmetric-key-algorithm) key))
263 (setq result key)))))
264
265(defun pgg-gpg-select-matching-key (message-keys secret-keys)
266 "Choose a key from MESSAGE-KEYS that matches one of the keys in SECRET-KEYS."
267 (loop for message-key in message-keys
268 for message-key-id = (and (equal (car message-key) 1)
269 (cdr (assq 'key-identifier
270 (cdr message-key))))
271 for key = (and message-key-id (pgg-lookup-key message-key-id 'encrypt))
272 when (and key (member key secret-keys)) return key))
295 273
296(defun pgg-gpg-sign-region (start end &optional cleartext passphrase) 274(defun pgg-gpg-sign-region (start end &optional cleartext passphrase)
297 "Make detached signature from text between START and END." 275 "Make detached signature from text between START and END."
298 (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id)) 276 (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
277 (passphrase (or passphrase
278 (pgg-read-passphrase
279 (format "GnuPG passphrase for %s: " pgg-gpg-user-id)
280 pgg-gpg-user-id)))
299 (args 281 (args
300 (append (list (if cleartext "--clearsign" "--detach-sign") 282 (append (list (if cleartext "--clearsign" "--detach-sign")
301 "--armor" "--verbose" 283 "--armor" "--batch" "--verbose"
302 "--local-user" pgg-gpg-user-id) 284 "--local-user" pgg-gpg-user-id)
303 (if pgg-text-mode '("--textmode")))) 285 (if pgg-text-mode (list "--textmode"))))
304 (process (pgg-gpg-start-process args))) 286 (inhibit-read-only t)
305 (unless pgg-gpg-use-agent 287 buffer-read-only)
306 (pgg-gpg-wait-for-status process '("BEGIN_SIGNING" "GOOD_PASSPHRASE"))) 288 (pgg-gpg-process-region start end passphrase pgg-gpg-program args)
307 (process-send-region process start end) 289 (with-current-buffer pgg-errors-buffer
308 (pgg-gpg-wait-for-completion process) 290 ;; Possibly cache passphrase under, e.g. "jas", for future sign.
309 (save-excursion 291 (pgg-gpg-possibly-cache-passphrase passphrase pgg-gpg-user-id)
310 (set-buffer (get-buffer-create pgg-errors-buffer)) 292 ;; Possibly cache passphrase under, e.g. B565716F, for future decrypt.
311 (goto-char (point-max)) 293 (pgg-gpg-possibly-cache-passphrase passphrase))
312 (not (null (re-search-backward "^\\[GNUPG:] SIG_CREATED\\>" 294 (pgg-process-when-success)))
313 nil t))))))
314 295
315(defun pgg-gpg-verify-region (start end &optional signature) 296(defun pgg-gpg-verify-region (start end &optional signature)
316 "Verify region between START and END as the detached signature SIGNATURE." 297 "Verify region between START and END as the detached signature SIGNATURE."
317 (let ((args '("--verify")) 298 (let ((args '("--batch" "--verify")))
318 process)
319 (when (stringp signature) 299 (when (stringp signature)
320 (setq args (append args (list signature)))) 300 (setq args (append args (list signature))))
321 (setq process (pgg-gpg-start-process (append args '("-")))) 301 (setq args (append args '("-")))
322 (process-send-region process start end) 302 (pgg-gpg-process-region start end nil pgg-gpg-program args)
323 (pgg-gpg-wait-for-completion process) 303 (with-current-buffer pgg-errors-buffer
324 (save-excursion 304 (goto-char (point-min))
325 (set-buffer (get-buffer-create pgg-errors-buffer)) 305 (while (re-search-forward "^gpg: \\(.*\\)\n" nil t)
326 (goto-char (point-max)) 306 (with-current-buffer pgg-output-buffer
327 (not (null (re-search-backward "^\\[GNUPG:] GOODSIG\\>" 307 (insert-buffer-substring pgg-errors-buffer
328 nil t)))))) 308 (match-beginning 1) (match-end 0)))
309 (delete-region (match-beginning 0) (match-end 0)))
310 (goto-char (point-min))
311 (re-search-forward "^\\[GNUPG:] GOODSIG\\>" nil t))))
329 312
330(defun pgg-gpg-insert-key () 313(defun pgg-gpg-insert-key ()
331 "Insert public key at point." 314 "Insert public key at point."
332 (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id)) 315 (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
333 (args (list "--export" "--armor" 316 (args (list "--batch" "--export" "--armor"
334 pgg-gpg-user-id)) 317 pgg-gpg-user-id)))
335 (process (pgg-gpg-start-process args))) 318 (pgg-gpg-process-region (point)(point) nil pgg-gpg-program args)
336 (pgg-gpg-wait-for-completion process)
337 (insert-buffer-substring pgg-output-buffer))) 319 (insert-buffer-substring pgg-output-buffer)))
338 320
339(defun pgg-gpg-snarf-keys-region (start end) 321(defun pgg-gpg-snarf-keys-region (start end)
340 "Add all public keys in region between START and END to the keyring." 322 "Add all public keys in region between START and END to the keyring."
341 (let* ((args '("--import" "-")) 323 (let ((args '("--import" "--batch" "-")) status)
342 (process (pgg-gpg-start-process args)) 324 (pgg-gpg-process-region start end nil pgg-gpg-program args)
343 status) 325 (set-buffer pgg-errors-buffer)
344 (process-send-region process start end) 326 (goto-char (point-min))
345 (pgg-gpg-wait-for-completion process) 327 (when (re-search-forward "^\\[GNUPG:] IMPORT_RES\\>" nil t)
346 (save-excursion 328 (setq status (buffer-substring (match-end 0)
347 (set-buffer (get-buffer-create pgg-errors-buffer)) 329 (progn (end-of-line)(point)))
348 (goto-char (point-max)) 330 status (vconcat (mapcar #'string-to-number (split-string status))))
349 (not (null (re-search-backward "^\\[GNUPG:] IMPORT_RES\\>" 331 (erase-buffer)
350 nil t)))))) 332 (insert (format "Imported %d key(s).
333\tArmor contains %d key(s) [%d bad, %d old].\n"
334 (+ (aref status 2)
335 (aref status 10))
336 (aref status 0)
337 (aref status 1)
338 (+ (aref status 4)
339 (aref status 11)))
340 (if (zerop (aref status 9))
341 ""
342 "\tSecret keys are imported.\n")))
343 (append-to-buffer pgg-output-buffer (point-min)(point-max))
344 (pgg-process-when-success)))
351 345
352(provide 'pgg-gpg) 346(provide 'pgg-gpg)
353 347