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