Mercurial > emacs

comparison lisp/pgg-gpg.el @ 69791:4192bb0fddd0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
2006-04-04 Daiki Ueno <ueno@unixuser.org> * pgg-gpg.el: Clean up process buffers every time gpg processes complete.
author Simon Josefsson <jas@extundo.com>
date Tue, 04 Apr 2006 10:34:03 +0000
parents b6e0fc8209f9
children 5c4a9226a577
comparison
equal deleted inserted replaced
69790:1e68e7f3b824 69791:4192bb0fddd0
105 (set-process-filter process #'pgg-gpg-process-filter) 105 (set-process-filter process #'pgg-gpg-process-filter)
106 (set-process-sentinel process #'pgg-gpg-process-sentinel) 106 (set-process-sentinel process #'pgg-gpg-process-sentinel)
107 process)) 107 process))
108 108
109 (defun pgg-gpg-process-filter (process input) 109 (defun pgg-gpg-process-filter (process input)
110 (if pgg-gpg-debug
111 (save-excursion
112 (set-buffer (get-buffer-create " *pgg-gpg-debug*"))
113 (goto-char (point-max))
114 (insert input)))
110 (if (buffer-live-p (process-buffer process)) 115 (if (buffer-live-p (process-buffer process))
111 (save-excursion 116 (save-excursion
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)) 117 (set-buffer (process-buffer process))
118 (goto-char (point-max)) 118 (goto-char (point-max))
119 (insert input) 119 (insert input)
120 (goto-char pgg-gpg-read-point) 120 (goto-char pgg-gpg-read-point)
121 (beginning-of-line) 121 (beginning-of-line)
129 (setq pgg-gpg-pending-status-list 129 (setq pgg-gpg-pending-status-list
130 (delq (car entry) 130 (delq (car entry)
131 pgg-gpg-pending-status-list))) 131 pgg-gpg-pending-status-list)))
132 (if (and symbol 132 (if (and symbol
133 (fboundp symbol)) 133 (fboundp symbol))
134 (funcall symbol process (buffer-substring (match-beginning 1) 134 (funcall symbol process (buffer-substring
135 (match-end 0))))))) 135 (match-beginning 1)
136 (match-end 0)))))))
136 (forward-line)) 137 (forward-line))
137 (setq pgg-gpg-read-point (point))))) 138 (setq pgg-gpg-read-point (point)))))
138 139
139 (defun pgg-gpg-process-sentinel (process status) 140 (defun pgg-gpg-process-sentinel (process status)
140 (set-process-filter process nil) 141 (if (buffer-live-p (process-buffer process))
141 (save-excursion 142 (save-excursion
142 ;; Copy the contents of process-buffer to pgg-errors-buffer. 143 (set-buffer (process-buffer process))
143 (set-buffer (get-buffer-create pgg-errors-buffer)) 144 (when pgg-gpg-passphrase
144 (buffer-disable-undo) 145 (fillarray pgg-gpg-passphrase 0)
145 (erase-buffer) 146 (setq pgg-gpg-passphrase nil))
146 (when (buffer-live-p (process-buffer process)) 147 ;; Copy the contents of process-buffer to pgg-errors-buffer.
147 (insert-buffer-substring (process-buffer process)) 148 (set-buffer (get-buffer-create pgg-errors-buffer))
148 (goto-char (point-min)) 149 (buffer-disable-undo)
149 ;(delete-matching-lines "^\\[GNUPG:] ") 150 (erase-buffer)
150 (goto-char (point-min)) 151 (insert-buffer-substring (process-buffer process))
151 (while (re-search-forward "^gpg: " nil t) 152 ;; Read the contents of the output file to pgg-output-buffer.
152 (replace-match ""))) 153 (set-buffer (get-buffer-create pgg-output-buffer))
153 ;; Read the contents of the output file to pgg-output-buffer. 154 (buffer-disable-undo)
154 (set-buffer (get-buffer-create pgg-output-buffer)) 155 (erase-buffer)
155 (buffer-disable-undo) 156 (if (equal status "finished\n")
156 (erase-buffer) 157 (let ((output-file-name
157 (if (and (equal status "finished\n") 158 (with-current-buffer (process-buffer process)
158 (buffer-live-p (process-buffer process))) 159 pgg-gpg-output-file-name)))
159 (let ((output-file-name (with-current-buffer (process-buffer process) 160 (when (file-exists-p output-file-name)
160 pgg-gpg-output-file-name))) 161 (let ((coding-system-for-read (if pgg-text-mode
161 (when (file-exists-p output-file-name) 162 'raw-text
162 (let ((coding-system-for-read (if pgg-text-mode 163 'binary)))
163 'raw-text 164 (insert-file-contents output-file-name))
164 'binary))) 165 (delete-file output-file-name))))
165 (insert-file-contents output-file-name)) 166 (kill-buffer (process-buffer process)))))
166 (delete-file output-file-name))))))
167 167
168 (defun pgg-gpg-wait-for-status (process status-list) 168 (defun pgg-gpg-wait-for-status (process status-list)
169 (with-current-buffer (process-buffer process) 169 (with-current-buffer (process-buffer process)
170 (setq pgg-gpg-pending-status-list status-list) 170 (setq pgg-gpg-pending-status-list status-list)
171 (while (and (eq (process-status process) 'run) 171 (while (and (eq (process-status process) 'run)
172 pgg-gpg-pending-status-list) 172 pgg-gpg-pending-status-list)
173 (accept-process-output process 1)))) 173 (accept-process-output process 1))))
174 174
175 (defun pgg-gpg-wait-for-completion (process &optional status-list) 175 (defun pgg-gpg-wait-for-completion (process)
176 (process-send-eof process) 176 (process-send-eof process)
177 (while (eq (process-status process) 'run) 177 (while (eq (process-status process) 'run)
178 (sit-for 0.1)) 178 ;; We can't use accept-process-output instead of sit-for here
179 (if (buffer-live-p (process-buffer process)) 179 ;; because it may cause an interrupt during the sentinel execution.
180 (save-excursion 180 (sit-for 0.1)))
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)))
193 181
194 (defun pgg-gpg-status-USERID_HINT (process line) 182 (defun pgg-gpg-status-USERID_HINT (process line)
195 (if (string-match "\\`USERID_HINT \\([^ ]+\\) \\(.*\\)" line) 183 (if (string-match "\\`USERID_HINT \\([^ ]+\\) \\(.*\\)" line)
196 (let* ((key-id (match-string 1 line)) 184 (let* ((key-id (match-string 1 line))
197 (user-id (match-string 2 line)) 185 (user-id (match-string 2 line))
269 (list pgg-gpg-user-id)))))))) 257 (list pgg-gpg-user-id))))))))
270 (process (pgg-gpg-start-process args))) 258 (process (pgg-gpg-start-process args)))
271 (if (and sign (not pgg-gpg-use-agent)) 259 (if (and sign (not pgg-gpg-use-agent))
272 (pgg-gpg-wait-for-status process '("GOOD_PASSPHRASE"))) 260 (pgg-gpg-wait-for-status process '("GOOD_PASSPHRASE")))
273 (process-send-region process start end) 261 (process-send-region process start end)
274 (pgg-gpg-wait-for-completion process '("SIG_CREATED" "END_ENCRYPTION")))) 262 (pgg-gpg-wait-for-completion process)
263 (save-excursion
264 (set-buffer (get-buffer-create pgg-errors-buffer))
265 (goto-char (point-max))
266 (not (null (re-search-backward "^\\[GNUPG:] END_ENCRYPTION\\>"
267 nil t))))))
275 268
276 (defun pgg-gpg-encrypt-symmetric-region (start end &optional passphrase) 269 (defun pgg-gpg-encrypt-symmetric-region (start end &optional passphrase)
277 "Encrypt the current region between START and END with symmetric cipher." 270 "Encrypt the current region between START and END with symmetric cipher."
278 (let* ((args 271 (let* ((args
279 (append '("--armor" "--symmetric") 272 (append '("--armor" "--symmetric")
280 (if pgg-text-mode '("--textmode")))) 273 (if pgg-text-mode '("--textmode"))))
281 (process (pgg-gpg-start-process args))) 274 (process (pgg-gpg-start-process args)))
282 (pgg-gpg-wait-for-status process '("BEGIN_ENCRYPTION")) 275 (pgg-gpg-wait-for-status process '("BEGIN_ENCRYPTION"))
283 (process-send-region process start end) 276 (process-send-region process start end)
284 (pgg-gpg-wait-for-completion process '("END_ENCRYPTION")))) 277 (pgg-gpg-wait-for-completion process)
278 (save-excursion
279 (set-buffer (get-buffer-create pgg-errors-buffer))
280 (goto-char (point-max))
281 (not (null (re-search-backward "^\\[GNUPG:] END_ENCRYPTION\\>"
282 nil t))))))
285 283
286 (defun pgg-gpg-decrypt-region (start end &optional passphrase) 284 (defun pgg-gpg-decrypt-region (start end &optional passphrase)
287 "Decrypt the current region between START and END." 285 "Decrypt the current region between START and END."
288 (let* ((args '("--decrypt")) 286 (let* ((args '("--decrypt"))
289 (process (pgg-gpg-start-process args))) 287 (process (pgg-gpg-start-process args)))
290 (process-send-region process start end) 288 (process-send-region process start end)
291 (pgg-gpg-wait-for-status process '("BEGIN_DECRYPTION")) 289 (pgg-gpg-wait-for-status process '("BEGIN_DECRYPTION"))
292 (pgg-gpg-wait-for-completion process '("GOODSIG" "DECRYPTION_OKAY")))) 290 (pgg-gpg-wait-for-completion process)
291 (save-excursion
292 (set-buffer (get-buffer-create pgg-errors-buffer))
293 (goto-char (point-max))
294 (not (null (re-search-backward "^\\[GNUPG:] DECRYPTION_OKAY\\>"
295 nil t))))))
293 296
294 (defun pgg-gpg-sign-region (start end &optional cleartext passphrase) 297 (defun pgg-gpg-sign-region (start end &optional cleartext passphrase)
295 "Make detached signature from text between START and END." 298 "Make detached signature from text between START and END."
296 (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id)) 299 (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
297 (args 300 (args
301 (if pgg-text-mode '("--textmode")))) 304 (if pgg-text-mode '("--textmode"))))
302 (process (pgg-gpg-start-process args))) 305 (process (pgg-gpg-start-process args)))
303 (unless pgg-gpg-use-agent 306 (unless pgg-gpg-use-agent
304 (pgg-gpg-wait-for-status process '("GOOD_PASSPHRASE"))) 307 (pgg-gpg-wait-for-status process '("GOOD_PASSPHRASE")))
305 (process-send-region process start end) 308 (process-send-region process start end)
306 (pgg-gpg-wait-for-completion process '("SIG_CREATED")))) 309 (pgg-gpg-wait-for-completion process)
310 (save-excursion
311 (set-buffer (get-buffer-create pgg-errors-buffer))
312 (goto-char (point-max))
313 (not (null (re-search-backward "^\\[GNUPG:] SIG_CREATED\\>"
314 nil t))))))
307 315
308 (defun pgg-gpg-verify-region (start end &optional signature) 316 (defun pgg-gpg-verify-region (start end &optional signature)
309 "Verify region between START and END as the detached signature SIGNATURE." 317 "Verify region between START and END as the detached signature SIGNATURE."
310 (let ((args '("--verify")) 318 (let ((args '("--verify"))
311 process) 319 process)
312 (when (stringp signature) 320 (when (stringp signature)
313 (setq args (append args (list signature)))) 321 (setq args (append args (list signature))))
314 (setq process (pgg-gpg-start-process (append args '("-")))) 322 (setq process (pgg-gpg-start-process (append args '("-"))))
315 (process-send-region process start end) 323 (process-send-region process start end)
316 (pgg-gpg-wait-for-completion process '("GOODSIG")))) 324 (pgg-gpg-wait-for-completion process)
325 (save-excursion
326 (set-buffer (get-buffer-create pgg-errors-buffer))
327 (goto-char (point-max))
328 (not (null (re-search-backward "^\\[GNUPG:] GOODSIG\\>"
329 nil t))))))
317 330
318 (defun pgg-gpg-insert-key () 331 (defun pgg-gpg-insert-key ()
319 "Insert public key at point." 332 "Insert public key at point."
320 (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id)) 333 (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
321 (args (list "--export" "--armor" 334 (args (list "--export" "--armor"
328 "Add all public keys in region between START and END to the keyring." 341 "Add all public keys in region between START and END to the keyring."
329 (let* ((args '("--import" "-")) 342 (let* ((args '("--import" "-"))
330 (process (pgg-gpg-start-process args)) 343 (process (pgg-gpg-start-process args))
331 status) 344 status)
332 (process-send-region process start end) 345 (process-send-region process start end)
333 (pgg-gpg-wait-for-completion process '("IMPORT_RES")))) 346 (pgg-gpg-wait-for-completion process)
347 (save-excursion
348 (set-buffer (get-buffer-create pgg-errors-buffer))
349 (goto-char (point-max))
350 (not (null (re-search-backward "^\\[GNUPG:] IMPORT_RES\\>"
351 nil t))))))
334 352
335 (provide 'pgg-gpg) 353 (provide 'pgg-gpg)
336 354
337 ;;; arch-tag: 2aa5d5d8-93a0-4865-9312-33e29830e000 355 ;;; arch-tag: 2aa5d5d8-93a0-4865-9312-33e29830e000
338 ;;; pgg-gpg.el ends here 356 ;;; pgg-gpg.el ends here