(dos-reevaluate-defcustoms): Comment out the reevaluation of trash-directory.
[bpt/emacs.git] / lisp / epg.el
CommitLineData
c154c0be
MO
1;;; epg.el --- the EasyPG Library
2;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
ae940284 3;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
c154c0be
MO
4
5;; Author: Daiki Ueno <ueno@unixuser.org>
6;; Keywords: PGP, GnuPG
7
8;; This file is part of GNU Emacs.
9
eb3fa2cf 10;; GNU Emacs is free software: you can redistribute it and/or modify
c154c0be 11;; it under the terms of the GNU General Public License as published by
eb3fa2cf
GM
12;; the Free Software Foundation, either version 3 of the License, or
13;; (at your option) any later version.
c154c0be
MO
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
eb3fa2cf 21;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
c154c0be
MO
22
23;;; Code:
24
25(require 'epg-config)
26
27(defvar epg-user-id nil
28 "GnuPG ID of your default identity.")
29
30(defvar epg-user-id-alist nil
31 "An alist mapping from key ID to user ID.")
32
33(defvar epg-last-status nil)
34(defvar epg-read-point nil)
35(defvar epg-process-filter-running nil)
36(defvar epg-pending-status-list nil)
37(defvar epg-key-id nil)
38(defvar epg-context nil)
39(defvar epg-debug-buffer nil)
40
41;; from gnupg/include/cipher.h
42(defconst epg-cipher-algorithm-alist
43 '((0 . "NONE")
44 (1 . "IDEA")
45 (2 . "3DES")
46 (3 . "CAST5")
47 (4 . "BLOWFISH")
48 (7 . "AES")
49 (8 . "AES192")
50 (9 . "AES256")
51 (10 . "TWOFISH")
13890796
DU
52 (11 . "CAMELLIA128")
53 (12 . "CAMELLIA256")
c154c0be
MO
54 (110 . "DUMMY")))
55
56;; from gnupg/include/cipher.h
57(defconst epg-pubkey-algorithm-alist
58 '((1 . "RSA")
59 (2 . "RSA_E")
60 (3 . "RSA_S")
61 (16 . "ELGAMAL_E")
62 (17 . "DSA")
63 (20 . "ELGAMAL")))
64
65;; from gnupg/include/cipher.h
66(defconst epg-digest-algorithm-alist
67 '((1 . "MD5")
68 (2 . "SHA1")
69 (3 . "RMD160")
70 (8 . "SHA256")
71 (9 . "SHA384")
13890796
DU
72 (10 . "SHA512")
73 (11 . "SHA224")))
c154c0be
MO
74
75;; from gnupg/include/cipher.h
76(defconst epg-compress-algorithm-alist
77 '((0 . "NONE")
78 (1 . "ZIP")
79 (2 . "ZLIB")
80 (3 . "BZIP2")))
81
82(defconst epg-invalid-recipients-reason-alist
83 '((0 . "No specific reason given")
84 (1 . "Not Found")
85 (2 . "Ambigious specification")
86 (3 . "Wrong key usage")
87 (4 . "Key revoked")
88 (5 . "Key expired")
89 (6 . "No CRL known")
90 (7 . "CRL too old")
91 (8 . "Policy mismatch")
92 (9 . "Not a secret key")
93 (10 . "Key not trusted")))
94
95(defconst epg-delete-problem-reason-alist
96 '((1 . "No such key")
97 (2 . "Must delete secret key first")
98 (3 . "Ambigious specification")))
99
100(defconst epg-import-ok-reason-alist
101 '((0 . "Not actually changed")
102 (1 . "Entirely new key")
103 (2 . "New user IDs")
104 (4 . "New signatures")
105 (8 . "New subkeys")
106 (16 . "Contains private key")))
107
108(defconst epg-import-problem-reason-alist
109 '((0 . "No specific reason given")
110 (1 . "Invalid Certificate")
111 (2 . "Issuer Certificate missing")
112 (3 . "Certificate Chain too long")
113 (4 . "Error storing certificate")))
114
115(defconst epg-no-data-reason-alist
116 '((1 . "No armored data")
117 (2 . "Expected a packet but did not found one")
118 (3 . "Invalid packet found, this may indicate a non OpenPGP message")
119 (4 . "Signature expected but not found")))
120
121(defconst epg-unexpected-reason-alist nil)
122
123(defvar epg-key-validity-alist
124 '((?o . unknown)
125 (?i . invalid)
126 (?d . disabled)
127 (?r . revoked)
128 (?e . expired)
129 (?- . none)
130 (?q . undefined)
131 (?n . never)
132 (?m . marginal)
133 (?f . full)
134 (?u . ultimate)))
135
136(defvar epg-key-capablity-alist
137 '((?e . encrypt)
138 (?s . sign)
139 (?c . certify)
140 (?a . authentication)))
141
142(defvar epg-new-signature-type-alist
143 '((?D . detached)
144 (?C . clear)
145 (?S . normal)))
146
147(defvar epg-dn-type-alist
148 '(("1.2.840.113549.1.9.1" . "EMail")
149 ("2.5.4.12" . "T")
150 ("2.5.4.42" . "GN")
151 ("2.5.4.4" . "SN")
152 ("0.2.262.1.10.7.20" . "NameDistinguisher")
153 ("2.5.4.16" . "ADDR")
154 ("2.5.4.15" . "BC")
155 ("2.5.4.13" . "D")
156 ("2.5.4.17" . "PostalCode")
157 ("2.5.4.65" . "Pseudo")
158 ("2.5.4.5" . "SerialNumber")))
159
160(defvar epg-prompt-alist nil)
161
162(put 'epg-error 'error-conditions '(epg-error error))
163
164(defun epg-make-data-from-file (file)
165 "Make a data object from FILE."
166 (cons 'epg-data (vector file nil)))
167
168(defun epg-make-data-from-string (string)
169 "Make a data object from STRING."
170 (cons 'epg-data (vector nil string)))
171
172(defun epg-data-file (data)
173 "Return the file of DATA."
174 (unless (eq (car-safe data) 'epg-data)
175 (signal 'wrong-type-argument (list 'epg-data-p data)))
176 (aref (cdr data) 0))
177
178(defun epg-data-string (data)
179 "Return the string of DATA."
180 (unless (eq (car-safe data) 'epg-data)
181 (signal 'wrong-type-argument (list 'epg-data-p data)))
182 (aref (cdr data) 1))
183
184(defun epg-make-context (&optional protocol armor textmode include-certs
185 cipher-algorithm digest-algorithm
186 compress-algorithm)
187 "Return a context object."
188 (cons 'epg-context
189 (vector (or protocol 'OpenPGP) armor textmode include-certs
190 cipher-algorithm digest-algorithm compress-algorithm
7c0ffa6d 191 (list #'epg-passphrase-callback-function)
c154c0be
MO
192 nil
193 nil nil nil nil nil nil)))
194
195(defun epg-context-protocol (context)
196 "Return the protocol used within CONTEXT."
197 (unless (eq (car-safe context) 'epg-context)
198 (signal 'wrong-type-argument (list 'epg-context-p context)))
199 (aref (cdr context) 0))
200
201(defun epg-context-armor (context)
05234615 202 "Return t if the output should be ASCII armored in CONTEXT."
c154c0be
MO
203 (unless (eq (car-safe context) 'epg-context)
204 (signal 'wrong-type-argument (list 'epg-context-p context)))
205 (aref (cdr context) 1))
206
207(defun epg-context-textmode (context)
208 "Return t if canonical text mode should be used in CONTEXT."
209 (unless (eq (car-safe context) 'epg-context)
210 (signal 'wrong-type-argument (list 'epg-context-p context)))
211 (aref (cdr context) 2))
212
213(defun epg-context-include-certs (context)
05234615 214 "Return how many certificates should be included in an S/MIME signed message."
c154c0be
MO
215 (unless (eq (car-safe context) 'epg-context)
216 (signal 'wrong-type-argument (list 'epg-context-p context)))
217 (aref (cdr context) 3))
218
219(defun epg-context-cipher-algorithm (context)
220 "Return the cipher algorithm in CONTEXT."
221 (unless (eq (car-safe context) 'epg-context)
222 (signal 'wrong-type-argument (list 'epg-context-p context)))
223 (aref (cdr context) 4))
224
225(defun epg-context-digest-algorithm (context)
226 "Return the digest algorithm in CONTEXT."
227 (unless (eq (car-safe context) 'epg-context)
228 (signal 'wrong-type-argument (list 'epg-context-p context)))
229 (aref (cdr context) 5))
230
231(defun epg-context-compress-algorithm (context)
232 "Return the compress algorithm in CONTEXT."
233 (unless (eq (car-safe context) 'epg-context)
234 (signal 'wrong-type-argument (list 'epg-context-p context)))
235 (aref (cdr context) 6))
236
237(defun epg-context-passphrase-callback (context)
238 "Return the function used to query passphrase."
239 (unless (eq (car-safe context) 'epg-context)
240 (signal 'wrong-type-argument (list 'epg-context-p context)))
241 (aref (cdr context) 7))
242
243(defun epg-context-progress-callback (context)
244 "Return the function which handles progress update."
245 (unless (eq (car-safe context) 'epg-context)
246 (signal 'wrong-type-argument (list 'epg-context-p context)))
247 (aref (cdr context) 8))
248
249(defun epg-context-signers (context)
05234615 250 "Return the list of key-id for signing."
c154c0be
MO
251 (unless (eq (car-safe context) 'epg-context)
252 (signal 'wrong-type-argument (list 'epg-context-p context)))
253 (aref (cdr context) 9))
254
255(defun epg-context-sig-notations (context)
05234615 256 "Return the list of notations for signing."
c154c0be
MO
257 (unless (eq (car-safe context) 'epg-context)
258 (signal 'wrong-type-argument (list 'epg-context-p context)))
259 (aref (cdr context) 10))
260
261(defun epg-context-process (context)
262 "Return the process object of `epg-gpg-program'.
263This function is for internal use only."
264 (unless (eq (car-safe context) 'epg-context)
265 (signal 'wrong-type-argument (list 'epg-context-p context)))
266 (aref (cdr context) 11))
267
268(defun epg-context-output-file (context)
269 "Return the output file of `epg-gpg-program'.
270This function is for internal use only."
271 (unless (eq (car-safe context) 'epg-context)
272 (signal 'wrong-type-argument (list 'epg-context-p context)))
273 (aref (cdr context) 12))
274
275(defun epg-context-result (context)
276 "Return the result of the previous cryptographic operation."
277 (unless (eq (car-safe context) 'epg-context)
278 (signal 'wrong-type-argument (list 'epg-context-p context)))
279 (aref (cdr context) 13))
280
281(defun epg-context-operation (context)
282 "Return the name of the current cryptographic operation."
283 (unless (eq (car-safe context) 'epg-context)
284 (signal 'wrong-type-argument (list 'epg-context-p context)))
285 (aref (cdr context) 14))
286
287(defun epg-context-set-protocol (context protocol)
288 "Set the protocol used within CONTEXT."
289 (unless (eq (car-safe context) 'epg-context)
290 (signal 'wrong-type-argument (list 'epg-context-p context)))
291 (aset (cdr context) 0 protocol))
292
293(defun epg-context-set-armor (context armor)
05234615 294 "Specify if the output should be ASCII armored in CONTEXT."
c154c0be
MO
295 (unless (eq (car-safe context) 'epg-context)
296 (signal 'wrong-type-argument (list 'epg-context-p context)))
297 (aset (cdr context) 1 armor))
298
299(defun epg-context-set-textmode (context textmode)
300 "Specify if canonical text mode should be used in CONTEXT."
301 (unless (eq (car-safe context) 'epg-context)
302 (signal 'wrong-type-argument (list 'epg-context-p context)))
303 (aset (cdr context) 2 textmode))
304
305(defun epg-context-set-include-certs (context include-certs)
306 "Set how many certificates should be included in an S/MIME signed message."
307 (unless (eq (car-safe context) 'epg-context)
308 (signal 'wrong-type-argument (list 'epg-context-p context)))
309 (aset (cdr context) 3 include-certs))
310
311(defun epg-context-set-cipher-algorithm (context cipher-algorithm)
312 "Set the cipher algorithm in CONTEXT."
313 (unless (eq (car-safe context) 'epg-context)
314 (signal 'wrong-type-argument (list 'epg-context-p context)))
315 (aset (cdr context) 4 cipher-algorithm))
316
317(defun epg-context-set-digest-algorithm (context digest-algorithm)
318 "Set the digest algorithm in CONTEXT."
319 (unless (eq (car-safe context) 'epg-context)
320 (signal 'wrong-type-argument (list 'epg-context-p context)))
321 (aset (cdr context) 5 digest-algorithm))
322
323(defun epg-context-set-compress-algorithm (context compress-algorithm)
324 "Set the compress algorithm in CONTEXT."
325 (unless (eq (car-safe context) 'epg-context)
326 (signal 'wrong-type-argument (list 'epg-context-p context)))
327 (aset (cdr context) 6 compress-algorithm))
328
329(defun epg-context-set-passphrase-callback (context
330 passphrase-callback)
b18508dd
DU
331 "Set the function used to query passphrase.
332
333PASSPHRASE-CALLBACK is either a function, or a cons-cell whose
334car is a function and cdr is a callback data.
97d4bdba 335
b18508dd
DU
336The function gets three arguments: the context, the key-id in
337question, and the callback data (if any)."
c154c0be
MO
338 (unless (eq (car-safe context) 'epg-context)
339 (signal 'wrong-type-argument (list 'epg-context-p context)))
7c0ffa6d
DU
340 (aset (cdr context) 7 (if (consp passphrase-callback)
341 passphrase-callback
342 (list passphrase-callback))))
c154c0be
MO
343
344(defun epg-context-set-progress-callback (context
345 progress-callback)
346 "Set the function which handles progress update.
b18508dd
DU
347
348PROGRESS-CALLBACK is either a function, or a cons-cell whose
349car is a function and cdr is a callback data.
350
351The function gets five arguments: the context, the operation
352description, the character to display a progress unit, the
353current amount done, the total amount to be done, and the
354callback data (if any)."
c154c0be
MO
355 (unless (eq (car-safe context) 'epg-context)
356 (signal 'wrong-type-argument (list 'epg-context-p context)))
7c0ffa6d
DU
357 (aset (cdr context) 8 (if (consp progress-callback)
358 progress-callback
359 (list progress-callback))))
c154c0be
MO
360
361(defun epg-context-set-signers (context signers)
05234615 362 "Set the list of key-id for signing."
c154c0be
MO
363 (unless (eq (car-safe context) 'epg-context)
364 (signal 'wrong-type-argument (list 'epg-context-p context)))
365 (aset (cdr context) 9 signers))
366
367(defun epg-context-set-sig-notations (context notations)
05234615 368 "Set the list of notations for signing."
c154c0be
MO
369 (unless (eq (car-safe context) 'epg-context)
370 (signal 'wrong-type-argument (list 'epg-context-p context)))
371 (aset (cdr context) 10 notations))
372
373(defun epg-context-set-process (context process)
374 "Set the process object of `epg-gpg-program'.
375This function is for internal use only."
376 (unless (eq (car-safe context) 'epg-context)
377 (signal 'wrong-type-argument (list 'epg-context-p context)))
378 (aset (cdr context) 11 process))
379
380(defun epg-context-set-output-file (context output-file)
381 "Set the output file of `epg-gpg-program'.
382This function is for internal use only."
383 (unless (eq (car-safe context) 'epg-context)
384 (signal 'wrong-type-argument (list 'epg-context-p context)))
385 (aset (cdr context) 12 output-file))
386
387(defun epg-context-set-result (context result)
388 "Set the result of the previous cryptographic operation."
389 (unless (eq (car-safe context) 'epg-context)
390 (signal 'wrong-type-argument (list 'epg-context-p context)))
391 (aset (cdr context) 13 result))
392
393(defun epg-context-set-operation (context operation)
394 "Set the name of the current cryptographic operation."
395 (unless (eq (car-safe context) 'epg-context)
396 (signal 'wrong-type-argument (list 'epg-context-p context)))
397 (aset (cdr context) 14 operation))
398
399(defun epg-make-signature (status &optional key-id)
400 "Return a signature object."
401 (cons 'epg-signature (vector status key-id nil nil nil nil nil nil nil nil
402 nil)))
403
404(defun epg-signature-status (signature)
405 "Return the status code of SIGNATURE."
406 (unless (eq (car-safe signature) 'epg-signature)
407 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
408 (aref (cdr signature) 0))
409
410(defun epg-signature-key-id (signature)
411 "Return the key-id of SIGNATURE."
412 (unless (eq (car-safe signature) 'epg-signature)
413 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
414 (aref (cdr signature) 1))
415
416(defun epg-signature-validity (signature)
417 "Return the validity of SIGNATURE."
418 (unless (eq (car-safe signature) 'epg-signature)
419 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
420 (aref (cdr signature) 2))
421
422(defun epg-signature-fingerprint (signature)
423 "Return the fingerprint of SIGNATURE."
424 (unless (eq (car-safe signature) 'epg-signature)
425 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
426 (aref (cdr signature) 3))
427
428(defun epg-signature-creation-time (signature)
429 "Return the creation time of SIGNATURE."
430 (unless (eq (car-safe signature) 'epg-signature)
431 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
432 (aref (cdr signature) 4))
433
434(defun epg-signature-expiration-time (signature)
435 "Return the expiration time of SIGNATURE."
436 (unless (eq (car-safe signature) 'epg-signature)
437 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
438 (aref (cdr signature) 5))
439
440(defun epg-signature-pubkey-algorithm (signature)
441 "Return the public key algorithm of SIGNATURE."
442 (unless (eq (car-safe signature) 'epg-signature)
443 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
444 (aref (cdr signature) 6))
445
446(defun epg-signature-digest-algorithm (signature)
447 "Return the digest algorithm of SIGNATURE."
448 (unless (eq (car-safe signature) 'epg-signature)
449 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
450 (aref (cdr signature) 7))
451
452(defun epg-signature-class (signature)
453 "Return the class of SIGNATURE."
454 (unless (eq (car-safe signature) 'epg-signature)
455 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
456 (aref (cdr signature) 8))
457
458(defun epg-signature-version (signature)
459 "Return the version of SIGNATURE."
460 (unless (eq (car-safe signature) 'epg-signature)
461 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
462 (aref (cdr signature) 9))
463
464(defun epg-sig-notations (signature)
465 "Return the list of notations of SIGNATURE."
466 (unless (eq (car-safe signature) 'epg-signature)
467 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
468 (aref (cdr signature) 10))
469
470(defun epg-signature-set-status (signature status)
471 "Set the status code of SIGNATURE."
472 (unless (eq (car-safe signature) 'epg-signature)
473 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
474 (aset (cdr signature) 0 status))
475
476(defun epg-signature-set-key-id (signature key-id)
477 "Set the key-id of SIGNATURE."
478 (unless (eq (car-safe signature) 'epg-signature)
479 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
480 (aset (cdr signature) 1 key-id))
481
482(defun epg-signature-set-validity (signature validity)
483 "Set the validity of SIGNATURE."
484 (unless (eq (car-safe signature) 'epg-signature)
485 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
486 (aset (cdr signature) 2 validity))
487
488(defun epg-signature-set-fingerprint (signature fingerprint)
489 "Set the fingerprint of SIGNATURE."
490 (unless (eq (car-safe signature) 'epg-signature)
491 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
492 (aset (cdr signature) 3 fingerprint))
493
494(defun epg-signature-set-creation-time (signature creation-time)
495 "Set the creation time of SIGNATURE."
496 (unless (eq (car-safe signature) 'epg-signature)
497 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
498 (aset (cdr signature) 4 creation-time))
499
500(defun epg-signature-set-expiration-time (signature expiration-time)
501 "Set the expiration time of SIGNATURE."
502 (unless (eq (car-safe signature) 'epg-signature)
503 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
504 (aset (cdr signature) 5 expiration-time))
505
506(defun epg-signature-set-pubkey-algorithm (signature pubkey-algorithm)
507 "Set the public key algorithm of SIGNATURE."
508 (unless (eq (car-safe signature) 'epg-signature)
509 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
510 (aset (cdr signature) 6 pubkey-algorithm))
511
512(defun epg-signature-set-digest-algorithm (signature digest-algorithm)
513 "Set the digest algorithm of SIGNATURE."
514 (unless (eq (car-safe signature) 'epg-signature)
515 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
516 (aset (cdr signature) 7 digest-algorithm))
517
518(defun epg-signature-set-class (signature class)
519 "Set the class of SIGNATURE."
520 (unless (eq (car-safe signature) 'epg-signature)
521 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
522 (aset (cdr signature) 8 class))
523
524(defun epg-signature-set-version (signature version)
525 "Set the version of SIGNATURE."
526 (unless (eq (car-safe signature) 'epg-signature)
527 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
528 (aset (cdr signature) 9 version))
529
530(defun epg-signature-set-notations (signature notations)
531 "Set the list of notations of SIGNATURE."
532 (unless (eq (car-safe signature) 'epg-signature)
533 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
534 (aset (cdr signature) 10 notations))
535
536(defun epg-make-new-signature (type pubkey-algorithm digest-algorithm
537 class creation-time fingerprint)
538 "Return a new signature object."
539 (cons 'epg-new-signature (vector type pubkey-algorithm digest-algorithm
540 class creation-time fingerprint)))
541
542(defun epg-new-signature-type (new-signature)
543 "Return the type of NEW-SIGNATURE."
544 (unless (eq (car-safe new-signature) 'epg-new-signature)
545 (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature)))
546 (aref (cdr new-signature) 0))
547
548(defun epg-new-signature-pubkey-algorithm (new-signature)
549 "Return the public key algorithm of NEW-SIGNATURE."
550 (unless (eq (car-safe new-signature) 'epg-new-signature)
551 (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature)))
552 (aref (cdr new-signature) 1))
553
554(defun epg-new-signature-digest-algorithm (new-signature)
555 "Return the digest algorithm of NEW-SIGNATURE."
556 (unless (eq (car-safe new-signature) 'epg-new-signature)
557 (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature)))
558 (aref (cdr new-signature) 2))
559
560(defun epg-new-signature-class (new-signature)
561 "Return the class of NEW-SIGNATURE."
562 (unless (eq (car-safe new-signature) 'epg-new-signature)
563 (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature)))
564 (aref (cdr new-signature) 3))
565
566(defun epg-new-signature-creation-time (new-signature)
567 "Return the creation time of NEW-SIGNATURE."
568 (unless (eq (car-safe new-signature) 'epg-new-signature)
569 (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature)))
570 (aref (cdr new-signature) 4))
571
572(defun epg-new-signature-fingerprint (new-signature)
573 "Return the fingerprint of NEW-SIGNATURE."
574 (unless (eq (car-safe new-signature) 'epg-new-signature)
575 (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature)))
576 (aref (cdr new-signature) 5))
577
578(defun epg-make-key (owner-trust)
579 "Return a key object."
580 (cons 'epg-key (vector owner-trust nil nil)))
581
582(defun epg-key-owner-trust (key)
583 "Return the owner trust of KEY."
584 (unless (eq (car-safe key) 'epg-key)
585 (signal 'wrong-type-argument (list 'epg-key-p key)))
586 (aref (cdr key) 0))
587
588(defun epg-key-sub-key-list (key)
589 "Return the sub key list of KEY."
590 (unless (eq (car-safe key) 'epg-key)
591 (signal 'wrong-type-argument (list 'epg-key-p key)))
592 (aref (cdr key) 1))
593
594(defun epg-key-user-id-list (key)
595 "Return the user ID list of KEY."
596 (unless (eq (car-safe key) 'epg-key)
597 (signal 'wrong-type-argument (list 'epg-key-p key)))
598 (aref (cdr key) 2))
599
600(defun epg-key-set-sub-key-list (key sub-key-list)
601 "Set the sub key list of KEY."
602 (unless (eq (car-safe key) 'epg-key)
603 (signal 'wrong-type-argument (list 'epg-key-p key)))
604 (aset (cdr key) 1 sub-key-list))
605
606(defun epg-key-set-user-id-list (key user-id-list)
607 "Set the user ID list of KEY."
608 (unless (eq (car-safe key) 'epg-key)
609 (signal 'wrong-type-argument (list 'epg-key-p key)))
610 (aset (cdr key) 2 user-id-list))
611
612(defun epg-make-sub-key (validity capability secret-p algorithm length id
613 creation-time expiration-time)
614 "Return a sub key object."
615 (cons 'epg-sub-key
616 (vector validity capability secret-p algorithm length id creation-time
617 expiration-time nil)))
618
619(defun epg-sub-key-validity (sub-key)
620 "Return the validity of SUB-KEY."
621 (unless (eq (car-safe sub-key) 'epg-sub-key)
622 (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
623 (aref (cdr sub-key) 0))
624
625(defun epg-sub-key-capability (sub-key)
626 "Return the capability of SUB-KEY."
627 (unless (eq (car-safe sub-key) 'epg-sub-key)
628 (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
629 (aref (cdr sub-key) 1))
630
631(defun epg-sub-key-secret-p (sub-key)
632 "Return non-nil if SUB-KEY is a secret key."
633 (unless (eq (car-safe sub-key) 'epg-sub-key)
634 (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
635 (aref (cdr sub-key) 2))
636
637(defun epg-sub-key-algorithm (sub-key)
638 "Return the algorithm of SUB-KEY."
639 (unless (eq (car-safe sub-key) 'epg-sub-key)
640 (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
641 (aref (cdr sub-key) 3))
642
643(defun epg-sub-key-length (sub-key)
644 "Return the length of SUB-KEY."
645 (unless (eq (car-safe sub-key) 'epg-sub-key)
646 (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
647 (aref (cdr sub-key) 4))
648
649(defun epg-sub-key-id (sub-key)
650 "Return the ID of SUB-KEY."
651 (unless (eq (car-safe sub-key) 'epg-sub-key)
652 (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
653 (aref (cdr sub-key) 5))
654
655(defun epg-sub-key-creation-time (sub-key)
656 "Return the creation time of SUB-KEY."
657 (unless (eq (car-safe sub-key) 'epg-sub-key)
658 (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
659 (aref (cdr sub-key) 6))
660
661(defun epg-sub-key-expiration-time (sub-key)
662 "Return the expiration time of SUB-KEY."
663 (unless (eq (car-safe sub-key) 'epg-sub-key)
664 (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
665 (aref (cdr sub-key) 7))
666
667(defun epg-sub-key-fingerprint (sub-key)
668 "Return the fingerprint of SUB-KEY."
669 (unless (eq (car-safe sub-key) 'epg-sub-key)
670 (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
671 (aref (cdr sub-key) 8))
672
673(defun epg-sub-key-set-fingerprint (sub-key fingerprint)
674 "Set the fingerprint of SUB-KEY.
675This function is for internal use only."
676 (unless (eq (car-safe sub-key) 'epg-sub-key)
677 (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
678 (aset (cdr sub-key) 8 fingerprint))
679
680(defun epg-make-user-id (validity string)
681 "Return a user ID object."
682 (cons 'epg-user-id (vector validity string nil)))
683
684(defun epg-user-id-validity (user-id)
685 "Return the validity of USER-ID."
686 (unless (eq (car-safe user-id) 'epg-user-id)
687 (signal 'wrong-type-argument (list 'epg-user-id-p user-id)))
688 (aref (cdr user-id) 0))
689
690(defun epg-user-id-string (user-id)
691 "Return the name of USER-ID."
692 (unless (eq (car-safe user-id) 'epg-user-id)
693 (signal 'wrong-type-argument (list 'epg-user-id-p user-id)))
694 (aref (cdr user-id) 1))
695
696(defun epg-user-id-signature-list (user-id)
697 "Return the signature list of USER-ID."
698 (unless (eq (car-safe user-id) 'epg-user-id)
699 (signal 'wrong-type-argument (list 'epg-user-id-p user-id)))
700 (aref (cdr user-id) 2))
701
702(defun epg-user-id-set-signature-list (user-id signature-list)
703 "Set the signature list of USER-ID."
704 (unless (eq (car-safe user-id) 'epg-user-id)
705 (signal 'wrong-type-argument (list 'epg-user-id-p user-id)))
706 (aset (cdr user-id) 2 signature-list))
707
708(defun epg-make-key-signature (validity pubkey-algorithm key-id creation-time
709 expiration-time user-id class
710 exportable-p)
711 "Return a key signature object."
712 (cons 'epg-key-signature
713 (vector validity pubkey-algorithm key-id creation-time expiration-time
714 user-id class exportable-p)))
715
716(defun epg-key-signature-validity (key-signature)
717 "Return the validity of KEY-SIGNATURE."
718 (unless (eq (car-safe key-signature) 'epg-key-signature)
719 (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
720 (aref (cdr key-signature) 0))
721
722(defun epg-key-signature-pubkey-algorithm (key-signature)
723 "Return the public key algorithm of KEY-SIGNATURE."
724 (unless (eq (car-safe key-signature) 'epg-key-signature)
725 (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
726 (aref (cdr key-signature) 1))
727
728(defun epg-key-signature-key-id (key-signature)
729 "Return the key-id of KEY-SIGNATURE."
730 (unless (eq (car-safe key-signature) 'epg-key-signature)
731 (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
732 (aref (cdr key-signature) 2))
733
734(defun epg-key-signature-creation-time (key-signature)
735 "Return the creation time of KEY-SIGNATURE."
736 (unless (eq (car-safe key-signature) 'epg-key-signature)
737 (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
738 (aref (cdr key-signature) 3))
739
740(defun epg-key-signature-expiration-time (key-signature)
741 "Return the expiration time of KEY-SIGNATURE."
742 (unless (eq (car-safe key-signature) 'epg-key-signature)
743 (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
744 (aref (cdr key-signature) 4))
745
746(defun epg-key-signature-user-id (key-signature)
747 "Return the user-id of KEY-SIGNATURE."
748 (unless (eq (car-safe key-signature) 'epg-key-signature)
749 (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
750 (aref (cdr key-signature) 5))
751
752(defun epg-key-signature-class (key-signature)
753 "Return the class of KEY-SIGNATURE."
754 (unless (eq (car-safe key-signature) 'epg-key-signature)
755 (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
756 (aref (cdr key-signature) 6))
757
758(defun epg-key-signature-exportable-p (key-signature)
759 "Return t if KEY-SIGNATURE is exportable."
760 (unless (eq (car-safe key-signature) 'epg-key-signature)
761 (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
762 (aref (cdr key-signature) 7))
763
764(defun epg-make-sig-notation (name value &optional human-readable
765 critical)
766 "Return a notation object."
767 (cons 'epg-sig-notation (vector name value human-readable critical)))
768
769(defun epg-sig-notation-name (sig-notation)
770 "Return the name of SIG-NOTATION."
771 (unless (eq (car-safe sig-notation) 'epg-sig-notation)
772 (signal 'wrong-type-argument (list 'epg-sig-notation-p
773 sig-notation)))
774 (aref (cdr sig-notation) 0))
775
776(defun epg-sig-notation-value (sig-notation)
777 "Return the value of SIG-NOTATION."
778 (unless (eq (car-safe sig-notation) 'epg-sig-notation)
779 (signal 'wrong-type-argument (list 'epg-sig-notation-p
780 sig-notation)))
781 (aref (cdr sig-notation) 1))
782
783(defun epg-sig-notation-human-readable (sig-notation)
784 "Return the human-readable of SIG-NOTATION."
785 (unless (eq (car-safe sig-notation) 'epg-sig-notation)
786 (signal 'wrong-type-argument (list 'epg-sig-notation-p
787 sig-notation)))
788 (aref (cdr sig-notation) 2))
789
790(defun epg-sig-notation-critical (sig-notation)
791 "Return the critical of SIG-NOTATION."
792 (unless (eq (car-safe sig-notation) 'epg-sig-notation)
793 (signal 'wrong-type-argument (list 'epg-sig-notation-p
794 sig-notation)))
795 (aref (cdr sig-notation) 3))
796
797(defun epg-sig-notation-set-value (sig-notation value)
798 "Set the value of SIG-NOTATION."
799 (unless (eq (car-safe sig-notation) 'epg-sig-notation)
800 (signal 'wrong-type-argument (list 'epg-sig-notation-p
801 sig-notation)))
802 (aset (cdr sig-notation) 1 value))
803
804(defun epg-make-import-status (fingerprint &optional reason new user-id
805 signature sub-key secret)
05234615 806 "Return an import status object."
c154c0be
MO
807 (cons 'epg-import-status (vector fingerprint reason new user-id signature
808 sub-key secret)))
809
810(defun epg-import-status-fingerprint (import-status)
811 "Return the fingerprint of the key that was considered."
812 (unless (eq (car-safe import-status) 'epg-import-status)
813 (signal 'wrong-type-argument (list 'epg-import-status-p import-status)))
814 (aref (cdr import-status) 0))
815
816(defun epg-import-status-reason (import-status)
817 "Return the reason code for import failure."
818 (unless (eq (car-safe import-status) 'epg-import-status)
819 (signal 'wrong-type-argument (list 'epg-import-status-p import-status)))
820 (aref (cdr import-status) 1))
821
822(defun epg-import-status-new (import-status)
823 "Return t if the imported key was new."
824 (unless (eq (car-safe import-status) 'epg-import-status)
825 (signal 'wrong-type-argument (list 'epg-import-status-p import-status)))
826 (aref (cdr import-status) 2))
827
828(defun epg-import-status-user-id (import-status)
829 "Return t if the imported key contained new user IDs."
830 (unless (eq (car-safe import-status) 'epg-import-status)
831 (signal 'wrong-type-argument (list 'epg-import-status-p import-status)))
832 (aref (cdr import-status) 3))
833
834(defun epg-import-status-signature (import-status)
835 "Return t if the imported key contained new signatures."
836 (unless (eq (car-safe import-status) 'epg-import-status)
837 (signal 'wrong-type-argument (list 'epg-import-status-p import-status)))
838 (aref (cdr import-status) 4))
839
840(defun epg-import-status-sub-key (import-status)
841 "Return t if the imported key contained new sub keys."
842 (unless (eq (car-safe import-status) 'epg-import-status)
843 (signal 'wrong-type-argument (list 'epg-import-status-p import-status)))
844 (aref (cdr import-status) 5))
845
846(defun epg-import-status-secret (import-status)
847 "Return t if the imported key contained a secret key."
848 (unless (eq (car-safe import-status) 'epg-import-status)
849 (signal 'wrong-type-argument (list 'epg-import-status-p import-status)))
850 (aref (cdr import-status) 6))
851
852(defun epg-make-import-result (considered no-user-id imported imported-rsa
853 unchanged new-user-ids new-sub-keys
854 new-signatures new-revocations
855 secret-read secret-imported
856 secret-unchanged not-imported
857 imports)
05234615 858 "Return an import result object."
c154c0be
MO
859 (cons 'epg-import-result (vector considered no-user-id imported imported-rsa
860 unchanged new-user-ids new-sub-keys
861 new-signatures new-revocations secret-read
862 secret-imported secret-unchanged
863 not-imported imports)))
864
865(defun epg-import-result-considered (import-result)
866 "Return the total number of considered keys."
867 (unless (eq (car-safe import-result) 'epg-import-result)
868 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
869 (aref (cdr import-result) 0))
870
871(defun epg-import-result-no-user-id (import-result)
872 "Return the number of keys without user ID."
873 (unless (eq (car-safe import-result) 'epg-import-result)
874 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
875 (aref (cdr import-result) 1))
876
877(defun epg-import-result-imported (import-result)
878 "Return the number of imported keys."
879 (unless (eq (car-safe import-result) 'epg-import-result)
880 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
881 (aref (cdr import-result) 2))
882
883(defun epg-import-result-imported-rsa (import-result)
884 "Return the number of imported RSA keys."
885 (unless (eq (car-safe import-result) 'epg-import-result)
886 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
887 (aref (cdr import-result) 3))
888
889(defun epg-import-result-unchanged (import-result)
890 "Return the number of unchanged keys."
891 (unless (eq (car-safe import-result) 'epg-import-result)
892 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
893 (aref (cdr import-result) 4))
894
895(defun epg-import-result-new-user-ids (import-result)
896 "Return the number of new user IDs."
897 (unless (eq (car-safe import-result) 'epg-import-result)
898 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
899 (aref (cdr import-result) 5))
900
901(defun epg-import-result-new-sub-keys (import-result)
902 "Return the number of new sub keys."
903 (unless (eq (car-safe import-result) 'epg-import-result)
904 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
905 (aref (cdr import-result) 6))
906
907(defun epg-import-result-new-signatures (import-result)
908 "Return the number of new signatures."
909 (unless (eq (car-safe import-result) 'epg-import-result)
910 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
911 (aref (cdr import-result) 7))
912
913(defun epg-import-result-new-revocations (import-result)
914 "Return the number of new revocations."
915 (unless (eq (car-safe import-result) 'epg-import-result)
916 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
917 (aref (cdr import-result) 8))
918
919(defun epg-import-result-secret-read (import-result)
920 "Return the total number of secret keys read."
921 (unless (eq (car-safe import-result) 'epg-import-result)
922 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
923 (aref (cdr import-result) 9))
924
925(defun epg-import-result-secret-imported (import-result)
926 "Return the number of imported secret keys."
927 (unless (eq (car-safe import-result) 'epg-import-result)
928 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
929 (aref (cdr import-result) 10))
930
931(defun epg-import-result-secret-unchanged (import-result)
932 "Return the number of unchanged secret keys."
933 (unless (eq (car-safe import-result) 'epg-import-result)
934 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
935 (aref (cdr import-result) 11))
936
937(defun epg-import-result-not-imported (import-result)
938 "Return the number of keys not imported."
939 (unless (eq (car-safe import-result) 'epg-import-result)
940 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
941 (aref (cdr import-result) 12))
942
943(defun epg-import-result-imports (import-result)
944 "Return the list of `epg-import-status' objects."
945 (unless (eq (car-safe import-result) 'epg-import-result)
946 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
947 (aref (cdr import-result) 13))
948
949(defun epg-context-result-for (context name)
950 "Return the result of CONTEXT associated with NAME."
951 (cdr (assq name (epg-context-result context))))
952
953(defun epg-context-set-result-for (context name value)
954 "Set the result of CONTEXT associated with NAME to VALUE."
955 (let* ((result (epg-context-result context))
956 (entry (assq name result)))
957 (if entry
958 (setcdr entry value)
959 (epg-context-set-result context (cons (cons name value) result)))))
960
961(defun epg-signature-to-string (signature)
962 "Convert SIGNATURE to a human readable string."
963 (let* ((user-id (cdr (assoc (epg-signature-key-id signature)
964 epg-user-id-alist)))
965 (pubkey-algorithm (epg-signature-pubkey-algorithm signature)))
966 (concat
967 (cond ((eq (epg-signature-status signature) 'good)
968 "Good signature from ")
969 ((eq (epg-signature-status signature) 'bad)
970 "Bad signature from ")
971 ((eq (epg-signature-status signature) 'expired)
972 "Expired signature from ")
973 ((eq (epg-signature-status signature) 'expired-key)
974 "Signature made by expired key ")
975 ((eq (epg-signature-status signature) 'revoked-key)
976 "Signature made by revoked key ")
977 ((eq (epg-signature-status signature) 'no-pubkey)
978 "No public key for "))
979 (epg-signature-key-id signature)
980 (if user-id
981 (concat " "
982 (if (stringp user-id)
983 user-id
984 (epg-decode-dn user-id)))
985 "")
986 (if (epg-signature-validity signature)
987 (format " (trust %s)" (epg-signature-validity signature))
988 "")
989 (if (epg-signature-creation-time signature)
990 (format-time-string " created at %Y-%m-%dT%T%z"
991 (epg-signature-creation-time signature))
992 "")
993 (if pubkey-algorithm
994 (concat " using "
995 (or (cdr (assq pubkey-algorithm epg-pubkey-algorithm-alist))
996 (format "(unknown algorithm %d)" pubkey-algorithm)))
997 ""))))
998
999(defun epg-verify-result-to-string (verify-result)
1000 "Convert VERIFY-RESULT to a human readable string."
1001 (mapconcat #'epg-signature-to-string verify-result "\n"))
1002
1003(defun epg-new-signature-to-string (new-signature)
1004 "Convert NEW-SIGNATURE to a human readable string."
1005 (concat
1006 (cond ((eq (epg-new-signature-type new-signature) 'detached)
1007 "Detached signature ")
1008 ((eq (epg-new-signature-type new-signature) 'clear)
1009 "Cleartext signature ")
1010 (t
1011 "Signature "))
1012 (cdr (assq (epg-new-signature-pubkey-algorithm new-signature)
1013 epg-pubkey-algorithm-alist))
1014 "/"
1015 (cdr (assq (epg-new-signature-digest-algorithm new-signature)
1016 epg-digest-algorithm-alist))
1017 " "
1018 (format "%02X " (epg-new-signature-class new-signature))
1019 (epg-new-signature-fingerprint new-signature)))
1020
1021(defun epg-import-result-to-string (import-result)
1022 "Convert IMPORT-RESULT to a human readable string."
1023 (concat (format "Total number processed: %d\n"
1024 (epg-import-result-considered import-result))
1025 (if (> (epg-import-result-not-imported import-result) 0)
1026 (format " skipped new keys: %d\n"
1027 (epg-import-result-not-imported import-result)))
1028 (if (> (epg-import-result-no-user-id import-result) 0)
1029 (format " w/o user IDs: %d\n"
1030 (epg-import-result-no-user-id import-result)))
1031 (if (> (epg-import-result-imported import-result) 0)
1032 (concat (format " imported: %d"
1033 (epg-import-result-imported import-result))
1034 (if (> (epg-import-result-imported-rsa import-result) 0)
1035 (format " (RSA: %d)"
1036 (epg-import-result-imported-rsa
1037 import-result)))
1038 "\n"))
1039 (if (> (epg-import-result-unchanged import-result) 0)
1040 (format " unchanged: %d\n"
1041 (epg-import-result-unchanged import-result)))
1042 (if (> (epg-import-result-new-user-ids import-result) 0)
1043 (format " new user IDs: %d\n"
1044 (epg-import-result-new-user-ids import-result)))
1045 (if (> (epg-import-result-new-sub-keys import-result) 0)
1046 (format " new subkeys: %d\n"
1047 (epg-import-result-new-sub-keys import-result)))
1048 (if (> (epg-import-result-new-signatures import-result) 0)
1049 (format " new signatures: %d\n"
1050 (epg-import-result-new-signatures import-result)))
1051 (if (> (epg-import-result-new-revocations import-result) 0)
1052 (format " new key revocations: %d\n"
1053 (epg-import-result-new-revocations import-result)))
1054 (if (> (epg-import-result-secret-read import-result) 0)
1055 (format " secret keys read: %d\n"
1056 (epg-import-result-secret-read import-result)))
1057 (if (> (epg-import-result-secret-imported import-result) 0)
1058 (format " secret keys imported: %d\n"
1059 (epg-import-result-secret-imported import-result)))
1060 (if (> (epg-import-result-secret-unchanged import-result) 0)
1061 (format " secret keys unchanged: %d\n"
1062 (epg-import-result-secret-unchanged import-result)))))
1063
1064(defun epg--start (context args)
1065 "Start `epg-gpg-program' in a subprocess with given ARGS."
1066 (if (and (epg-context-process context)
1067 (eq (process-status (epg-context-process context)) 'run))
1068 (error "%s is already running in this context"
1069 (if (eq (epg-context-protocol context) 'CMS)
1070 epg-gpgsm-program
1071 epg-gpg-program)))
1072 (let* ((args (append (list "--no-tty"
1073 "--status-fd" "1"
1074 "--yes")
1075 (if (and (not (eq (epg-context-protocol context) 'CMS))
1076 (string-match ":" (or (getenv "GPG_AGENT_INFO")
1077 "")))
1078 '("--use-agent"))
1079 (if (and (not (eq (epg-context-protocol context) 'CMS))
1080 (epg-context-progress-callback context))
1081 '("--enable-progress-filter"))
1082 (if epg-gpg-home-directory
1083 (list "--homedir" epg-gpg-home-directory))
1084 (unless (eq (epg-context-protocol context) 'CMS)
1085 '("--command-fd" "0"))
1086 (if (epg-context-armor context) '("--armor"))
1087 (if (epg-context-textmode context) '("--textmode"))
1088 (if (epg-context-output-file context)
1089 (list "--output" (epg-context-output-file context)))
1090 args))
1091 (coding-system-for-write 'binary)
1092 (coding-system-for-read 'binary)
1093 process-connection-type
1094 (orig-mode (default-file-modes))
1095 (buffer (generate-new-buffer " *epg*"))
1096 process)
1097 (if epg-debug
1098 (save-excursion
1099 (unless epg-debug-buffer
1100 (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
1101 (set-buffer epg-debug-buffer)
1102 (goto-char (point-max))
1103 (insert (format "%s %s\n"
1104 (if (eq (epg-context-protocol context) 'CMS)
1105 epg-gpgsm-program
1106 epg-gpg-program)
1107 (mapconcat #'identity args " ")))))
1108 (with-current-buffer buffer
1109 (if (fboundp 'set-buffer-multibyte)
1110 (set-buffer-multibyte nil))
1111 (make-local-variable 'epg-last-status)
1112 (setq epg-last-status nil)
1113 (make-local-variable 'epg-read-point)
1114 (setq epg-read-point (point-min))
1115 (make-local-variable 'epg-process-filter-running)
1116 (setq epg-process-filter-running nil)
1117 (make-local-variable 'epg-pending-status-list)
1118 (setq epg-pending-status-list nil)
1119 (make-local-variable 'epg-key-id)
1120 (setq epg-key-id nil)
1121 (make-local-variable 'epg-context)
1122 (setq epg-context context))
1123 (unwind-protect
1124 (progn
1125 (set-default-file-modes 448)
1126 (setq process
1127 (apply #'start-process "epg" buffer
1128 (if (eq (epg-context-protocol context) 'CMS)
1129 epg-gpgsm-program
1130 epg-gpg-program)
1131 args)))
1132 (set-default-file-modes orig-mode))
1133 (set-process-filter process #'epg--process-filter)
1134 (epg-context-set-process context process)))
1135
1136(defun epg--process-filter (process input)
1137 (if epg-debug
1138 (save-excursion
1139 (unless epg-debug-buffer
1140 (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
1141 (set-buffer epg-debug-buffer)
1142 (goto-char (point-max))
1143 (insert input)))
1144 (if (buffer-live-p (process-buffer process))
1145 (save-excursion
1146 (set-buffer (process-buffer process))
1147 (goto-char (point-max))
1148 (insert input)
1149 (unless epg-process-filter-running
1150 (unwind-protect
1151 (progn
1152 (setq epg-process-filter-running t)
1153 (goto-char epg-read-point)
1154 (beginning-of-line)
1155 (while (looking-at ".*\n") ;the input line finished
1156 (if (looking-at "\\[GNUPG:] \\([A-Z_]+\\) ?\\(.*\\)")
1157 (let* ((status (match-string 1))
1158 (string (match-string 2))
1159 (symbol (intern-soft (concat "epg--status-"
1160 status))))
1161 (if (member status epg-pending-status-list)
1162 (setq epg-pending-status-list nil))
1163 (if (and symbol
1164 (fboundp symbol))
1165 (funcall symbol epg-context string))
1166 (setq epg-last-status (cons status string))))
1167 (forward-line)
1168 (setq epg-read-point (point))))
1169 (setq epg-process-filter-running nil))))))
1170
1171(defun epg-read-output (context)
1172 "Read the output file CONTEXT and return the content as a string."
1173 (with-temp-buffer
1174 (if (fboundp 'set-buffer-multibyte)
1175 (set-buffer-multibyte nil))
1176 (if (file-exists-p (epg-context-output-file context))
1177 (let ((coding-system-for-read 'binary))
1178 (insert-file-contents (epg-context-output-file context))
1179 (buffer-string)))))
1180
1181(defun epg-wait-for-status (context status-list)
1182 "Wait until one of elements in STATUS-LIST arrives."
1183 (with-current-buffer (process-buffer (epg-context-process context))
1184 (setq epg-pending-status-list status-list)
1185 (while (and (eq (process-status (epg-context-process context)) 'run)
1186 epg-pending-status-list)
47e49712
DU
1187 (accept-process-output (epg-context-process context) 1))
1188 (if epg-pending-status-list
1189 (epg-context-set-result-for context 'error 'exit))))
c154c0be
MO
1190
1191(defun epg-wait-for-completion (context)
1192 "Wait until the `epg-gpg-program' process completes."
1193 (while (eq (process-status (epg-context-process context)) 'run)
de22b81d 1194 (accept-process-output (epg-context-process context) 1))
2a268ee2 1195 ;; This line is needed to run the process-filter right now.
de22b81d 1196 (sleep-for 0.1))
c154c0be
MO
1197
1198(defun epg-reset (context)
1199 "Reset the CONTEXT."
1200 (if (and (epg-context-process context)
1201 (buffer-live-p (process-buffer (epg-context-process context))))
1202 (kill-buffer (process-buffer (epg-context-process context))))
1203 (epg-context-set-process context nil))
1204
1205(defun epg-delete-output-file (context)
1206 "Delete the output file of CONTEXT."
1207 (if (and (epg-context-output-file context)
1208 (file-exists-p (epg-context-output-file context)))
1209 (delete-file (epg-context-output-file context))))
1210
1211(eval-and-compile
1212 (if (fboundp 'decode-coding-string)
1213 (defalias 'epg--decode-coding-string 'decode-coding-string)
1214 (defalias 'epg--decode-coding-string 'identity)))
1215
1216(defun epg--status-USERID_HINT (context string)
1217 (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
1218 (let* ((key-id (match-string 1 string))
1219 (user-id (match-string 2 string))
1220 (entry (assoc key-id epg-user-id-alist)))
1221 (condition-case nil
1222 (setq user-id (epg--decode-coding-string
1223 (epg--decode-percent-escape user-id)
1224 'utf-8))
1225 (error))
1226 (if entry
1227 (setcdr entry user-id)
1228 (setq epg-user-id-alist (cons (cons key-id user-id)
1229 epg-user-id-alist))))))
1230
1231(defun epg--status-NEED_PASSPHRASE (context string)
1232 (if (string-match "\\`\\([^ ]+\\)" string)
1233 (setq epg-key-id (match-string 1 string))))
1234
1235(defun epg--status-NEED_PASSPHRASE_SYM (context string)
1236 (setq epg-key-id 'SYM))
1237
1238(defun epg--status-NEED_PASSPHRASE_PIN (context string)
1239 (setq epg-key-id 'PIN))
1240
1241(eval-and-compile
1242 (if (fboundp 'clear-string)
1243 (defalias 'epg--clear-string 'clear-string)
1244 (defun epg--clear-string (string)
1245 (fillarray string 0))))
1246
1247(eval-and-compile
1248 (if (fboundp 'encode-coding-string)
1249 (defalias 'epg--encode-coding-string 'encode-coding-string)
1250 (defalias 'epg--encode-coding-string 'identity)))
1251
1252(defun epg--status-GET_HIDDEN (context string)
1253 (when (and epg-key-id
1254 (string-match "\\`passphrase\\." string))
1255 (unless (epg-context-passphrase-callback context)
1256 (error "passphrase-callback not set"))
1257 (let (inhibit-quit
1258 passphrase
1259 passphrase-with-new-line
1260 encoded-passphrase-with-new-line)
1261 (unwind-protect
1262 (condition-case nil
1263 (progn
1264 (setq passphrase
1265 (funcall
7c0ffa6d 1266 (car (epg-context-passphrase-callback context))
c154c0be
MO
1267 context
1268 epg-key-id
7c0ffa6d 1269 (cdr (epg-context-passphrase-callback context))))
c154c0be
MO
1270 (when passphrase
1271 (setq passphrase-with-new-line (concat passphrase "\n"))
1272 (epg--clear-string passphrase)
1273 (setq passphrase nil)
1274 (if epg-passphrase-coding-system
1275 (progn
1276 (setq encoded-passphrase-with-new-line
1277 (epg--encode-coding-string
1278 passphrase-with-new-line
1279 (coding-system-change-eol-conversion
1280 epg-passphrase-coding-system 'unix)))
1281 (epg--clear-string passphrase-with-new-line)
1282 (setq passphrase-with-new-line nil))
1283 (setq encoded-passphrase-with-new-line
1284 passphrase-with-new-line
1285 passphrase-with-new-line nil))
1286 (process-send-string (epg-context-process context)
1287 encoded-passphrase-with-new-line)))
1288 (quit
1289 (epg-context-set-result-for
1290 context 'error
1291 (cons '(quit)
1292 (epg-context-result-for context 'error)))
1293 (delete-process (epg-context-process context))))
1294 (if passphrase
1295 (epg--clear-string passphrase))
1296 (if passphrase-with-new-line
1297 (epg--clear-string passphrase-with-new-line))
1298 (if encoded-passphrase-with-new-line
1299 (epg--clear-string encoded-passphrase-with-new-line))))))
1300
1301(defun epg--prompt-GET_BOOL (context string)
1302 (let ((entry (assoc string epg-prompt-alist)))
1303 (y-or-n-p (if entry (cdr entry) (concat string "? ")))))
1304
1305(defun epg--prompt-GET_BOOL-untrusted_key.override (context string)
1306 (y-or-n-p (if (and (equal (car epg-last-status) "USERID_HINT")
1307 (string-match "\\`\\([^ ]+\\) \\(.*\\)"
1308 (cdr epg-last-status)))
1309 (let* ((key-id (match-string 1 (cdr epg-last-status)))
1310 (user-id (match-string 2 (cdr epg-last-status)))
1311 (entry (assoc key-id epg-user-id-alist)))
1312 (if entry
1313 (setq user-id (cdr entry)))
1314 (format "Untrusted key %s %s. Use anyway? " key-id user-id))
1315 "Use untrusted key anyway? ")))
1316
1317(defun epg--status-GET_BOOL (context string)
1318 (let (inhibit-quit)
1319 (condition-case nil
1320 (if (funcall (or (intern-soft (concat "epg--prompt-GET_BOOL-" string))
1321 #'epg--prompt-GET_BOOL)
1322 context string)
1323 (process-send-string (epg-context-process context) "y\n")
1324 (process-send-string (epg-context-process context) "n\n"))
1325 (quit
1326 (epg-context-set-result-for
1327 context 'error
1328 (cons '(quit)
1329 (epg-context-result-for context 'error)))
1330 (delete-process (epg-context-process context))))))
1331
1332(defun epg--status-GET_LINE (context string)
1333 (let ((entry (assoc string epg-prompt-alist))
1334 inhibit-quit)
1335 (condition-case nil
1336 (process-send-string (epg-context-process context)
1337 (concat (read-string
1338 (if entry
1339 (cdr entry)
1340 (concat string ": ")))
1341 "\n"))
1342 (quit
1343 (epg-context-set-result-for
1344 context 'error
1345 (cons '(quit)
1346 (epg-context-result-for context 'error)))
1347 (delete-process (epg-context-process context))))))
1348
1349(defun epg--status-*SIG (context status string)
1350 (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
1351 (let* ((key-id (match-string 1 string))
1352 (user-id (match-string 2 string))
1353 (entry (assoc key-id epg-user-id-alist)))
1354 (epg-context-set-result-for
1355 context
1356 'verify
1357 (cons (epg-make-signature status key-id)
1358 (epg-context-result-for context 'verify)))
1359 (condition-case nil
1360 (if (eq (epg-context-protocol context) 'CMS)
1361 (setq user-id (epg-dn-from-string user-id))
1362 (setq user-id (epg--decode-coding-string
1363 (epg--decode-percent-escape user-id)
1364 'utf-8)))
1365 (error))
1366 (if entry
1367 (setcdr entry user-id)
1368 (setq epg-user-id-alist
1369 (cons (cons key-id user-id) epg-user-id-alist))))
1370 (epg-context-set-result-for
1371 context
1372 'verify
1373 (cons (epg-make-signature status)
1374 (epg-context-result-for context 'verify)))))
1375
1376(defun epg--status-GOODSIG (context string)
1377 (epg--status-*SIG context 'good string))
1378
1379(defun epg--status-EXPSIG (context string)
1380 (epg--status-*SIG context 'expired string))
1381
1382(defun epg--status-EXPKEYSIG (context string)
1383 (epg--status-*SIG context 'expired-key string))
1384
1385(defun epg--status-REVKEYSIG (context string)
1386 (epg--status-*SIG context 'revoked-key string))
1387
1388(defun epg--status-BADSIG (context string)
1389 (epg--status-*SIG context 'bad string))
1390
1391(defun epg--status-NO_PUBKEY (context string)
1392 (let ((signature (car (epg-context-result-for context 'verify))))
1393 (if (and signature
1394 (eq (epg-signature-status signature) 'error)
1395 (equal (epg-signature-key-id signature) string))
1396 (epg-signature-set-status signature 'no-pubkey))))
1397
1398(defun epg--time-from-seconds (seconds)
1399 (let ((number-seconds (string-to-number (concat seconds ".0"))))
1400 (cons (floor (/ number-seconds 65536))
1401 (floor (mod number-seconds 65536)))))
1402
1403(defun epg--status-ERRSIG (context string)
1404 (if (string-match "\\`\\([^ ]+\\) \\([0-9]+\\) \\([0-9]+\\) \
1405\\([0-9A-Fa-f][0-9A-Fa-f]\\) \\([^ ]+\\) \\([0-9]+\\)"
1406 string)
1407 (let ((signature (epg-make-signature 'error)))
1408 (epg-context-set-result-for
1409 context
1410 'verify
1411 (cons signature
1412 (epg-context-result-for context 'verify)))
1413 (epg-signature-set-key-id
1414 signature
1415 (match-string 1 string))
1416 (epg-signature-set-pubkey-algorithm
1417 signature
1418 (string-to-number (match-string 2 string)))
1419 (epg-signature-set-digest-algorithm
1420 signature
1421 (string-to-number (match-string 3 string)))
1422 (epg-signature-set-class
1423 signature
1424 (string-to-number (match-string 4 string) 16))
1425 (epg-signature-set-creation-time
1426 signature
1427 (epg--time-from-seconds (match-string 5 string))))))
1428
1429(defun epg--status-VALIDSIG (context string)
1430 (let ((signature (car (epg-context-result-for context 'verify))))
1431 (when (and signature
1432 (eq (epg-signature-status signature) 'good)
1433 (string-match "\\`\\([^ ]+\\) [^ ]+ \\([^ ]+\\) \\([^ ]+\\) \
1434\\([0-9]+\\) [^ ]+ \\([0-9]+\\) \\([0-9]+\\) \\([0-9A-Fa-f][0-9A-Fa-f]\\) \
1435\\(.*\\)"
1436 string))
1437 (epg-signature-set-fingerprint
1438 signature
1439 (match-string 1 string))
1440 (epg-signature-set-creation-time
1441 signature
1442 (epg--time-from-seconds (match-string 2 string)))
1443 (unless (equal (match-string 3 string) "0")
1444 (epg-signature-set-expiration-time
1445 signature
1446 (epg--time-from-seconds (match-string 3 string))))
1447 (epg-signature-set-version
1448 signature
1449 (string-to-number (match-string 4 string)))
1450 (epg-signature-set-pubkey-algorithm
f1914c40 1451 signature
c154c0be
MO
1452 (string-to-number (match-string 5 string)))
1453 (epg-signature-set-digest-algorithm
1454 signature
1455 (string-to-number (match-string 6 string)))
1456 (epg-signature-set-class
1457 signature
1458 (string-to-number (match-string 7 string) 16)))))
1459
1460(defun epg--status-TRUST_UNDEFINED (context string)
1461 (let ((signature (car (epg-context-result-for context 'verify))))
1462 (if (and signature
1463 (eq (epg-signature-status signature) 'good))
1464 (epg-signature-set-validity signature 'undefined))))
1465
1466(defun epg--status-TRUST_NEVER (context string)
1467 (let ((signature (car (epg-context-result-for context 'verify))))
1468 (if (and signature
1469 (eq (epg-signature-status signature) 'good))
1470 (epg-signature-set-validity signature 'never))))
1471
1472(defun epg--status-TRUST_MARGINAL (context string)
1473 (let ((signature (car (epg-context-result-for context 'verify))))
1474 (if (and signature
1475 (eq (epg-signature-status signature) 'marginal))
1476 (epg-signature-set-validity signature 'marginal))))
1477
1478(defun epg--status-TRUST_FULLY (context string)
1479 (let ((signature (car (epg-context-result-for context 'verify))))
1480 (if (and signature
1481 (eq (epg-signature-status signature) 'good))
1482 (epg-signature-set-validity signature 'full))))
1483
1484(defun epg--status-TRUST_ULTIMATE (context string)
1485 (let ((signature (car (epg-context-result-for context 'verify))))
1486 (if (and signature
1487 (eq (epg-signature-status signature) 'good))
1488 (epg-signature-set-validity signature 'ultimate))))
1489
1490(defun epg--status-NOTATION_NAME (context string)
1491 (let ((signature (car (epg-context-result-for context 'verify))))
1492 (if signature
1493 (epg-signature-set-notations
1494 signature
1495 (cons (epg-make-sig-notation string nil t nil)
1496 (epg-sig-notations signature))))))
1497
1498(defun epg--status-NOTATION_DATA (context string)
1499 (let ((signature (car (epg-context-result-for context 'verify)))
1500 notation)
1501 (if (and signature
1502 (setq notation (car (epg-sig-notations signature))))
1503 (epg-sig-notation-set-value notation string))))
1504
1505(defun epg--status-POLICY_URL (context string)
1506 (let ((signature (car (epg-context-result-for context 'verify))))
1507 (if signature
1508 (epg-signature-set-notations
1509 signature
1510 (cons (epg-make-sig-notation nil string t nil)
1511 (epg-sig-notations signature))))))
1512
1513(defun epg--status-PROGRESS (context string)
1514 (if (and (epg-context-progress-callback context)
1515 (string-match "\\`\\([^ ]+\\) \\([^ ]\\) \\([0-9]+\\) \\([0-9]+\\)"
1516 string))
7c0ffa6d 1517 (funcall (car (epg-context-progress-callback context))
c154c0be
MO
1518 context
1519 (match-string 1 string)
1520 (match-string 2 string)
1521 (string-to-number (match-string 3 string))
1522 (string-to-number (match-string 4 string))
7c0ffa6d 1523 (cdr (epg-context-progress-callback context)))))
c154c0be
MO
1524
1525(defun epg--status-ENC_TO (context string)
1526 (if (string-match "\\`\\([0-9A-Za-z]+\\) \\([0-9]+\\) \\([0-9]+\\)" string)
1527 (epg-context-set-result-for
1528 context 'encrypted-to
1529 (cons (list (match-string 1 string)
1530 (string-to-number (match-string 2 string))
1531 (string-to-number (match-string 3 string)))
1532 (epg-context-result-for context 'encrypted-to)))))
1533
1534(defun epg--status-DECRYPTION_FAILED (context string)
1535 (epg-context-set-result-for context 'decryption-failed t))
1536
1537(defun epg--status-DECRYPTION_OKAY (context string)
1538 (epg-context-set-result-for context 'decryption-okay t))
1539
1540(defun epg--status-NODATA (context string)
1541 (epg-context-set-result-for
1542 context 'error
1543 (cons (cons 'no-data (string-to-number string))
1544 (epg-context-result-for context 'error))))
1545
1546(defun epg--status-UNEXPECTED (context string)
1547 (epg-context-set-result-for
1548 context 'error
1549 (cons (cons 'unexpected (string-to-number string))
1550 (epg-context-result-for context 'error))))
1551
1552(defun epg--status-KEYEXPIRED (context string)
1553 (epg-context-set-result-for
1554 context 'error
1555 (cons (list 'key-expired (cons 'expiration-time
1556 (epg--time-from-seconds string)))
1557 (epg-context-result-for context 'error))))
1558
1559(defun epg--status-KEYREVOKED (context string)
1560 (epg-context-set-result-for
1561 context 'error
1562 (cons '(key-revoked)
1563 (epg-context-result-for context 'error))))
1564
1565(defun epg--status-BADARMOR (context string)
1566 (epg-context-set-result-for
1567 context 'error
1568 (cons '(bad-armor)
1569 (epg-context-result-for context 'error))))
1570
1571(defun epg--status-INV_RECP (context string)
1572 (if (string-match "\\`\\([0-9]+\\) \\(.*\\)" string)
1573 (epg-context-set-result-for
1574 context 'error
1575 (cons (list 'invalid-recipient
1576 (cons 'reason
1577 (string-to-number (match-string 1 string)))
1578 (cons 'requested-recipient
1579 (match-string 2 string)))
1580 (epg-context-result-for context 'error)))))
1581
1582(defun epg--status-NO_RECP (context string)
1583 (epg-context-set-result-for
1584 context 'error
1585 (cons '(no-recipients)
1586 (epg-context-result-for context 'error))))
1587
1588(defun epg--status-DELETE_PROBLEM (context string)
1589 (if (string-match "\\`\\([0-9]+\\)" string)
1590 (epg-context-set-result-for
1591 context 'error
1592 (cons (cons 'delete-problem
1593 (string-to-number (match-string 1 string)))
1594 (epg-context-result-for context 'error)))))
1595
1596(defun epg--status-SIG_CREATED (context string)
1597 (if (string-match "\\`\\([DCS]\\) \\([0-9]+\\) \\([0-9]+\\) \
1598\\([0-9A-Fa-F][0-9A-Fa-F]\\) \\(.*\\) " string)
1599 (epg-context-set-result-for
1600 context 'sign
1601 (cons (epg-make-new-signature
1602 (cdr (assq (aref (match-string 1 string) 0)
1603 epg-new-signature-type-alist))
1604 (string-to-number (match-string 2 string))
1605 (string-to-number (match-string 3 string))
1606 (string-to-number (match-string 4 string) 16)
1607 (epg--time-from-seconds (match-string 5 string))
1608 (substring string (match-end 0)))
1609 (epg-context-result-for context 'sign)))))
1610
1611(defun epg--status-KEY_CREATED (context string)
1612 (if (string-match "\\`\\([BPS]\\) \\([^ ]+\\)" string)
1613 (epg-context-set-result-for
1614 context 'generate-key
1615 (cons (list (cons 'type (string-to-char (match-string 1 string)))
1616 (cons 'fingerprint (match-string 2 string)))
1617 (epg-context-result-for context 'generate-key)))))
1618
1619(defun epg--status-KEY_NOT_CREATED (context string)
1620 (epg-context-set-result-for
1621 context 'error
1622 (cons '(key-not-created)
1623 (epg-context-result-for context 'error))))
1624
1625(defun epg--status-IMPORTED (context string)
1626 (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
1627 (let* ((key-id (match-string 1 string))
1628 (user-id (match-string 2 string))
1629 (entry (assoc key-id epg-user-id-alist)))
1630 (condition-case nil
1631 (setq user-id (epg--decode-coding-string
1632 (epg--decode-percent-escape user-id)
1633 'utf-8))
1634 (error))
1635 (if entry
1636 (setcdr entry user-id)
1637 (setq epg-user-id-alist (cons (cons key-id user-id)
1638 epg-user-id-alist))))))
1639
1640(defun epg--status-IMPORT_OK (context string)
1641 (if (string-match "\\`\\([0-9]+\\)\\( \\(.+\\)\\)?" string)
1642 (let ((reason (string-to-number (match-string 1 string))))
1643 (epg-context-set-result-for
1644 context 'import-status
1645 (cons (epg-make-import-status (if (match-beginning 2)
1646 (match-string 3 string))
1647 nil
1648 (/= (logand reason 1) 0)
1649 (/= (logand reason 2) 0)
1650 (/= (logand reason 4) 0)
1651 (/= (logand reason 8) 0)
1652 (/= (logand reason 16) 0))
1653 (epg-context-result-for context 'import-status))))))
1654
1655(defun epg--status-IMPORT_PROBLEM (context string)
1656 (if (string-match "\\`\\([0-9]+\\)\\( \\(.+\\)\\)?" string)
1657 (epg-context-set-result-for
1658 context 'import-status
1659 (cons (epg-make-import-status
1660 (if (match-beginning 2)
1661 (match-string 3 string))
1662 (string-to-number (match-string 1 string)))
1663 (epg-context-result-for context 'import-status)))))
1664
1665(defun epg--status-IMPORT_RES (context string)
1666 (when (string-match "\\`\\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \
1667\\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) \
1668\\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)" string)
1669 (epg-context-set-result-for
1670 context 'import
1671 (epg-make-import-result (string-to-number (match-string 1 string))
1672 (string-to-number (match-string 2 string))
1673 (string-to-number (match-string 3 string))
1674 (string-to-number (match-string 4 string))
1675 (string-to-number (match-string 5 string))
1676 (string-to-number (match-string 6 string))
1677 (string-to-number (match-string 7 string))
1678 (string-to-number (match-string 8 string))
1679 (string-to-number (match-string 9 string))
1680 (string-to-number (match-string 10 string))
1681 (string-to-number (match-string 11 string))
1682 (string-to-number (match-string 12 string))
1683 (string-to-number (match-string 13 string))
1684 (epg-context-result-for context 'import-status)))
1685 (epg-context-set-result-for context 'import-status nil)))
1686
1687(defun epg-passphrase-callback-function (context key-id handback)
1688 (if (eq key-id 'SYM)
1689 (read-passwd "Passphrase for symmetric encryption: "
1690 (eq (epg-context-operation context) 'encrypt))
1691 (read-passwd
1692 (if (eq key-id 'PIN)
1693 "Passphrase for PIN: "
1694 (let ((entry (assoc key-id epg-user-id-alist)))
1695 (if entry
1696 (format "Passphrase for %s %s: " key-id (cdr entry))
1697 (format "Passphrase for %s: " key-id)))))))
1698
1699(make-obsolete 'epg-passphrase-callback-function
5443c9b7 1700 'epa-passphrase-callback-function "23.1")
c154c0be
MO
1701
1702(defun epg--list-keys-1 (context name mode)
1703 (let ((args (append (if epg-gpg-home-directory
1704 (list "--homedir" epg-gpg-home-directory))
1705 '("--with-colons" "--no-greeting" "--batch"
1706 "--with-fingerprint" "--with-fingerprint")
1707 (unless (eq (epg-context-protocol context) 'CMS)
1708 '("--fixed-list-mode"))))
1709 (list-keys-option (if (memq mode '(t secret))
1710 "--list-secret-keys"
1711 (if (memq mode '(nil public))
1712 "--list-keys"
1713 "--list-sigs")))
1714 (coding-system-for-read 'binary)
1715 keys string field index)
1716 (if name
1717 (progn
1718 (unless (listp name)
1719 (setq name (list name)))
1720 (while name
1721 (setq args (append args (list list-keys-option (car name)))
1722 name (cdr name))))
1723 (setq args (append args (list list-keys-option))))
1724 (with-temp-buffer
1725 (apply #'call-process
1726 (if (eq (epg-context-protocol context) 'CMS)
1727 epg-gpgsm-program
1728 epg-gpg-program)
1729 nil (list t nil) nil args)
1730 (goto-char (point-min))
1731 (while (re-search-forward "^[a-z][a-z][a-z]:.*" nil t)
1732 (setq keys (cons (make-vector 15 nil) keys)
1733 string (match-string 0)
1734 index 0
1735 field 0)
1736 (while (eq index
1737 (string-match "\\([^:]+\\)?:" string index))
1738 (setq index (match-end 0))
1739 (aset (car keys) field (match-string 1 string))
1740 (setq field (1+ field))))
1741 (nreverse keys))))
1742
1743(defun epg--make-sub-key-1 (line)
1744 (epg-make-sub-key
1745 (if (aref line 1)
1746 (cdr (assq (string-to-char (aref line 1)) epg-key-validity-alist)))
1747 (delq nil
1748 (mapcar (lambda (char) (cdr (assq char epg-key-capablity-alist)))
1749 (aref line 11)))
1750 (member (aref line 0) '("sec" "ssb"))
1751 (string-to-number (aref line 3))
1752 (string-to-number (aref line 2))
1753 (aref line 4)
1754 (epg--time-from-seconds (aref line 5))
1755 (if (aref line 6)
1756 (epg--time-from-seconds (aref line 6)))))
1757
1758;;;###autoload
1759(defun epg-list-keys (context &optional name mode)
1760 "Return a list of epg-key objects matched with NAME.
1761If MODE is nil or 'public, only public keyring should be searched.
f1914c40 1762If MODE is t or 'secret, only secret keyring should be searched.
c154c0be
MO
1763Otherwise, only public keyring should be searched and the key
1764signatures should be included.
1765NAME is either a string or a list of strings."
1766 (let ((lines (epg--list-keys-1 context name mode))
1767 keys cert pointer pointer-1 index string)
1768 (while lines
1769 (cond
1770 ((member (aref (car lines) 0) '("pub" "sec" "crt" "crs"))
1771 (setq cert (member (aref (car lines) 0) '("crt" "crs"))
1772 keys (cons (epg-make-key
1773 (if (aref (car lines) 8)
1774 (cdr (assq (string-to-char (aref (car lines) 8))
1775 epg-key-validity-alist))))
1776 keys))
1777 (epg-key-set-sub-key-list
1778 (car keys)
1779 (cons (epg--make-sub-key-1 (car lines))
1780 (epg-key-sub-key-list (car keys)))))
1781 ((member (aref (car lines) 0) '("sub" "ssb"))
1782 (epg-key-set-sub-key-list
1783 (car keys)
1784 (cons (epg--make-sub-key-1 (car lines))
1785 (epg-key-sub-key-list (car keys)))))
1786 ((equal (aref (car lines) 0) "uid")
1787 ;; Decode the UID name as a backslash escaped UTF-8 string,
1788 ;; generated by GnuPG/GpgSM.
1789 (setq string (copy-sequence (aref (car lines) 9))
1790 index 0)
1791 (while (string-match "\"" string index)
1792 (setq string (replace-match "\\\"" t t string)
1793 index (1+ (match-end 0))))
1794 (condition-case nil
1795 (setq string (epg--decode-coding-string
1796 (car (read-from-string (concat "\"" string "\"")))
1797 'utf-8))
1798 (error
1799 (setq string (aref (car lines) 9))))
1800 (epg-key-set-user-id-list
1801 (car keys)
1802 (cons (epg-make-user-id
1803 (if (aref (car lines) 1)
1804 (cdr (assq (string-to-char (aref (car lines) 1))
1805 epg-key-validity-alist)))
1806 (if cert
1807 (condition-case nil
1808 (epg-dn-from-string string)
1809 (error string))
1810 string))
1811 (epg-key-user-id-list (car keys)))))
1812 ((equal (aref (car lines) 0) "fpr")
1813 (epg-sub-key-set-fingerprint (car (epg-key-sub-key-list (car keys)))
1814 (aref (car lines) 9)))
1815 ((equal (aref (car lines) 0) "sig")
1816 (epg-user-id-set-signature-list
1817 (car (epg-key-user-id-list (car keys)))
1818 (cons
1819 (epg-make-key-signature
1820 (if (aref (car lines) 1)
1821 (cdr (assq (string-to-char (aref (car lines) 1))
1822 epg-key-validity-alist)))
1823 (string-to-number (aref (car lines) 3))
1824 (aref (car lines) 4)
1825 (epg--time-from-seconds (aref (car lines) 5))
1826 (epg--time-from-seconds (aref (car lines) 6))
1827 (aref (car lines) 9)
1828 (string-to-number (aref (car lines) 10) 16)
1829 (eq (aref (aref (car lines) 10) 2) ?x))
1830 (epg-user-id-signature-list
1831 (car (epg-key-user-id-list (car keys))))))))
1832 (setq lines (cdr lines)))
1833 (setq keys (nreverse keys)
1834 pointer keys)
1835 (while pointer
1836 (epg-key-set-sub-key-list
1837 (car pointer)
1838 (nreverse (epg-key-sub-key-list (car pointer))))
1839 (setq pointer-1 (epg-key-set-user-id-list
1840 (car pointer)
1841 (nreverse (epg-key-user-id-list (car pointer)))))
1842 (while pointer-1
1843 (epg-user-id-set-signature-list
1844 (car pointer-1)
1845 (nreverse (epg-user-id-signature-list (car pointer-1))))
1846 (setq pointer-1 (cdr pointer-1)))
1847 (setq pointer (cdr pointer)))
1848 keys))
1849
1850(eval-and-compile
1851 (if (fboundp 'make-temp-file)
1852 (defalias 'epg--make-temp-file 'make-temp-file)
1853 (defvar temporary-file-directory)
1854 ;; stolen from poe.el.
1855 (defun epg--make-temp-file (prefix)
1856 "Create a temporary file.
1857The returned file name (created by appending some random characters at the end
1858of PREFIX, and expanding against `temporary-file-directory' if necessary),
1859is guaranteed to point to a newly created empty file.
1860You can then use `write-region' to write new data into the file."
1861 (let (tempdir tempfile)
1862 (setq prefix (expand-file-name prefix
1863 (if (featurep 'xemacs)
1864 (temp-directory)
1865 temporary-file-directory)))
1866 (unwind-protect
1867 (let (file)
1868 ;; First, create a temporary directory.
1869 (while (condition-case ()
1870 (progn
1871 (setq tempdir (make-temp-name
1872 (concat
1873 (file-name-directory prefix)
1874 "DIR")))
1875 ;; return nil or signal an error.
1876 (make-directory tempdir))
1877 ;; let's try again.
1878 (file-already-exists t)))
1879 (set-file-modes tempdir 448)
1880 ;; Second, create a temporary file in the tempdir.
1881 ;; There *is* a race condition between `make-temp-name'
1882 ;; and `write-region', but we don't care it since we are
1883 ;; in a private directory now.
1884 (setq tempfile (make-temp-name (concat tempdir "/EMU")))
1885 (write-region "" nil tempfile nil 'silent)
1886 (set-file-modes tempfile 384)
1887 ;; Finally, make a hard-link from the tempfile.
1888 (while (condition-case ()
1889 (progn
1890 (setq file (make-temp-name prefix))
1891 ;; return nil or signal an error.
1892 (add-name-to-file tempfile file))
1893 ;; let's try again.
1894 (file-already-exists t)))
1895 file)
1896 ;; Cleanup the tempfile.
1897 (and tempfile
1898 (file-exists-p tempfile)
1899 (delete-file tempfile))
1900 ;; Cleanup the tempdir.
1901 (and tempdir
1902 (file-directory-p tempdir)
1903 (delete-directory tempdir)))))))
1904
1905(defun epg--args-from-sig-notations (notations)
1906 (apply #'nconc
1907 (mapcar
1908 (lambda (notation)
1909 (if (and (epg-sig-notation-name notation)
1910 (not (epg-sig-notation-human-readable notation)))
1911 (error "Unreadable"))
1912 (if (epg-sig-notation-name notation)
1913 (list "--sig-notation"
1914 (if (epg-sig-notation-critical notation)
1915 (concat "!" (epg-sig-notation-name notation)
1916 "=" (epg-sig-notation-value notation))
1917 (concat (epg-sig-notation-name notation)
1918 "=" (epg-sig-notation-value notation))))
1919 (list "--sig-policy-url"
1920 (if (epg-sig-notation-critical notation)
1921 (concat "!" (epg-sig-notation-value notation))
1922 (epg-sig-notation-value notation)))))
1923 notations)))
1924
1925;;;###autoload
1926(defun epg-cancel (context)
1927 (if (buffer-live-p (process-buffer (epg-context-process context)))
1928 (save-excursion
1929 (set-buffer (process-buffer (epg-context-process context)))
1930 (epg-context-set-result-for
1931 epg-context 'error
1932 (cons '(quit)
1933 (epg-context-result-for epg-context 'error)))))
1934 (if (eq (process-status (epg-context-process context)) 'run)
1935 (delete-process (epg-context-process context))))
1936
1937;;;###autoload
1938(defun epg-start-decrypt (context cipher)
1939 "Initiate a decrypt operation on CIPHER.
1940CIPHER must be a file data object.
1941
1942If you use this function, you will need to wait for the completion of
1943`epg-gpg-program' by using `epg-wait-for-completion' and call
1944`epg-reset' to clear a temporaly output file.
1945If you are unsure, use synchronous version of this function
1946`epg-decrypt-file' or `epg-decrypt-string' instead."
1947 (unless (epg-data-file cipher)
1948 (error "Not a file"))
1949 (epg-context-set-operation context 'decrypt)
1950 (epg-context-set-result context nil)
1951 (epg--start context (list "--decrypt" "--" (epg-data-file cipher)))
1952 ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
1953 (unless (eq (epg-context-protocol context) 'CMS)
1954 (epg-wait-for-status context '("BEGIN_DECRYPTION"))))
1955
1956(defun epg--check-error-for-decrypt (context)
1957 (if (epg-context-result-for context 'decryption-failed)
1958 (signal 'epg-error (list "Decryption failed")))
1959 (if (epg-context-result-for context 'no-secret-key)
1960 (signal 'epg-error
1961 (list "No secret key"
1962 (epg-context-result-for context 'no-secret-key))))
1963 (unless (epg-context-result-for context 'decryption-okay)
1964 (let* ((error (epg-context-result-for context 'error)))
1965 (if (assq 'no-data error)
1966 (signal 'epg-error (list "No data")))
1967 (signal 'epg-error (list "Can't decrypt" error)))))
1968
1969;;;###autoload
1970(defun epg-decrypt-file (context cipher plain)
1971 "Decrypt a file CIPHER and store the result to a file PLAIN.
1972If PLAIN is nil, it returns the result as a string."
1973 (unwind-protect
1974 (progn
1975 (if plain
1976 (epg-context-set-output-file context plain)
1977 (epg-context-set-output-file context
1978 (epg--make-temp-file "epg-output")))
1979 (epg-start-decrypt context (epg-make-data-from-file cipher))
1980 (epg-wait-for-completion context)
1981 (epg--check-error-for-decrypt context)
1982 (unless plain
1983 (epg-read-output context)))
1984 (unless plain
1985 (epg-delete-output-file context))
1986 (epg-reset context)))
1987
1988;;;###autoload
1989(defun epg-decrypt-string (context cipher)
1990 "Decrypt a string CIPHER and return the plain text."
1991 (let ((input-file (epg--make-temp-file "epg-input"))
1992 (coding-system-for-write 'binary))
1993 (unwind-protect
1994 (progn
1995 (write-region cipher nil input-file nil 'quiet)
1996 (epg-context-set-output-file context
1997 (epg--make-temp-file "epg-output"))
1998 (epg-start-decrypt context (epg-make-data-from-file input-file))
1999 (epg-wait-for-completion context)
2000 (epg--check-error-for-decrypt context)
2001 (epg-read-output context))
2002 (epg-delete-output-file context)
2003 (if (file-exists-p input-file)
2004 (delete-file input-file))
2005 (epg-reset context))))
2006
2007;;;###autoload
2008(defun epg-start-verify (context signature &optional signed-text)
2009 "Initiate a verify operation on SIGNATURE.
2010SIGNATURE and SIGNED-TEXT are a data object if they are specified.
2011
2012For a detached signature, both SIGNATURE and SIGNED-TEXT should be set.
2013For a normal or a cleartext signature, SIGNED-TEXT should be nil.
2014
2015If you use this function, you will need to wait for the completion of
2016`epg-gpg-program' by using `epg-wait-for-completion' and call
2017`epg-reset' to clear a temporaly output file.
2018If you are unsure, use synchronous version of this function
2019`epg-verify-file' or `epg-verify-string' instead."
2020 (epg-context-set-operation context 'verify)
2021 (epg-context-set-result context nil)
2022 (if signed-text
2023 ;; Detached signature.
2024 (if (epg-data-file signed-text)
2025 (epg--start context (list "--verify" "--" (epg-data-file signature)
2026 (epg-data-file signed-text)))
2027 (epg--start context (list "--verify" "--" (epg-data-file signature)
2028 "-"))
2029 (if (eq (process-status (epg-context-process context)) 'run)
2030 (process-send-string (epg-context-process context)
2031 (epg-data-string signed-text)))
2032 (if (eq (process-status (epg-context-process context)) 'run)
2033 (process-send-eof (epg-context-process context))))
2034 ;; Normal (or cleartext) signature.
2035 (if (epg-data-file signature)
761cd524
DU
2036 (epg--start context (if (eq (epg-context-protocol context) 'CMS)
2037 (list "--verify" "--" (epg-data-file signature))
2038 (list "--" (epg-data-file signature))))
2039 (epg--start context (if (eq (epg-context-protocol context) 'CMS)
2040 '("--verify" "-")
2041 '("-")))
c154c0be
MO
2042 (if (eq (process-status (epg-context-process context)) 'run)
2043 (process-send-string (epg-context-process context)
2044 (epg-data-string signature)))
2045 (if (eq (process-status (epg-context-process context)) 'run)
2046 (process-send-eof (epg-context-process context))))))
2047
2048;;;###autoload
2049(defun epg-verify-file (context signature &optional signed-text plain)
2050 "Verify a file SIGNATURE.
2051SIGNED-TEXT and PLAIN are also a file if they are specified.
2052
2053For a detached signature, both SIGNATURE and SIGNED-TEXT should be
2054string. For a normal or a cleartext signature, SIGNED-TEXT should be
2055nil. In the latter case, if PLAIN is specified, the plaintext is
2056stored into the file after successful verification."
2057 (unwind-protect
2058 (progn
2059 (if plain
2060 (epg-context-set-output-file context plain)
2061 (epg-context-set-output-file context
2062 (epg--make-temp-file "epg-output")))
2063 (if signed-text
2064 (epg-start-verify context
2065 (epg-make-data-from-file signature)
2066 (epg-make-data-from-file signed-text))
2067 (epg-start-verify context
2068 (epg-make-data-from-file signature)))
2069 (epg-wait-for-completion context)
2070 (unless plain
2071 (epg-read-output context)))
2072 (unless plain
2073 (epg-delete-output-file context))
2074 (epg-reset context)))
2075
2076;;;###autoload
2077(defun epg-verify-string (context signature &optional signed-text)
2078 "Verify a string SIGNATURE.
2079SIGNED-TEXT is a string if it is specified.
2080
2081For a detached signature, both SIGNATURE and SIGNED-TEXT should be
2082string. For a normal or a cleartext signature, SIGNED-TEXT should be
2083nil. In the latter case, this function returns the plaintext after
2084successful verification."
2085 (let ((coding-system-for-write 'binary)
2086 input-file)
2087 (unwind-protect
2088 (progn
2089 (epg-context-set-output-file context
2090 (epg--make-temp-file "epg-output"))
2091 (if signed-text
2092 (progn
2093 (setq input-file (epg--make-temp-file "epg-signature"))
2094 (write-region signature nil input-file nil 'quiet)
2095 (epg-start-verify context
2096 (epg-make-data-from-file input-file)
2097 (epg-make-data-from-string signed-text)))
2098 (epg-start-verify context (epg-make-data-from-string signature)))
2099 (epg-wait-for-completion context)
2100 (epg-read-output context))
2101 (epg-delete-output-file context)
2102 (if (and input-file
2103 (file-exists-p input-file))
2104 (delete-file input-file))
2105 (epg-reset context))))
2106
2107;;;###autoload
2108(defun epg-start-sign (context plain &optional mode)
2109 "Initiate a sign operation on PLAIN.
2110PLAIN is a data object.
2111
2112If optional 3rd argument MODE is t or 'detached, it makes a detached signature.
2113If it is nil or 'normal, it makes a normal signature.
2114Otherwise, it makes a cleartext signature.
2115
2116If you use this function, you will need to wait for the completion of
2117`epg-gpg-program' by using `epg-wait-for-completion' and call
2118`epg-reset' to clear a temporaly output file.
2119If you are unsure, use synchronous version of this function
2120`epg-sign-file' or `epg-sign-string' instead."
2121 (epg-context-set-operation context 'sign)
2122 (epg-context-set-result context nil)
2123 (unless (memq mode '(t detached nil normal)) ;i.e. cleartext
2124 (epg-context-set-armor context nil)
2125 (epg-context-set-textmode context nil))
2126 (epg--start context
2127 (append (list (if (memq mode '(t detached))
2128 "--detach-sign"
2129 (if (memq mode '(nil normal))
2130 "--sign"
2131 "--clearsign")))
2132 (apply #'nconc
2133 (mapcar
2134 (lambda (signer)
2135 (list "-u"
2136 (epg-sub-key-id
2137 (car (epg-key-sub-key-list signer)))))
2138 (epg-context-signers context)))
2139 (epg--args-from-sig-notations
2140 (epg-context-sig-notations context))
2141 (if (epg-data-file plain)
2142 (list "--" (epg-data-file plain)))))
2143 ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
2144 (unless (eq (epg-context-protocol context) 'CMS)
2145 (epg-wait-for-status context '("BEGIN_SIGNING")))
2146 (when (epg-data-string plain)
2147 (if (eq (process-status (epg-context-process context)) 'run)
2148 (process-send-string (epg-context-process context)
2149 (epg-data-string plain)))
2150 (if (eq (process-status (epg-context-process context)) 'run)
2151 (process-send-eof (epg-context-process context)))))
2152
2153;;;###autoload
2154(defun epg-sign-file (context plain signature &optional mode)
2155 "Sign a file PLAIN and store the result to a file SIGNATURE.
2156If SIGNATURE is nil, it returns the result as a string.
2157If optional 3rd argument MODE is t or 'detached, it makes a detached signature.
2158If it is nil or 'normal, it makes a normal signature.
2159Otherwise, it makes a cleartext signature."
2160 (unwind-protect
2161 (progn
2162 (if signature
2163 (epg-context-set-output-file context signature)
2164 (epg-context-set-output-file context
2165 (epg--make-temp-file "epg-output")))
2166 (epg-start-sign context (epg-make-data-from-file plain) mode)
2167 (epg-wait-for-completion context)
2168 (unless (epg-context-result-for context 'sign)
2169 (if (epg-context-result-for context 'error)
2170 (error "Sign failed: %S"
2171 (epg-context-result-for context 'error))
2172 (error "Sign failed")))
2173 (unless signature
2174 (epg-read-output context)))
2175 (unless signature
2176 (epg-delete-output-file context))
2177 (epg-reset context)))
2178
2179;;;###autoload
2180(defun epg-sign-string (context plain &optional mode)
2181 "Sign a string PLAIN and return the output as string.
2182If optional 3rd argument MODE is t or 'detached, it makes a detached signature.
2183If it is nil or 'normal, it makes a normal signature.
2184Otherwise, it makes a cleartext signature."
2185 (let ((input-file
2186 (unless (or (eq (epg-context-protocol context) 'CMS)
2187 (condition-case nil
2188 (progn
2189 (epg-check-configuration (epg-configuration))
2190 t)
2191 (error)))
2192 (epg--make-temp-file "epg-input")))
2193 (coding-system-for-write 'binary))
2194 (unwind-protect
2195 (progn
2196 (epg-context-set-output-file context
2197 (epg--make-temp-file "epg-output"))
2198 (if input-file
2199 (write-region plain nil input-file nil 'quiet))
2200 (epg-start-sign context
2201 (if input-file
2202 (epg-make-data-from-file input-file)
2203 (epg-make-data-from-string plain))
2204 mode)
2205 (epg-wait-for-completion context)
2206 (unless (epg-context-result-for context 'sign)
2207 (if (epg-context-result-for context 'error)
2208 (error "Sign failed: %S"
2209 (epg-context-result-for context 'error))
2210 (error "Sign failed")))
2211 (epg-read-output context))
2212 (epg-delete-output-file context)
2213 (if input-file
2214 (delete-file input-file))
2215 (epg-reset context))))
2216
2217;;;###autoload
2218(defun epg-start-encrypt (context plain recipients
2219 &optional sign always-trust)
2220 "Initiate an encrypt operation on PLAIN.
2221PLAIN is a data object.
2222If RECIPIENTS is nil, it performs symmetric encryption.
2223
2224If you use this function, you will need to wait for the completion of
2225`epg-gpg-program' by using `epg-wait-for-completion' and call
2226`epg-reset' to clear a temporaly output file.
2227If you are unsure, use synchronous version of this function
2228`epg-encrypt-file' or `epg-encrypt-string' instead."
2229 (epg-context-set-operation context 'encrypt)
2230 (epg-context-set-result context nil)
2231 (epg--start context
2232 (append (if always-trust '("--always-trust"))
2233 (if recipients '("--encrypt") '("--symmetric"))
2234 (if sign '("--sign"))
2235 (if sign
2236 (apply #'nconc
2237 (mapcar
2238 (lambda (signer)
2239 (list "-u"
2240 (epg-sub-key-id
2241 (car (epg-key-sub-key-list
2242 signer)))))
2243 (epg-context-signers context))))
2244 (if sign
2245 (epg--args-from-sig-notations
2246 (epg-context-sig-notations context)))
2247 (apply #'nconc
2248 (mapcar
2249 (lambda (recipient)
2250 (list "-r"
2251 (epg-sub-key-id
2252 (car (epg-key-sub-key-list recipient)))))
2253 recipients))
2254 (if (epg-data-file plain)
2255 (list "--" (epg-data-file plain)))))
2256 ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
2257 (unless (eq (epg-context-protocol context) 'CMS)
2258 (if sign
2259 (epg-wait-for-status context '("BEGIN_SIGNING"))
2260 (epg-wait-for-status context '("BEGIN_ENCRYPTION"))))
2261 (when (epg-data-string plain)
2262 (if (eq (process-status (epg-context-process context)) 'run)
2263 (process-send-string (epg-context-process context)
2264 (epg-data-string plain)))
2265 (if (eq (process-status (epg-context-process context)) 'run)
2266 (process-send-eof (epg-context-process context)))))
2267
2268;;;###autoload
2269(defun epg-encrypt-file (context plain recipients
2270 cipher &optional sign always-trust)
2271 "Encrypt a file PLAIN and store the result to a file CIPHER.
2272If CIPHER is nil, it returns the result as a string.
2273If RECIPIENTS is nil, it performs symmetric encryption."
2274 (unwind-protect
2275 (progn
2276 (if cipher
2277 (epg-context-set-output-file context cipher)
2278 (epg-context-set-output-file context
2279 (epg--make-temp-file "epg-output")))
2280 (epg-start-encrypt context (epg-make-data-from-file plain)
2281 recipients sign always-trust)
2282 (epg-wait-for-completion context)
2283 (if (and sign
2284 (not (epg-context-result-for context 'sign)))
2285 (if (epg-context-result-for context 'error)
2286 (error "Sign failed: %S"
2287 (epg-context-result-for context 'error))
2288 (error "Sign failed")))
2289 (if (epg-context-result-for context 'error)
2290 (error "Encrypt failed: %S"
2291 (epg-context-result-for context 'error)))
2292 (unless cipher
2293 (epg-read-output context)))
2294 (unless cipher
2295 (epg-delete-output-file context))
2296 (epg-reset context)))
2297
2298;;;###autoload
2299(defun epg-encrypt-string (context plain recipients
2300 &optional sign always-trust)
2301 "Encrypt a string PLAIN.
2302If RECIPIENTS is nil, it performs symmetric encryption."
2303 (let ((input-file
2304 (unless (or (not sign)
2305 (eq (epg-context-protocol context) 'CMS)
2306 (condition-case nil
2307 (progn
2308 (epg-check-configuration (epg-configuration))
2309 t)
2310 (error)))
2311 (epg--make-temp-file "epg-input")))
2312 (coding-system-for-write 'binary))
2313 (unwind-protect
2314 (progn
2315 (epg-context-set-output-file context
2316 (epg--make-temp-file "epg-output"))
2317 (if input-file
2318 (write-region plain nil input-file nil 'quiet))
2319 (epg-start-encrypt context
2320 (if input-file
2321 (epg-make-data-from-file input-file)
2322 (epg-make-data-from-string plain))
2323 recipients sign always-trust)
2324 (epg-wait-for-completion context)
2325 (if (and sign
2326 (not (epg-context-result-for context 'sign)))
2327 (if (epg-context-result-for context 'error)
2328 (error "Sign failed: %S"
2329 (epg-context-result-for context 'error))
2330 (error "Sign failed")))
2331 (if (epg-context-result-for context 'error)
2332 (error "Encrypt failed: %S"
2333 (epg-context-result-for context 'error)))
2334 (epg-read-output context))
2335 (epg-delete-output-file context)
2336 (if input-file
2337 (delete-file input-file))
2338 (epg-reset context))))
2339
2340;;;###autoload
2341(defun epg-start-export-keys (context keys)
2342 "Initiate an export keys operation.
2343
2344If you use this function, you will need to wait for the completion of
2345`epg-gpg-program' by using `epg-wait-for-completion' and call
2346`epg-reset' to clear a temporaly output file.
2347If you are unsure, use synchronous version of this function
2348`epg-export-keys-to-file' or `epg-export-keys-to-string' instead."
2349 (epg-context-set-operation context 'export-keys)
2350 (epg-context-set-result context nil)
2351 (epg--start context (cons "--export"
2352 (mapcar
2353 (lambda (key)
2354 (epg-sub-key-id
2355 (car (epg-key-sub-key-list key))))
2356 keys))))
2357
2358;;;###autoload
2359(defun epg-export-keys-to-file (context keys file)
2360 "Extract public KEYS."
2361 (unwind-protect
2362 (progn
2363 (if file
2364 (epg-context-set-output-file context file)
2365 (epg-context-set-output-file context
2366 (epg--make-temp-file "epg-output")))
2367 (epg-start-export-keys context keys)
2368 (epg-wait-for-completion context)
2369 (if (epg-context-result-for context 'error)
2370 (error "Export keys failed: %S"
2371 (epg-context-result-for context 'error)))
2372 (unless file
2373 (epg-read-output context)))
2374 (unless file
2375 (epg-delete-output-file context))
2376 (epg-reset context)))
2377
2378;;;###autoload
2379(defun epg-export-keys-to-string (context keys)
2380 "Extract public KEYS and return them as a string."
2381 (epg-export-keys-to-file context keys nil))
2382
2383;;;###autoload
2384(defun epg-start-import-keys (context keys)
2385 "Initiate an import keys operation.
2386KEYS is a data object.
2387
2388If you use this function, you will need to wait for the completion of
2389`epg-gpg-program' by using `epg-wait-for-completion' and call
2390`epg-reset' to clear a temporaly output file.
2391If you are unsure, use synchronous version of this function
2392`epg-import-keys-from-file' or `epg-import-keys-from-string' instead."
2393 (epg-context-set-operation context 'import-keys)
2394 (epg-context-set-result context nil)
2395 (epg--start context (if (epg-data-file keys)
2396 (list "--import" "--" (epg-data-file keys))
2397 (list "--import")))
2398 (when (epg-data-string keys)
2399 (if (eq (process-status (epg-context-process context)) 'run)
2400 (process-send-string (epg-context-process context)
2401 (epg-data-string keys)))
2402 (if (eq (process-status (epg-context-process context)) 'run)
2403 (process-send-eof (epg-context-process context)))))
2404
2405(defun epg--import-keys-1 (context keys)
2406 (unwind-protect
2407 (progn
2408 (epg-start-import-keys context keys)
2409 (epg-wait-for-completion context)
2410 (if (epg-context-result-for context 'error)
2411 (error "Import keys failed: %S"
2412 (epg-context-result-for context 'error))))
2413 (epg-reset context)))
2414
2415;;;###autoload
2416(defun epg-import-keys-from-file (context keys)
2417 "Add keys from a file KEYS."
2418 (epg--import-keys-1 context (epg-make-data-from-file keys)))
2419
2420;;;###autoload
2421(defun epg-import-keys-from-string (context keys)
2422 "Add keys from a string KEYS."
2423 (epg--import-keys-1 context (epg-make-data-from-string keys)))
2424
2425;;;###autoload
2426(defun epg-start-receive-keys (context key-id-list)
2427 "Initiate a receive key operation.
2428KEY-ID-LIST is a list of key IDs.
2429
2430If you use this function, you will need to wait for the completion of
2431`epg-gpg-program' by using `epg-wait-for-completion' and call
2432`epg-reset' to clear a temporaly output file.
2433If you are unsure, use synchronous version of this function
2c6c404a 2434`epg-receive-keys' instead."
c154c0be
MO
2435 (epg-context-set-operation context 'receive-keys)
2436 (epg-context-set-result context nil)
2437 (epg--start context (cons "--recv-keys" key-id-list)))
2438
2439;;;###autoload
2440(defun epg-receive-keys (context keys)
2441 "Add keys from server.
2442KEYS is a list of key IDs"
2443 (unwind-protect
2444 (progn
2445 (epg-start-receive-keys context keys)
2446 (epg-wait-for-completion context)
2447 (if (epg-context-result-for context 'error)
2448 (error "Receive keys failed: %S"
2449 (epg-context-result-for context 'error))))
2450 (epg-reset context)))
2451
2452;;;###autoload
2453(defalias 'epg-import-keys-from-server 'epg-receive-keys)
2454
2455;;;###autoload
2456(defun epg-start-delete-keys (context keys &optional allow-secret)
05234615 2457 "Initiate a delete keys operation.
c154c0be
MO
2458
2459If you use this function, you will need to wait for the completion of
2460`epg-gpg-program' by using `epg-wait-for-completion' and call
2461`epg-reset' to clear a temporaly output file.
2462If you are unsure, use synchronous version of this function
2463`epg-delete-keys' instead."
2464 (epg-context-set-operation context 'delete-keys)
2465 (epg-context-set-result context nil)
2466 (epg--start context (cons (if allow-secret
2467 "--delete-secret-key"
2468 "--delete-key")
2469 (mapcar
2470 (lambda (key)
2471 (epg-sub-key-id
2472 (car (epg-key-sub-key-list key))))
2473 keys))))
2474
2475;;;###autoload
2476(defun epg-delete-keys (context keys &optional allow-secret)
2477 "Delete KEYS from the key ring."
2478 (unwind-protect
2479 (progn
2480 (epg-start-delete-keys context keys allow-secret)
2481 (epg-wait-for-completion context)
2482 (let ((entry (assq 'delete-problem
2483 (epg-context-result-for context 'error))))
2484 (if entry
2485 (if (setq entry (assq (cdr entry)
2486 epg-delete-problem-reason-alist))
2487 (error "Delete keys failed: %s" (cdr entry))
2488 (error "Delete keys failed")))))
2489 (epg-reset context)))
2490
2491;;;###autoload
2492(defun epg-start-sign-keys (context keys &optional local)
2493 "Initiate a sign keys operation.
2494
2495If you use this function, you will need to wait for the completion of
2496`epg-gpg-program' by using `epg-wait-for-completion' and call
2497`epg-reset' to clear a temporaly output file.
2498If you are unsure, use synchronous version of this function
2499`epg-sign-keys' instead."
2500 (epg-context-set-operation context 'sign-keys)
2501 (epg-context-set-result context nil)
2502 (epg--start context (cons (if local
2503 "--lsign-key"
2504 "--sign-key")
2505 (mapcar
2506 (lambda (key)
2507 (epg-sub-key-id
2508 (car (epg-key-sub-key-list key))))
2509 keys))))
5443c9b7 2510(make-obsolete 'epg-start-sign-keys "do not use." "23.1")
c154c0be
MO
2511
2512;;;###autoload
2513(defun epg-sign-keys (context keys &optional local)
2514 "Sign KEYS from the key ring."
2515 (unwind-protect
2516 (progn
2517 (epg-start-sign-keys context keys local)
2518 (epg-wait-for-completion context)
2519 (if (epg-context-result-for context 'error)
2520 (error "Sign keys failed: %S"
2521 (epg-context-result-for context 'error))))
2522 (epg-reset context)))
5443c9b7 2523(make-obsolete 'epg-sign-keys "do not use." "23.1")
c154c0be
MO
2524
2525;;;###autoload
2526(defun epg-start-generate-key (context parameters)
2527 "Initiate a key generation.
2528PARAMETERS specifies parameters for the key.
2529
2530If you use this function, you will need to wait for the completion of
2531`epg-gpg-program' by using `epg-wait-for-completion' and call
2532`epg-reset' to clear a temporaly output file.
2533If you are unsure, use synchronous version of this function
2534`epg-generate-key-from-file' or `epg-generate-key-from-string' instead."
2535 (epg-context-set-operation context 'generate-key)
2536 (epg-context-set-result context nil)
2537 (if (epg-data-file parameters)
2538 (epg--start context (list "--batch" "--genkey" "--"
2539 (epg-data-file parameters)))
2540 (epg--start context '("--batch" "--genkey"))
2541 (if (eq (process-status (epg-context-process context)) 'run)
2542 (process-send-string (epg-context-process context)
2543 (epg-data-string parameters)))
2544 (if (eq (process-status (epg-context-process context)) 'run)
2545 (process-send-eof (epg-context-process context)))))
2546
2547;;;###autoload
2548(defun epg-generate-key-from-file (context parameters)
2549 "Generate a new key pair.
2550PARAMETERS is a file which tells how to create the key."
2551 (unwind-protect
2552 (progn
2553 (epg-start-generate-key context (epg-make-data-from-file parameters))
2554 (epg-wait-for-completion context)
2555 (if (epg-context-result-for context 'error)
2556 (error "Generate key failed: %S"
2557 (epg-context-result-for context 'error))))
2558 (epg-reset context)))
2559
2560;;;###autoload
2561(defun epg-generate-key-from-string (context parameters)
2562 "Generate a new key pair.
2563PARAMETERS is a string which tells how to create the key."
2564 (unwind-protect
2565 (progn
2566 (epg-start-generate-key context (epg-make-data-from-string parameters))
2567 (epg-wait-for-completion context)
2568 (if (epg-context-result-for context 'error)
2569 (error "Generate key failed: %S"
2570 (epg-context-result-for context 'error))))
2571 (epg-reset context)))
2572
2573(defun epg--decode-percent-escape (string)
2574 (let ((index 0))
2575 (while (string-match "%\\(\\(%\\)\\|\\([0-9A-Fa-f][0-9A-Fa-f]\\)\\)"
2576 string index)
2577 (if (match-beginning 2)
2578 (setq string (replace-match "%" t t string)
2579 index (1- (match-end 0)))
2580 (setq string (replace-match
2581 (string (string-to-number (match-string 3 string) 16))
2582 t t string)
2583 index (- (match-end 0) 2))))
2584 string))
2585
2586(defun epg--decode-hexstring (string)
2587 (let ((index 0))
2588 (while (eq index (string-match "[0-9A-Fa-f][0-9A-Fa-f]" string index))
2589 (setq string (replace-match (string (string-to-number
2590 (match-string 0 string) 16))
2591 t t string)
2592 index (1- (match-end 0))))
2593 string))
2594
2595(defun epg--decode-quotedstring (string)
2596 (let ((index 0))
2597 (while (string-match "\\\\\\(\\([,=+<>#;\\\"]\\)\\|\
2598\\([0-9A-Fa-f][0-9A-Fa-f]\\)\\)"
2599 string index)
2600 (if (match-beginning 2)
2601 (setq string (replace-match "\\2" t nil string)
2602 index (1- (match-end 0)))
2603 (if (match-beginning 3)
2604 (setq string (replace-match (string (string-to-number
2605 (match-string 0 string) 16))
2606 t t string)
2607 index (- (match-end 0) 2)))))
2608 string))
2609
2610(defun epg-dn-from-string (string)
2611 "Parse STRING as LADPv3 Distinguished Names (RFC2253).
2612The return value is an alist mapping from types to values."
2613 (let ((index 0)
2614 (length (length string))
2615 alist type value group)
2616 (while (< index length)
2617 (if (eq index (string-match "[ \t\n\r]*" string index))
2618 (setq index (match-end 0)))
2619 (if (eq index (string-match
2620 "\\([0-9]+\\(\\.[0-9]+\\)*\\)\[ \t\n\r]*=[ \t\n\r]*"
2621 string index))
2622 (setq type (match-string 1 string)
2623 index (match-end 0))
2624 (if (eq index (string-match "\\([0-9A-Za-z]+\\)[ \t\n\r]*=[ \t\n\r]*"
2625 string index))
2626 (setq type (match-string 1 string)
2627 index (match-end 0))))
2628 (unless type
2629 (error "Invalid type"))
2630 (if (eq index (string-match
2631 "\\([^,=+<>#;\\\"]\\|\\\\.\\)+"
2632 string index))
2633 (setq index (match-end 0)
2634 value (epg--decode-quotedstring (match-string 0 string)))
2635 (if (eq index (string-match "#\\([0-9A-Fa-f]+\\)" string index))
2636 (setq index (match-end 0)
2637 value (epg--decode-hexstring (match-string 1 string)))
2638 (if (eq index (string-match "\"\\([^\\\"]\\|\\\\.\\)*\""
2639 string index))
2640 (setq index (match-end 0)
2641 value (epg--decode-quotedstring
2642 (match-string 0 string))))))
2643 (if group
2644 (if (stringp (car (car alist)))
2645 (setcar alist (list (cons type value) (car alist)))
2646 (setcar alist (cons (cons type value) (car alist))))
2647 (if (consp (car (car alist)))
2648 (setcar alist (nreverse (car alist))))
2649 (setq alist (cons (cons type value) alist)
2650 type nil
2651 value nil))
2652 (if (eq index (string-match "[ \t\n\r]*\\([,;+]\\)" string index))
2653 (setq index (match-end 0)
2654 group (eq (aref string (match-beginning 1)) ?+))))
2655 (nreverse alist)))
2656
2657(defun epg-decode-dn (alist)
2658 "Convert ALIST returned by `epg-dn-from-string' to a human readable form.
2659Type names are resolved using `epg-dn-type-alist'."
2660 (mapconcat
2661 (lambda (rdn)
2662 (if (stringp (car rdn))
2663 (let ((entry (assoc (car rdn) epg-dn-type-alist)))
2664 (if entry
2665 (format "%s=%s" (cdr entry) (cdr rdn))
2666 (format "%s=%s" (car rdn) (cdr rdn))))
2667 (concat "(" (epg-decode-dn rdn) ")")))
2668 alist
2669 ", "))
2670
2671(provide 'epg)
2672
37b77401 2673;; arch-tag: de8f0acc-1bcf-4c14-a09e-bfffe1b579b7
c154c0be 2674;;; epg.el ends here