Mercurial > emacs
comparison lisp/pgg-gpg.el @ 69791:4192bb0fddd0
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 |