1 ;;; pgg-gpg.el --- GnuPG support for PGG.
3 ;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
4 ;; 2005, 2006 Free Software Foundation, Inc.
6 ;; Author: Daiki Ueno <ueno@unixuser.org>
7 ;; Symmetric encryption support added by: Sascha Wilde <wilde@sha-bang.de>
9 ;; Keywords: PGP, OpenPGP, GnuPG
11 ;; This file is part of GNU Emacs.
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)
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.
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
25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
26 ;; Boston, MA 02110-1301, USA.
37 (defcustom pgg-gpg-program
"gpg"
38 "The GnuPG executable."
42 (defcustom pgg-gpg-extra-args nil
43 "Extra arguments for every GnuPG invocation."
45 :type
'(repeat (string :tag
"Argument")))
47 (defcustom pgg-gpg-recipient-argument
"--recipient"
48 "GnuPG option to specify recipient."
50 :type
'(choice (const :tag
"New `--recipient' option" "--recipient")
51 (const :tag
"Old `--remote-user' option" "--remote-user")))
53 (defcustom pgg-gpg-use-agent nil
54 "Whether to use gnupg agent for key caching."
58 (defvar pgg-gpg-user-id nil
59 "GnuPG ID of your default identity.")
61 (defvar pgg-gpg-user-id-alist nil
62 "An alist mapping from key ID to user ID.")
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
)
71 (defun pgg-gpg-start-process (args)
72 (let* ((output-file-name (pgg-make-temp-file "pgg-output"))
74 (append (list "--no-tty"
78 "--output" output-file-name
)
79 (if pgg-gpg-use-agent
'("--use-agent"))
82 (coding-system-for-write 'binary
)
83 (process-connection-type nil
)
84 (orig-mode (default-file-modes))
85 default-enable-multibyte-characters
86 (buffer (generate-new-buffer " *pgg-gpg*"))
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
))
101 (set-default-file-modes 448)
103 (apply #'start-process
"pgg-gpg" buffer pgg-gpg-program args
)))
104 (set-default-file-modes orig-mode
))
105 (set-process-filter process
#'pgg-gpg-process-filter
)
106 (set-process-sentinel process
#'pgg-gpg-process-sentinel
)
109 (defun pgg-gpg-process-filter (process input
)
110 (if (buffer-live-p (process-buffer process
))
114 (set-buffer (get-buffer-create " *pgg-gpg-debug*"))
115 (goto-char (point-max))
117 (set-buffer (process-buffer process
))
118 (goto-char (point-max))
120 (goto-char pgg-gpg-read-point
)
122 (while (looking-at ".*\n") ;the input line is finished
124 (if (looking-at "\\[GNUPG:] \\([A-Z_]+\\)\\>.*")
125 (let* ((status (match-string 1))
126 (symbol (intern-soft (concat "pgg-gpg-status-" status
)))
127 (entry (member status pgg-gpg-pending-status-list
)))
129 (setq pgg-gpg-pending-status-list
131 pgg-gpg-pending-status-list
)))
134 (funcall symbol process
(buffer-substring (match-beginning 1)
137 (setq pgg-gpg-read-point
(point)))))
139 (defun pgg-gpg-process-sentinel (process status
)
140 (set-process-filter process nil
)
142 ;; Copy the contents of process-buffer to pgg-errors-buffer.
143 (set-buffer (get-buffer-create pgg-errors-buffer
))
144 (buffer-disable-undo)
146 (when (buffer-live-p (process-buffer process
))
147 (insert-buffer-substring (process-buffer process
))
148 (goto-char (point-min))
149 ;(delete-matching-lines "^\\[GNUPG:] ")
150 (goto-char (point-min))
151 (while (re-search-forward "^gpg: " nil t
)
153 ;; Read the contents of the output file to pgg-output-buffer.
154 (set-buffer (get-buffer-create pgg-output-buffer
))
155 (buffer-disable-undo)
157 (if (and (equal status
"finished\n")
158 (buffer-live-p (process-buffer process
)))
159 (let ((output-file-name (with-current-buffer (process-buffer process
)
160 pgg-gpg-output-file-name
)))
161 (when (file-exists-p output-file-name
)
162 (let ((coding-system-for-read (if pgg-text-mode
165 (insert-file-contents output-file-name
))
166 (delete-file output-file-name
))))))
168 (defun pgg-gpg-wait-for-status (process status-list
)
169 (with-current-buffer (process-buffer process
)
170 (setq pgg-gpg-pending-status-list status-list
)
171 (while (and (eq (process-status process
) 'run
)
172 pgg-gpg-pending-status-list
)
173 (accept-process-output process
1))))
175 (defun pgg-gpg-wait-for-completion (process &optional status-list
)
176 (process-send-eof process
)
177 (while (eq (process-status process
) 'run
)
179 (if (buffer-live-p (process-buffer process
))
181 (set-buffer (process-buffer process
))
182 (setq status-list
(copy-sequence status-list
))
183 (let ((pointer status-list
))
185 (goto-char (point-min))
186 (unless (re-search-forward
187 (concat "^\\[GNUPG:] " (car pointer
) "\\>")
189 (setq status-list
(delq (car pointer
) status-list
)))
190 (setq pointer
(cdr pointer
))))
191 (kill-buffer (process-buffer process
))
194 (defun pgg-gpg-status-USERID_HINT (process line
)
195 (if (string-match "\\`USERID_HINT \\([^ ]+\\) \\(.*\\)" line
)
196 (let* ((key-id (match-string 1 line
))
197 (user-id (match-string 2 line
))
198 (entry (assoc key-id pgg-gpg-user-id-alist
)))
200 (setcdr entry user-id
)
201 (setq pgg-gpg-user-id-alist
(cons (cons key-id user-id
)
202 pgg-gpg-user-id-alist
))))))
204 (defun pgg-gpg-status-NEED_PASSPHRASE (process line
)
205 (if (string-match "\\`NEED_PASSPHRASE \\([^ ]+\\)" line
)
206 (setq pgg-gpg-key-id
(match-string 1 line
))))
208 (defun pgg-gpg-status-NEED_PASSPHRASE_SYM (process line
)
209 (setq pgg-gpg-key-id
'SYM
))
211 (defun pgg-gpg-status-NEED_PASSPHRASE_PIN (process line
)
212 (setq pgg-gpg-key-id
'PIN
))
214 (defun pgg-gpg-status-GET_HIDDEN (process line
)
215 (let ((entry (assoc pgg-gpg-key-id pgg-gpg-user-id-alist
)))
216 (if (setq pgg-gpg-passphrase
217 (if (eq pgg-gpg-key-id
'SYM
)
219 "GnuPG passphrase for symmetric encryption: ")
221 (format "GnuPG passphrase for %s: "
225 (if (eq pgg-gpg-key-id
'PIN
)
228 (process-send-string process
(concat pgg-gpg-passphrase
"\n")))))
230 (defun pgg-gpg-status-GOOD_PASSPHRASE (process line
)
231 (when (and pgg-gpg-passphrase
232 (stringp pgg-gpg-key-id
))
233 (pgg-add-passphrase-to-cache pgg-gpg-key-id pgg-gpg-passphrase
)
234 (setq pgg-gpg-passphrase nil
)))
236 (defun pgg-gpg-status-BAD_PASSPHRASE (process line
)
237 (when pgg-gpg-passphrase
238 (fillarray pgg-gpg-passphrase
0)
239 (setq pgg-gpg-passphrase nil
)))
241 (defun pgg-gpg-lookup-key (string &optional type
)
242 "Search keys associated with STRING."
243 (let ((args (list "--with-colons" "--no-greeting" "--batch"
244 (if type
"--list-secret-keys" "--list-keys")
247 (apply #'call-process pgg-gpg-program nil t nil args
)
248 (goto-char (point-min))
249 (if (re-search-forward "^\\(sec\\|pub\\):[^:]*:[^:]*:[^:]*:\\([^:]*\\)"
251 (substring (match-string 2) 8)))))
253 (defun pgg-gpg-encrypt-region (start end recipients
&optional sign passphrase
)
254 "Encrypt the current region between START and END.
256 If optional argument SIGN is non-nil, do a combined sign and encrypt."
257 (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id
))
260 '("--armor" "--always-trust" "--encrypt")
261 (if pgg-text-mode
'("--textmode"))
262 (if sign
(list "--sign" "--local-user" pgg-gpg-user-id
))
265 (mapcar (lambda (rcpt)
266 (list pgg-gpg-recipient-argument rcpt
))
268 (if pgg-encrypt-for-me
269 (list pgg-gpg-user-id
))))))))
270 (process (pgg-gpg-start-process args
)))
271 (if (and sign
(not pgg-gpg-use-agent
))
272 (pgg-gpg-wait-for-status process
'("GOOD_PASSPHRASE")))
273 (process-send-region process start end
)
274 (pgg-gpg-wait-for-completion process
'("SIG_CREATED" "END_ENCRYPTION"))))
276 (defun pgg-gpg-encrypt-symmetric-region (start end
&optional passphrase
)
277 "Encrypt the current region between START and END with symmetric cipher."
279 (append '("--armor" "--symmetric")
280 (if pgg-text-mode
'("--textmode"))))
281 (process (pgg-gpg-start-process args
)))
282 (pgg-gpg-wait-for-status process
'("BEGIN_ENCRYPTION"))
283 (process-send-region process start end
)
284 (pgg-gpg-wait-for-completion process
'("END_ENCRYPTION"))))
286 (defun pgg-gpg-decrypt-region (start end
&optional passphrase
)
287 "Decrypt the current region between START and END."
288 (let* ((args '("--decrypt"))
289 (process (pgg-gpg-start-process args
)))
290 (process-send-region process start end
)
291 (pgg-gpg-wait-for-status process
'("BEGIN_DECRYPTION"))
292 (pgg-gpg-wait-for-completion process
'("GOODSIG" "DECRYPTION_OKAY"))))
294 (defun pgg-gpg-sign-region (start end
&optional cleartext passphrase
)
295 "Make detached signature from text between START and END."
296 (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id
))
298 (append (list (if cleartext
"--clearsign" "--detach-sign")
299 "--armor" "--verbose"
300 "--local-user" pgg-gpg-user-id
)
301 (if pgg-text-mode
'("--textmode"))))
302 (process (pgg-gpg-start-process args
)))
303 (unless pgg-gpg-use-agent
304 (pgg-gpg-wait-for-status process
'("GOOD_PASSPHRASE")))
305 (process-send-region process start end
)
306 (pgg-gpg-wait-for-completion process
'("SIG_CREATED"))))
308 (defun pgg-gpg-verify-region (start end
&optional signature
)
309 "Verify region between START and END as the detached signature SIGNATURE."
310 (let ((args '("--verify"))
312 (when (stringp signature
)
313 (setq args
(append args
(list signature
))))
314 (setq process
(pgg-gpg-start-process (append args
'("-"))))
315 (process-send-region process start end
)
316 (pgg-gpg-wait-for-completion process
'("GOODSIG"))))
318 (defun pgg-gpg-insert-key ()
319 "Insert public key at point."
320 (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id
))
321 (args (list "--export" "--armor"
323 (process (pgg-gpg-start-process args
)))
324 (pgg-gpg-wait-for-completion process
)
325 (insert-buffer-substring pgg-output-buffer
)))
327 (defun pgg-gpg-snarf-keys-region (start end
)
328 "Add all public keys in region between START and END to the keyring."
329 (let* ((args '("--import" "-"))
330 (process (pgg-gpg-start-process args
))
332 (process-send-region process start end
)
333 (pgg-gpg-wait-for-completion process
'("IMPORT_RES"))))
337 ;;; arch-tag: 2aa5d5d8-93a0-4865-9312-33e29830e000
338 ;;; pgg-gpg.el ends here