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