|
91647
|
1 ;;; epg.el --- the EasyPG Library
|
|
|
2 ;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
|
|
106815
|
3 ;; 2005, 2006, 2007, 2008, 2009, 2010 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)
|
|
108294
|
140 (?a . authentication)
|
|
|
141 (?D . disabled)))
|
|
91647
|
142
|
|
|
143 (defvar epg-new-signature-type-alist
|
|
|
144 '((?D . detached)
|
|
|
145 (?C . clear)
|
|
|
146 (?S . normal)))
|
|
|
147
|
|
|
148 (defvar epg-dn-type-alist
|
|
|
149 '(("1.2.840.113549.1.9.1" . "EMail")
|
|
|
150 ("2.5.4.12" . "T")
|
|
|
151 ("2.5.4.42" . "GN")
|
|
|
152 ("2.5.4.4" . "SN")
|
|
|
153 ("0.2.262.1.10.7.20" . "NameDistinguisher")
|
|
|
154 ("2.5.4.16" . "ADDR")
|
|
|
155 ("2.5.4.15" . "BC")
|
|
|
156 ("2.5.4.13" . "D")
|
|
|
157 ("2.5.4.17" . "PostalCode")
|
|
|
158 ("2.5.4.65" . "Pseudo")
|
|
|
159 ("2.5.4.5" . "SerialNumber")))
|
|
|
160
|
|
|
161 (defvar epg-prompt-alist nil)
|
|
|
162
|
|
|
163 (put 'epg-error 'error-conditions '(epg-error error))
|
|
|
164
|
|
|
165 (defun epg-make-data-from-file (file)
|
|
|
166 "Make a data object from FILE."
|
|
|
167 (cons 'epg-data (vector file nil)))
|
|
|
168
|
|
|
169 (defun epg-make-data-from-string (string)
|
|
|
170 "Make a data object from STRING."
|
|
|
171 (cons 'epg-data (vector nil string)))
|
|
|
172
|
|
|
173 (defun epg-data-file (data)
|
|
|
174 "Return the file of DATA."
|
|
|
175 (unless (eq (car-safe data) 'epg-data)
|
|
|
176 (signal 'wrong-type-argument (list 'epg-data-p data)))
|
|
|
177 (aref (cdr data) 0))
|
|
|
178
|
|
|
179 (defun epg-data-string (data)
|
|
|
180 "Return the string of DATA."
|
|
|
181 (unless (eq (car-safe data) 'epg-data)
|
|
|
182 (signal 'wrong-type-argument (list 'epg-data-p data)))
|
|
|
183 (aref (cdr data) 1))
|
|
|
184
|
|
104984
|
185 ;;;###autoload
|
|
91647
|
186 (defun epg-make-context (&optional protocol armor textmode include-certs
|
|
|
187 cipher-algorithm digest-algorithm
|
|
|
188 compress-algorithm)
|
|
|
189 "Return a context object."
|
|
|
190 (cons 'epg-context
|
|
|
191 (vector (or protocol 'OpenPGP) armor textmode include-certs
|
|
|
192 cipher-algorithm digest-algorithm compress-algorithm
|
|
97587
|
193 (list #'epg-passphrase-callback-function)
|
|
91647
|
194 nil
|
|
|
195 nil nil nil nil nil nil)))
|
|
|
196
|
|
|
197 (defun epg-context-protocol (context)
|
|
|
198 "Return the protocol used within CONTEXT."
|
|
|
199 (unless (eq (car-safe context) 'epg-context)
|
|
|
200 (signal 'wrong-type-argument (list 'epg-context-p context)))
|
|
|
201 (aref (cdr context) 0))
|
|
|
202
|
|
|
203 (defun epg-context-armor (context)
|
|
92510
|
204 "Return t if the output should be ASCII armored in CONTEXT."
|
|
91647
|
205 (unless (eq (car-safe context) 'epg-context)
|
|
|
206 (signal 'wrong-type-argument (list 'epg-context-p context)))
|
|
|
207 (aref (cdr context) 1))
|
|
|
208
|
|
|
209 (defun epg-context-textmode (context)
|
|
|
210 "Return t if canonical text mode should be used in CONTEXT."
|
|
|
211 (unless (eq (car-safe context) 'epg-context)
|
|
|
212 (signal 'wrong-type-argument (list 'epg-context-p context)))
|
|
|
213 (aref (cdr context) 2))
|
|
|
214
|
|
|
215 (defun epg-context-include-certs (context)
|
|
92510
|
216 "Return how many certificates should be included in an S/MIME signed message."
|
|
91647
|
217 (unless (eq (car-safe context) 'epg-context)
|
|
|
218 (signal 'wrong-type-argument (list 'epg-context-p context)))
|
|
|
219 (aref (cdr context) 3))
|
|
|
220
|
|
|
221 (defun epg-context-cipher-algorithm (context)
|
|
|
222 "Return the cipher algorithm in CONTEXT."
|
|
|
223 (unless (eq (car-safe context) 'epg-context)
|
|
|
224 (signal 'wrong-type-argument (list 'epg-context-p context)))
|
|
|
225 (aref (cdr context) 4))
|
|
|
226
|
|
|
227 (defun epg-context-digest-algorithm (context)
|
|
|
228 "Return the digest algorithm in CONTEXT."
|
|
|
229 (unless (eq (car-safe context) 'epg-context)
|
|
|
230 (signal 'wrong-type-argument (list 'epg-context-p context)))
|
|
|
231 (aref (cdr context) 5))
|
|
|
232
|
|
|
233 (defun epg-context-compress-algorithm (context)
|
|
|
234 "Return the compress algorithm in CONTEXT."
|
|
|
235 (unless (eq (car-safe context) 'epg-context)
|
|
|
236 (signal 'wrong-type-argument (list 'epg-context-p context)))
|
|
|
237 (aref (cdr context) 6))
|
|
|
238
|
|
|
239 (defun epg-context-passphrase-callback (context)
|
|
|
240 "Return the function used to query passphrase."
|
|
|
241 (unless (eq (car-safe context) 'epg-context)
|
|
|
242 (signal 'wrong-type-argument (list 'epg-context-p context)))
|
|
|
243 (aref (cdr context) 7))
|
|
|
244
|
|
|
245 (defun epg-context-progress-callback (context)
|
|
|
246 "Return the function which handles progress update."
|
|
|
247 (unless (eq (car-safe context) 'epg-context)
|
|
|
248 (signal 'wrong-type-argument (list 'epg-context-p context)))
|
|
|
249 (aref (cdr context) 8))
|
|
|
250
|
|
|
251 (defun epg-context-signers (context)
|
|
92510
|
252 "Return the list of key-id for signing."
|
|
91647
|
253 (unless (eq (car-safe context) 'epg-context)
|
|
|
254 (signal 'wrong-type-argument (list 'epg-context-p context)))
|
|
|
255 (aref (cdr context) 9))
|
|
|
256
|
|
|
257 (defun epg-context-sig-notations (context)
|
|
92510
|
258 "Return the list of notations for signing."
|
|
91647
|
259 (unless (eq (car-safe context) 'epg-context)
|
|
|
260 (signal 'wrong-type-argument (list 'epg-context-p context)))
|
|
|
261 (aref (cdr context) 10))
|
|
|
262
|
|
|
263 (defun epg-context-process (context)
|
|
|
264 "Return the process object of `epg-gpg-program'.
|
|
|
265 This function is for internal use only."
|
|
|
266 (unless (eq (car-safe context) 'epg-context)
|
|
|
267 (signal 'wrong-type-argument (list 'epg-context-p context)))
|
|
|
268 (aref (cdr context) 11))
|
|
|
269
|
|
|
270 (defun epg-context-output-file (context)
|
|
|
271 "Return the output file of `epg-gpg-program'.
|
|
|
272 This function is for internal use only."
|
|
|
273 (unless (eq (car-safe context) 'epg-context)
|
|
|
274 (signal 'wrong-type-argument (list 'epg-context-p context)))
|
|
|
275 (aref (cdr context) 12))
|
|
|
276
|
|
|
277 (defun epg-context-result (context)
|
|
|
278 "Return the result of the previous cryptographic operation."
|
|
|
279 (unless (eq (car-safe context) 'epg-context)
|
|
|
280 (signal 'wrong-type-argument (list 'epg-context-p context)))
|
|
|
281 (aref (cdr context) 13))
|
|
|
282
|
|
|
283 (defun epg-context-operation (context)
|
|
|
284 "Return the name of the current cryptographic operation."
|
|
|
285 (unless (eq (car-safe context) 'epg-context)
|
|
|
286 (signal 'wrong-type-argument (list 'epg-context-p context)))
|
|
|
287 (aref (cdr context) 14))
|
|
|
288
|
|
|
289 (defun epg-context-set-protocol (context protocol)
|
|
|
290 "Set the protocol used within CONTEXT."
|
|
|
291 (unless (eq (car-safe context) 'epg-context)
|
|
|
292 (signal 'wrong-type-argument (list 'epg-context-p context)))
|
|
|
293 (aset (cdr context) 0 protocol))
|
|
|
294
|
|
|
295 (defun epg-context-set-armor (context armor)
|
|
92510
|
296 "Specify if the output should be ASCII armored in CONTEXT."
|
|
91647
|
297 (unless (eq (car-safe context) 'epg-context)
|
|
|
298 (signal 'wrong-type-argument (list 'epg-context-p context)))
|
|
|
299 (aset (cdr context) 1 armor))
|
|
|
300
|
|
|
301 (defun epg-context-set-textmode (context textmode)
|
|
|
302 "Specify if canonical text mode should be used in CONTEXT."
|
|
|
303 (unless (eq (car-safe context) 'epg-context)
|
|
|
304 (signal 'wrong-type-argument (list 'epg-context-p context)))
|
|
|
305 (aset (cdr context) 2 textmode))
|
|
|
306
|
|
|
307 (defun epg-context-set-include-certs (context include-certs)
|
|
|
308 "Set how many certificates should be included in an S/MIME signed message."
|
|
|
309 (unless (eq (car-safe context) 'epg-context)
|
|
|
310 (signal 'wrong-type-argument (list 'epg-context-p context)))
|
|
|
311 (aset (cdr context) 3 include-certs))
|
|
|
312
|
|
|
313 (defun epg-context-set-cipher-algorithm (context cipher-algorithm)
|
|
|
314 "Set the cipher algorithm in CONTEXT."
|
|
|
315 (unless (eq (car-safe context) 'epg-context)
|
|
|
316 (signal 'wrong-type-argument (list 'epg-context-p context)))
|
|
|
317 (aset (cdr context) 4 cipher-algorithm))
|
|
|
318
|
|
|
319 (defun epg-context-set-digest-algorithm (context digest-algorithm)
|
|
|
320 "Set the digest algorithm in CONTEXT."
|
|
|
321 (unless (eq (car-safe context) 'epg-context)
|
|
|
322 (signal 'wrong-type-argument (list 'epg-context-p context)))
|
|
|
323 (aset (cdr context) 5 digest-algorithm))
|
|
|
324
|
|
|
325 (defun epg-context-set-compress-algorithm (context compress-algorithm)
|
|
|
326 "Set the compress algorithm in CONTEXT."
|
|
|
327 (unless (eq (car-safe context) 'epg-context)
|
|
|
328 (signal 'wrong-type-argument (list 'epg-context-p context)))
|
|
|
329 (aset (cdr context) 6 compress-algorithm))
|
|
|
330
|
|
|
331 (defun epg-context-set-passphrase-callback (context
|
|
|
332 passphrase-callback)
|
|
104963
|
333 "Set the function used to query passphrase.
|
|
|
334
|
|
|
335 PASSPHRASE-CALLBACK is either a function, or a cons-cell whose
|
|
|
336 car is a function and cdr is a callback data.
|
|
104964
|
337
|
|
104963
|
338 The function gets three arguments: the context, the key-id in
|
|
|
339 question, and the callback data (if any)."
|
|
91647
|
340 (unless (eq (car-safe context) 'epg-context)
|
|
|
341 (signal 'wrong-type-argument (list 'epg-context-p context)))
|
|
97587
|
342 (aset (cdr context) 7 (if (consp passphrase-callback)
|
|
|
343 passphrase-callback
|
|
|
344 (list passphrase-callback))))
|
|
91647
|
345
|
|
|
346 (defun epg-context-set-progress-callback (context
|
|
|
347 progress-callback)
|
|
|
348 "Set the function which handles progress update.
|
|
104963
|
349
|
|
|
350 PROGRESS-CALLBACK is either a function, or a cons-cell whose
|
|
|
351 car is a function and cdr is a callback data.
|
|
|
352
|
|
|
353 The function gets five arguments: the context, the operation
|
|
|
354 description, the character to display a progress unit, the
|
|
|
355 current amount done, the total amount to be done, and the
|
|
|
356 callback data (if any)."
|
|
91647
|
357 (unless (eq (car-safe context) 'epg-context)
|
|
|
358 (signal 'wrong-type-argument (list 'epg-context-p context)))
|
|
97587
|
359 (aset (cdr context) 8 (if (consp progress-callback)
|
|
|
360 progress-callback
|
|
|
361 (list progress-callback))))
|
|
91647
|
362
|
|
|
363 (defun epg-context-set-signers (context signers)
|
|
92510
|
364 "Set the list of key-id for signing."
|
|
91647
|
365 (unless (eq (car-safe context) 'epg-context)
|
|
|
366 (signal 'wrong-type-argument (list 'epg-context-p context)))
|
|
|
367 (aset (cdr context) 9 signers))
|
|
|
368
|
|
|
369 (defun epg-context-set-sig-notations (context notations)
|
|
92510
|
370 "Set the list of notations for signing."
|
|
91647
|
371 (unless (eq (car-safe context) 'epg-context)
|
|
|
372 (signal 'wrong-type-argument (list 'epg-context-p context)))
|
|
|
373 (aset (cdr context) 10 notations))
|
|
|
374
|
|
|
375 (defun epg-context-set-process (context process)
|
|
|
376 "Set the process object of `epg-gpg-program'.
|
|
|
377 This function is for internal use only."
|
|
|
378 (unless (eq (car-safe context) 'epg-context)
|
|
|
379 (signal 'wrong-type-argument (list 'epg-context-p context)))
|
|
|
380 (aset (cdr context) 11 process))
|
|
|
381
|
|
|
382 (defun epg-context-set-output-file (context output-file)
|
|
|
383 "Set the output file of `epg-gpg-program'.
|
|
|
384 This function is for internal use only."
|
|
|
385 (unless (eq (car-safe context) 'epg-context)
|
|
|
386 (signal 'wrong-type-argument (list 'epg-context-p context)))
|
|
|
387 (aset (cdr context) 12 output-file))
|
|
|
388
|
|
|
389 (defun epg-context-set-result (context result)
|
|
|
390 "Set the result of the previous cryptographic operation."
|
|
|
391 (unless (eq (car-safe context) 'epg-context)
|
|
|
392 (signal 'wrong-type-argument (list 'epg-context-p context)))
|
|
|
393 (aset (cdr context) 13 result))
|
|
|
394
|
|
|
395 (defun epg-context-set-operation (context operation)
|
|
|
396 "Set the name of the current cryptographic operation."
|
|
|
397 (unless (eq (car-safe context) 'epg-context)
|
|
|
398 (signal 'wrong-type-argument (list 'epg-context-p context)))
|
|
|
399 (aset (cdr context) 14 operation))
|
|
|
400
|
|
|
401 (defun epg-make-signature (status &optional key-id)
|
|
|
402 "Return a signature object."
|
|
|
403 (cons 'epg-signature (vector status key-id nil nil nil nil nil nil nil nil
|
|
|
404 nil)))
|
|
|
405
|
|
|
406 (defun epg-signature-status (signature)
|
|
|
407 "Return the status code of SIGNATURE."
|
|
|
408 (unless (eq (car-safe signature) 'epg-signature)
|
|
|
409 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
|
|
|
410 (aref (cdr signature) 0))
|
|
|
411
|
|
|
412 (defun epg-signature-key-id (signature)
|
|
|
413 "Return the key-id of SIGNATURE."
|
|
|
414 (unless (eq (car-safe signature) 'epg-signature)
|
|
|
415 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
|
|
|
416 (aref (cdr signature) 1))
|
|
|
417
|
|
|
418 (defun epg-signature-validity (signature)
|
|
|
419 "Return the validity of SIGNATURE."
|
|
|
420 (unless (eq (car-safe signature) 'epg-signature)
|
|
|
421 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
|
|
|
422 (aref (cdr signature) 2))
|
|
|
423
|
|
|
424 (defun epg-signature-fingerprint (signature)
|
|
|
425 "Return the fingerprint of SIGNATURE."
|
|
|
426 (unless (eq (car-safe signature) 'epg-signature)
|
|
|
427 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
|
|
|
428 (aref (cdr signature) 3))
|
|
|
429
|
|
|
430 (defun epg-signature-creation-time (signature)
|
|
|
431 "Return the creation time of SIGNATURE."
|
|
|
432 (unless (eq (car-safe signature) 'epg-signature)
|
|
|
433 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
|
|
|
434 (aref (cdr signature) 4))
|
|
|
435
|
|
|
436 (defun epg-signature-expiration-time (signature)
|
|
|
437 "Return the expiration time of SIGNATURE."
|
|
|
438 (unless (eq (car-safe signature) 'epg-signature)
|
|
|
439 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
|
|
|
440 (aref (cdr signature) 5))
|
|
|
441
|
|
|
442 (defun epg-signature-pubkey-algorithm (signature)
|
|
|
443 "Return the public key algorithm of SIGNATURE."
|
|
|
444 (unless (eq (car-safe signature) 'epg-signature)
|
|
|
445 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
|
|
|
446 (aref (cdr signature) 6))
|
|
|
447
|
|
|
448 (defun epg-signature-digest-algorithm (signature)
|
|
|
449 "Return the digest algorithm of SIGNATURE."
|
|
|
450 (unless (eq (car-safe signature) 'epg-signature)
|
|
|
451 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
|
|
|
452 (aref (cdr signature) 7))
|
|
|
453
|
|
|
454 (defun epg-signature-class (signature)
|
|
|
455 "Return the class of SIGNATURE."
|
|
|
456 (unless (eq (car-safe signature) 'epg-signature)
|
|
|
457 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
|
|
|
458 (aref (cdr signature) 8))
|
|
|
459
|
|
|
460 (defun epg-signature-version (signature)
|
|
|
461 "Return the version of SIGNATURE."
|
|
|
462 (unless (eq (car-safe signature) 'epg-signature)
|
|
|
463 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
|
|
|
464 (aref (cdr signature) 9))
|
|
|
465
|
|
|
466 (defun epg-sig-notations (signature)
|
|
|
467 "Return the list of notations of SIGNATURE."
|
|
|
468 (unless (eq (car-safe signature) 'epg-signature)
|
|
|
469 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
|
|
|
470 (aref (cdr signature) 10))
|
|
|
471
|
|
|
472 (defun epg-signature-set-status (signature status)
|
|
|
473 "Set the status code of SIGNATURE."
|
|
|
474 (unless (eq (car-safe signature) 'epg-signature)
|
|
|
475 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
|
|
|
476 (aset (cdr signature) 0 status))
|
|
|
477
|
|
|
478 (defun epg-signature-set-key-id (signature key-id)
|
|
|
479 "Set the key-id of SIGNATURE."
|
|
|
480 (unless (eq (car-safe signature) 'epg-signature)
|
|
|
481 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
|
|
|
482 (aset (cdr signature) 1 key-id))
|
|
|
483
|
|
|
484 (defun epg-signature-set-validity (signature validity)
|
|
|
485 "Set the validity of SIGNATURE."
|
|
|
486 (unless (eq (car-safe signature) 'epg-signature)
|
|
|
487 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
|
|
|
488 (aset (cdr signature) 2 validity))
|
|
|
489
|
|
|
490 (defun epg-signature-set-fingerprint (signature fingerprint)
|
|
|
491 "Set the fingerprint of SIGNATURE."
|
|
|
492 (unless (eq (car-safe signature) 'epg-signature)
|
|
|
493 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
|
|
|
494 (aset (cdr signature) 3 fingerprint))
|
|
|
495
|
|
|
496 (defun epg-signature-set-creation-time (signature creation-time)
|
|
|
497 "Set the creation time of SIGNATURE."
|
|
|
498 (unless (eq (car-safe signature) 'epg-signature)
|
|
|
499 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
|
|
|
500 (aset (cdr signature) 4 creation-time))
|
|
|
501
|
|
|
502 (defun epg-signature-set-expiration-time (signature expiration-time)
|
|
|
503 "Set the expiration time of SIGNATURE."
|
|
|
504 (unless (eq (car-safe signature) 'epg-signature)
|
|
|
505 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
|
|
|
506 (aset (cdr signature) 5 expiration-time))
|
|
|
507
|
|
|
508 (defun epg-signature-set-pubkey-algorithm (signature pubkey-algorithm)
|
|
|
509 "Set the public key algorithm of SIGNATURE."
|
|
|
510 (unless (eq (car-safe signature) 'epg-signature)
|
|
|
511 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
|
|
|
512 (aset (cdr signature) 6 pubkey-algorithm))
|
|
|
513
|
|
|
514 (defun epg-signature-set-digest-algorithm (signature digest-algorithm)
|
|
|
515 "Set the digest algorithm of SIGNATURE."
|
|
|
516 (unless (eq (car-safe signature) 'epg-signature)
|
|
|
517 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
|
|
|
518 (aset (cdr signature) 7 digest-algorithm))
|
|
|
519
|
|
|
520 (defun epg-signature-set-class (signature class)
|
|
|
521 "Set the class of SIGNATURE."
|
|
|
522 (unless (eq (car-safe signature) 'epg-signature)
|
|
|
523 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
|
|
|
524 (aset (cdr signature) 8 class))
|
|
|
525
|
|
|
526 (defun epg-signature-set-version (signature version)
|
|
|
527 "Set the version of SIGNATURE."
|
|
|
528 (unless (eq (car-safe signature) 'epg-signature)
|
|
|
529 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
|
|
|
530 (aset (cdr signature) 9 version))
|
|
|
531
|
|
|
532 (defun epg-signature-set-notations (signature notations)
|
|
|
533 "Set the list of notations of SIGNATURE."
|
|
|
534 (unless (eq (car-safe signature) 'epg-signature)
|
|
|
535 (signal 'wrong-type-argument (list 'epg-signature-p signature)))
|
|
|
536 (aset (cdr signature) 10 notations))
|
|
|
537
|
|
|
538 (defun epg-make-new-signature (type pubkey-algorithm digest-algorithm
|
|
|
539 class creation-time fingerprint)
|
|
|
540 "Return a new signature object."
|
|
|
541 (cons 'epg-new-signature (vector type pubkey-algorithm digest-algorithm
|
|
|
542 class creation-time fingerprint)))
|
|
|
543
|
|
|
544 (defun epg-new-signature-type (new-signature)
|
|
|
545 "Return the type of NEW-SIGNATURE."
|
|
|
546 (unless (eq (car-safe new-signature) 'epg-new-signature)
|
|
|
547 (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature)))
|
|
|
548 (aref (cdr new-signature) 0))
|
|
|
549
|
|
|
550 (defun epg-new-signature-pubkey-algorithm (new-signature)
|
|
|
551 "Return the public key algorithm of NEW-SIGNATURE."
|
|
|
552 (unless (eq (car-safe new-signature) 'epg-new-signature)
|
|
|
553 (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature)))
|
|
|
554 (aref (cdr new-signature) 1))
|
|
|
555
|
|
|
556 (defun epg-new-signature-digest-algorithm (new-signature)
|
|
|
557 "Return the digest algorithm of NEW-SIGNATURE."
|
|
|
558 (unless (eq (car-safe new-signature) 'epg-new-signature)
|
|
|
559 (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature)))
|
|
|
560 (aref (cdr new-signature) 2))
|
|
|
561
|
|
|
562 (defun epg-new-signature-class (new-signature)
|
|
|
563 "Return the class of NEW-SIGNATURE."
|
|
|
564 (unless (eq (car-safe new-signature) 'epg-new-signature)
|
|
|
565 (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature)))
|
|
|
566 (aref (cdr new-signature) 3))
|
|
|
567
|
|
|
568 (defun epg-new-signature-creation-time (new-signature)
|
|
|
569 "Return the creation time of NEW-SIGNATURE."
|
|
|
570 (unless (eq (car-safe new-signature) 'epg-new-signature)
|
|
|
571 (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature)))
|
|
|
572 (aref (cdr new-signature) 4))
|
|
|
573
|
|
|
574 (defun epg-new-signature-fingerprint (new-signature)
|
|
|
575 "Return the fingerprint of NEW-SIGNATURE."
|
|
|
576 (unless (eq (car-safe new-signature) 'epg-new-signature)
|
|
|
577 (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature)))
|
|
|
578 (aref (cdr new-signature) 5))
|
|
|
579
|
|
|
580 (defun epg-make-key (owner-trust)
|
|
|
581 "Return a key object."
|
|
|
582 (cons 'epg-key (vector owner-trust nil nil)))
|
|
|
583
|
|
|
584 (defun epg-key-owner-trust (key)
|
|
|
585 "Return the owner trust of KEY."
|
|
|
586 (unless (eq (car-safe key) 'epg-key)
|
|
|
587 (signal 'wrong-type-argument (list 'epg-key-p key)))
|
|
|
588 (aref (cdr key) 0))
|
|
|
589
|
|
|
590 (defun epg-key-sub-key-list (key)
|
|
|
591 "Return the sub key list of KEY."
|
|
|
592 (unless (eq (car-safe key) 'epg-key)
|
|
|
593 (signal 'wrong-type-argument (list 'epg-key-p key)))
|
|
|
594 (aref (cdr key) 1))
|
|
|
595
|
|
|
596 (defun epg-key-user-id-list (key)
|
|
|
597 "Return the user ID list of KEY."
|
|
|
598 (unless (eq (car-safe key) 'epg-key)
|
|
|
599 (signal 'wrong-type-argument (list 'epg-key-p key)))
|
|
|
600 (aref (cdr key) 2))
|
|
|
601
|
|
|
602 (defun epg-key-set-sub-key-list (key sub-key-list)
|
|
|
603 "Set the sub key list of KEY."
|
|
|
604 (unless (eq (car-safe key) 'epg-key)
|
|
|
605 (signal 'wrong-type-argument (list 'epg-key-p key)))
|
|
|
606 (aset (cdr key) 1 sub-key-list))
|
|
|
607
|
|
|
608 (defun epg-key-set-user-id-list (key user-id-list)
|
|
|
609 "Set the user ID list of KEY."
|
|
|
610 (unless (eq (car-safe key) 'epg-key)
|
|
|
611 (signal 'wrong-type-argument (list 'epg-key-p key)))
|
|
|
612 (aset (cdr key) 2 user-id-list))
|
|
|
613
|
|
|
614 (defun epg-make-sub-key (validity capability secret-p algorithm length id
|
|
|
615 creation-time expiration-time)
|
|
|
616 "Return a sub key object."
|
|
|
617 (cons 'epg-sub-key
|
|
|
618 (vector validity capability secret-p algorithm length id creation-time
|
|
|
619 expiration-time nil)))
|
|
|
620
|
|
|
621 (defun epg-sub-key-validity (sub-key)
|
|
|
622 "Return the validity of SUB-KEY."
|
|
|
623 (unless (eq (car-safe sub-key) 'epg-sub-key)
|
|
|
624 (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
|
|
|
625 (aref (cdr sub-key) 0))
|
|
|
626
|
|
|
627 (defun epg-sub-key-capability (sub-key)
|
|
|
628 "Return the capability of SUB-KEY."
|
|
|
629 (unless (eq (car-safe sub-key) 'epg-sub-key)
|
|
|
630 (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
|
|
|
631 (aref (cdr sub-key) 1))
|
|
|
632
|
|
|
633 (defun epg-sub-key-secret-p (sub-key)
|
|
|
634 "Return non-nil if SUB-KEY is a secret key."
|
|
|
635 (unless (eq (car-safe sub-key) 'epg-sub-key)
|
|
|
636 (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
|
|
|
637 (aref (cdr sub-key) 2))
|
|
|
638
|
|
|
639 (defun epg-sub-key-algorithm (sub-key)
|
|
|
640 "Return the algorithm of SUB-KEY."
|
|
|
641 (unless (eq (car-safe sub-key) 'epg-sub-key)
|
|
|
642 (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
|
|
|
643 (aref (cdr sub-key) 3))
|
|
|
644
|
|
|
645 (defun epg-sub-key-length (sub-key)
|
|
|
646 "Return the length of SUB-KEY."
|
|
|
647 (unless (eq (car-safe sub-key) 'epg-sub-key)
|
|
|
648 (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
|
|
|
649 (aref (cdr sub-key) 4))
|
|
|
650
|
|
|
651 (defun epg-sub-key-id (sub-key)
|
|
|
652 "Return the ID of SUB-KEY."
|
|
|
653 (unless (eq (car-safe sub-key) 'epg-sub-key)
|
|
|
654 (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
|
|
|
655 (aref (cdr sub-key) 5))
|
|
|
656
|
|
|
657 (defun epg-sub-key-creation-time (sub-key)
|
|
|
658 "Return the creation time of SUB-KEY."
|
|
|
659 (unless (eq (car-safe sub-key) 'epg-sub-key)
|
|
|
660 (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
|
|
|
661 (aref (cdr sub-key) 6))
|
|
|
662
|
|
|
663 (defun epg-sub-key-expiration-time (sub-key)
|
|
|
664 "Return the expiration time of SUB-KEY."
|
|
|
665 (unless (eq (car-safe sub-key) 'epg-sub-key)
|
|
|
666 (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
|
|
|
667 (aref (cdr sub-key) 7))
|
|
|
668
|
|
|
669 (defun epg-sub-key-fingerprint (sub-key)
|
|
|
670 "Return the fingerprint of SUB-KEY."
|
|
|
671 (unless (eq (car-safe sub-key) 'epg-sub-key)
|
|
|
672 (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
|
|
|
673 (aref (cdr sub-key) 8))
|
|
|
674
|
|
|
675 (defun epg-sub-key-set-fingerprint (sub-key fingerprint)
|
|
|
676 "Set the fingerprint of SUB-KEY.
|
|
|
677 This function is for internal use only."
|
|
|
678 (unless (eq (car-safe sub-key) 'epg-sub-key)
|
|
|
679 (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
|
|
|
680 (aset (cdr sub-key) 8 fingerprint))
|
|
|
681
|
|
|
682 (defun epg-make-user-id (validity string)
|
|
|
683 "Return a user ID object."
|
|
|
684 (cons 'epg-user-id (vector validity string nil)))
|
|
|
685
|
|
|
686 (defun epg-user-id-validity (user-id)
|
|
|
687 "Return the validity of USER-ID."
|
|
|
688 (unless (eq (car-safe user-id) 'epg-user-id)
|
|
|
689 (signal 'wrong-type-argument (list 'epg-user-id-p user-id)))
|
|
|
690 (aref (cdr user-id) 0))
|
|
|
691
|
|
|
692 (defun epg-user-id-string (user-id)
|
|
|
693 "Return the name of USER-ID."
|
|
|
694 (unless (eq (car-safe user-id) 'epg-user-id)
|
|
|
695 (signal 'wrong-type-argument (list 'epg-user-id-p user-id)))
|
|
|
696 (aref (cdr user-id) 1))
|
|
|
697
|
|
|
698 (defun epg-user-id-signature-list (user-id)
|
|
|
699 "Return the signature list of USER-ID."
|
|
|
700 (unless (eq (car-safe user-id) 'epg-user-id)
|
|
|
701 (signal 'wrong-type-argument (list 'epg-user-id-p user-id)))
|
|
|
702 (aref (cdr user-id) 2))
|
|
|
703
|
|
|
704 (defun epg-user-id-set-signature-list (user-id signature-list)
|
|
|
705 "Set the signature list of USER-ID."
|
|
|
706 (unless (eq (car-safe user-id) 'epg-user-id)
|
|
|
707 (signal 'wrong-type-argument (list 'epg-user-id-p user-id)))
|
|
|
708 (aset (cdr user-id) 2 signature-list))
|
|
|
709
|
|
|
710 (defun epg-make-key-signature (validity pubkey-algorithm key-id creation-time
|
|
|
711 expiration-time user-id class
|
|
|
712 exportable-p)
|
|
|
713 "Return a key signature object."
|
|
|
714 (cons 'epg-key-signature
|
|
|
715 (vector validity pubkey-algorithm key-id creation-time expiration-time
|
|
|
716 user-id class exportable-p)))
|
|
|
717
|
|
|
718 (defun epg-key-signature-validity (key-signature)
|
|
|
719 "Return the validity of KEY-SIGNATURE."
|
|
|
720 (unless (eq (car-safe key-signature) 'epg-key-signature)
|
|
|
721 (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
|
|
|
722 (aref (cdr key-signature) 0))
|
|
|
723
|
|
|
724 (defun epg-key-signature-pubkey-algorithm (key-signature)
|
|
|
725 "Return the public key algorithm of KEY-SIGNATURE."
|
|
|
726 (unless (eq (car-safe key-signature) 'epg-key-signature)
|
|
|
727 (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
|
|
|
728 (aref (cdr key-signature) 1))
|
|
|
729
|
|
|
730 (defun epg-key-signature-key-id (key-signature)
|
|
|
731 "Return the key-id of KEY-SIGNATURE."
|
|
|
732 (unless (eq (car-safe key-signature) 'epg-key-signature)
|
|
|
733 (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
|
|
|
734 (aref (cdr key-signature) 2))
|
|
|
735
|
|
|
736 (defun epg-key-signature-creation-time (key-signature)
|
|
|
737 "Return the creation time of KEY-SIGNATURE."
|
|
|
738 (unless (eq (car-safe key-signature) 'epg-key-signature)
|
|
|
739 (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
|
|
|
740 (aref (cdr key-signature) 3))
|
|
|
741
|
|
|
742 (defun epg-key-signature-expiration-time (key-signature)
|
|
|
743 "Return the expiration time of KEY-SIGNATURE."
|
|
|
744 (unless (eq (car-safe key-signature) 'epg-key-signature)
|
|
|
745 (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
|
|
|
746 (aref (cdr key-signature) 4))
|
|
|
747
|
|
|
748 (defun epg-key-signature-user-id (key-signature)
|
|
|
749 "Return the user-id of KEY-SIGNATURE."
|
|
|
750 (unless (eq (car-safe key-signature) 'epg-key-signature)
|
|
|
751 (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
|
|
|
752 (aref (cdr key-signature) 5))
|
|
|
753
|
|
|
754 (defun epg-key-signature-class (key-signature)
|
|
|
755 "Return the class of KEY-SIGNATURE."
|
|
|
756 (unless (eq (car-safe key-signature) 'epg-key-signature)
|
|
|
757 (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
|
|
|
758 (aref (cdr key-signature) 6))
|
|
|
759
|
|
|
760 (defun epg-key-signature-exportable-p (key-signature)
|
|
|
761 "Return t if KEY-SIGNATURE is exportable."
|
|
|
762 (unless (eq (car-safe key-signature) 'epg-key-signature)
|
|
|
763 (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
|
|
|
764 (aref (cdr key-signature) 7))
|
|
|
765
|
|
|
766 (defun epg-make-sig-notation (name value &optional human-readable
|
|
|
767 critical)
|
|
|
768 "Return a notation object."
|
|
|
769 (cons 'epg-sig-notation (vector name value human-readable critical)))
|
|
|
770
|
|
|
771 (defun epg-sig-notation-name (sig-notation)
|
|
|
772 "Return the name of SIG-NOTATION."
|
|
|
773 (unless (eq (car-safe sig-notation) 'epg-sig-notation)
|
|
|
774 (signal 'wrong-type-argument (list 'epg-sig-notation-p
|
|
|
775 sig-notation)))
|
|
|
776 (aref (cdr sig-notation) 0))
|
|
|
777
|
|
|
778 (defun epg-sig-notation-value (sig-notation)
|
|
|
779 "Return the value of SIG-NOTATION."
|
|
|
780 (unless (eq (car-safe sig-notation) 'epg-sig-notation)
|
|
|
781 (signal 'wrong-type-argument (list 'epg-sig-notation-p
|
|
|
782 sig-notation)))
|
|
|
783 (aref (cdr sig-notation) 1))
|
|
|
784
|
|
|
785 (defun epg-sig-notation-human-readable (sig-notation)
|
|
|
786 "Return the human-readable of SIG-NOTATION."
|
|
|
787 (unless (eq (car-safe sig-notation) 'epg-sig-notation)
|
|
|
788 (signal 'wrong-type-argument (list 'epg-sig-notation-p
|
|
|
789 sig-notation)))
|
|
|
790 (aref (cdr sig-notation) 2))
|
|
|
791
|
|
|
792 (defun epg-sig-notation-critical (sig-notation)
|
|
|
793 "Return the critical of SIG-NOTATION."
|
|
|
794 (unless (eq (car-safe sig-notation) 'epg-sig-notation)
|
|
|
795 (signal 'wrong-type-argument (list 'epg-sig-notation-p
|
|
|
796 sig-notation)))
|
|
|
797 (aref (cdr sig-notation) 3))
|
|
|
798
|
|
|
799 (defun epg-sig-notation-set-value (sig-notation value)
|
|
|
800 "Set the value of SIG-NOTATION."
|
|
|
801 (unless (eq (car-safe sig-notation) 'epg-sig-notation)
|
|
|
802 (signal 'wrong-type-argument (list 'epg-sig-notation-p
|
|
|
803 sig-notation)))
|
|
|
804 (aset (cdr sig-notation) 1 value))
|
|
|
805
|
|
|
806 (defun epg-make-import-status (fingerprint &optional reason new user-id
|
|
|
807 signature sub-key secret)
|
|
92510
|
808 "Return an import status object."
|
|
91647
|
809 (cons 'epg-import-status (vector fingerprint reason new user-id signature
|
|
|
810 sub-key secret)))
|
|
|
811
|
|
|
812 (defun epg-import-status-fingerprint (import-status)
|
|
|
813 "Return the fingerprint of the key that was considered."
|
|
|
814 (unless (eq (car-safe import-status) 'epg-import-status)
|
|
|
815 (signal 'wrong-type-argument (list 'epg-import-status-p import-status)))
|
|
|
816 (aref (cdr import-status) 0))
|
|
|
817
|
|
|
818 (defun epg-import-status-reason (import-status)
|
|
|
819 "Return the reason code for import failure."
|
|
|
820 (unless (eq (car-safe import-status) 'epg-import-status)
|
|
|
821 (signal 'wrong-type-argument (list 'epg-import-status-p import-status)))
|
|
|
822 (aref (cdr import-status) 1))
|
|
|
823
|
|
|
824 (defun epg-import-status-new (import-status)
|
|
|
825 "Return t if the imported key was new."
|
|
|
826 (unless (eq (car-safe import-status) 'epg-import-status)
|
|
|
827 (signal 'wrong-type-argument (list 'epg-import-status-p import-status)))
|
|
|
828 (aref (cdr import-status) 2))
|
|
|
829
|
|
|
830 (defun epg-import-status-user-id (import-status)
|
|
|
831 "Return t if the imported key contained new user IDs."
|
|
|
832 (unless (eq (car-safe import-status) 'epg-import-status)
|
|
|
833 (signal 'wrong-type-argument (list 'epg-import-status-p import-status)))
|
|
|
834 (aref (cdr import-status) 3))
|
|
|
835
|
|
|
836 (defun epg-import-status-signature (import-status)
|
|
|
837 "Return t if the imported key contained new signatures."
|
|
|
838 (unless (eq (car-safe import-status) 'epg-import-status)
|
|
|
839 (signal 'wrong-type-argument (list 'epg-import-status-p import-status)))
|
|
|
840 (aref (cdr import-status) 4))
|
|
|
841
|
|
|
842 (defun epg-import-status-sub-key (import-status)
|
|
|
843 "Return t if the imported key contained new sub keys."
|
|
|
844 (unless (eq (car-safe import-status) 'epg-import-status)
|
|
|
845 (signal 'wrong-type-argument (list 'epg-import-status-p import-status)))
|
|
|
846 (aref (cdr import-status) 5))
|
|
|
847
|
|
|
848 (defun epg-import-status-secret (import-status)
|
|
|
849 "Return t if the imported key contained a secret key."
|
|
|
850 (unless (eq (car-safe import-status) 'epg-import-status)
|
|
|
851 (signal 'wrong-type-argument (list 'epg-import-status-p import-status)))
|
|
|
852 (aref (cdr import-status) 6))
|
|
|
853
|
|
|
854 (defun epg-make-import-result (considered no-user-id imported imported-rsa
|
|
|
855 unchanged new-user-ids new-sub-keys
|
|
|
856 new-signatures new-revocations
|
|
|
857 secret-read secret-imported
|
|
|
858 secret-unchanged not-imported
|
|
|
859 imports)
|
|
92510
|
860 "Return an import result object."
|
|
91647
|
861 (cons 'epg-import-result (vector considered no-user-id imported imported-rsa
|
|
|
862 unchanged new-user-ids new-sub-keys
|
|
|
863 new-signatures new-revocations secret-read
|
|
|
864 secret-imported secret-unchanged
|
|
|
865 not-imported imports)))
|
|
|
866
|
|
|
867 (defun epg-import-result-considered (import-result)
|
|
|
868 "Return the total number of considered keys."
|
|
|
869 (unless (eq (car-safe import-result) 'epg-import-result)
|
|
|
870 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
|
|
|
871 (aref (cdr import-result) 0))
|
|
|
872
|
|
|
873 (defun epg-import-result-no-user-id (import-result)
|
|
|
874 "Return the number of keys without user ID."
|
|
|
875 (unless (eq (car-safe import-result) 'epg-import-result)
|
|
|
876 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
|
|
|
877 (aref (cdr import-result) 1))
|
|
|
878
|
|
|
879 (defun epg-import-result-imported (import-result)
|
|
|
880 "Return the number of imported keys."
|
|
|
881 (unless (eq (car-safe import-result) 'epg-import-result)
|
|
|
882 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
|
|
|
883 (aref (cdr import-result) 2))
|
|
|
884
|
|
|
885 (defun epg-import-result-imported-rsa (import-result)
|
|
|
886 "Return the number of imported RSA keys."
|
|
|
887 (unless (eq (car-safe import-result) 'epg-import-result)
|
|
|
888 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
|
|
|
889 (aref (cdr import-result) 3))
|
|
|
890
|
|
|
891 (defun epg-import-result-unchanged (import-result)
|
|
|
892 "Return the number of unchanged keys."
|
|
|
893 (unless (eq (car-safe import-result) 'epg-import-result)
|
|
|
894 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
|
|
|
895 (aref (cdr import-result) 4))
|
|
|
896
|
|
|
897 (defun epg-import-result-new-user-ids (import-result)
|
|
|
898 "Return the number of new user IDs."
|
|
|
899 (unless (eq (car-safe import-result) 'epg-import-result)
|
|
|
900 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
|
|
|
901 (aref (cdr import-result) 5))
|
|
|
902
|
|
|
903 (defun epg-import-result-new-sub-keys (import-result)
|
|
|
904 "Return the number of new sub keys."
|
|
|
905 (unless (eq (car-safe import-result) 'epg-import-result)
|
|
|
906 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
|
|
|
907 (aref (cdr import-result) 6))
|
|
|
908
|
|
|
909 (defun epg-import-result-new-signatures (import-result)
|
|
|
910 "Return the number of new signatures."
|
|
|
911 (unless (eq (car-safe import-result) 'epg-import-result)
|
|
|
912 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
|
|
|
913 (aref (cdr import-result) 7))
|
|
|
914
|
|
|
915 (defun epg-import-result-new-revocations (import-result)
|
|
|
916 "Return the number of new revocations."
|
|
|
917 (unless (eq (car-safe import-result) 'epg-import-result)
|
|
|
918 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
|
|
|
919 (aref (cdr import-result) 8))
|
|
|
920
|
|
|
921 (defun epg-import-result-secret-read (import-result)
|
|
|
922 "Return the total number of secret keys read."
|
|
|
923 (unless (eq (car-safe import-result) 'epg-import-result)
|
|
|
924 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
|
|
|
925 (aref (cdr import-result) 9))
|
|
|
926
|
|
|
927 (defun epg-import-result-secret-imported (import-result)
|
|
|
928 "Return the number of imported secret keys."
|
|
|
929 (unless (eq (car-safe import-result) 'epg-import-result)
|
|
|
930 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
|
|
|
931 (aref (cdr import-result) 10))
|
|
|
932
|
|
|
933 (defun epg-import-result-secret-unchanged (import-result)
|
|
|
934 "Return the number of unchanged secret keys."
|
|
|
935 (unless (eq (car-safe import-result) 'epg-import-result)
|
|
|
936 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
|
|
|
937 (aref (cdr import-result) 11))
|
|
|
938
|
|
|
939 (defun epg-import-result-not-imported (import-result)
|
|
|
940 "Return the number of keys not imported."
|
|
|
941 (unless (eq (car-safe import-result) 'epg-import-result)
|
|
|
942 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
|
|
|
943 (aref (cdr import-result) 12))
|
|
|
944
|
|
|
945 (defun epg-import-result-imports (import-result)
|
|
|
946 "Return the list of `epg-import-status' objects."
|
|
|
947 (unless (eq (car-safe import-result) 'epg-import-result)
|
|
|
948 (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
|
|
|
949 (aref (cdr import-result) 13))
|
|
|
950
|
|
|
951 (defun epg-context-result-for (context name)
|
|
|
952 "Return the result of CONTEXT associated with NAME."
|
|
|
953 (cdr (assq name (epg-context-result context))))
|
|
|
954
|
|
|
955 (defun epg-context-set-result-for (context name value)
|
|
|
956 "Set the result of CONTEXT associated with NAME to VALUE."
|
|
|
957 (let* ((result (epg-context-result context))
|
|
|
958 (entry (assq name result)))
|
|
|
959 (if entry
|
|
|
960 (setcdr entry value)
|
|
|
961 (epg-context-set-result context (cons (cons name value) result)))))
|
|
|
962
|
|
|
963 (defun epg-signature-to-string (signature)
|
|
|
964 "Convert SIGNATURE to a human readable string."
|
|
|
965 (let* ((user-id (cdr (assoc (epg-signature-key-id signature)
|
|
|
966 epg-user-id-alist)))
|
|
|
967 (pubkey-algorithm (epg-signature-pubkey-algorithm signature)))
|
|
|
968 (concat
|
|
|
969 (cond ((eq (epg-signature-status signature) 'good)
|
|
|
970 "Good signature from ")
|
|
|
971 ((eq (epg-signature-status signature) 'bad)
|
|
|
972 "Bad signature from ")
|
|
|
973 ((eq (epg-signature-status signature) 'expired)
|
|
|
974 "Expired signature from ")
|
|
|
975 ((eq (epg-signature-status signature) 'expired-key)
|
|
|
976 "Signature made by expired key ")
|
|
|
977 ((eq (epg-signature-status signature) 'revoked-key)
|
|
|
978 "Signature made by revoked key ")
|
|
|
979 ((eq (epg-signature-status signature) 'no-pubkey)
|
|
|
980 "No public key for "))
|
|
|
981 (epg-signature-key-id signature)
|
|
|
982 (if user-id
|
|
|
983 (concat " "
|
|
|
984 (if (stringp user-id)
|
|
|
985 user-id
|
|
|
986 (epg-decode-dn user-id)))
|
|
|
987 "")
|
|
|
988 (if (epg-signature-validity signature)
|
|
|
989 (format " (trust %s)" (epg-signature-validity signature))
|
|
|
990 "")
|
|
|
991 (if (epg-signature-creation-time signature)
|
|
|
992 (format-time-string " created at %Y-%m-%dT%T%z"
|
|
|
993 (epg-signature-creation-time signature))
|
|
|
994 "")
|
|
|
995 (if pubkey-algorithm
|
|
|
996 (concat " using "
|
|
|
997 (or (cdr (assq pubkey-algorithm epg-pubkey-algorithm-alist))
|
|
|
998 (format "(unknown algorithm %d)" pubkey-algorithm)))
|
|
|
999 ""))))
|
|
|
1000
|
|
|
1001 (defun epg-verify-result-to-string (verify-result)
|
|
|
1002 "Convert VERIFY-RESULT to a human readable string."
|
|
|
1003 (mapconcat #'epg-signature-to-string verify-result "\n"))
|
|
|
1004
|
|
|
1005 (defun epg-new-signature-to-string (new-signature)
|
|
|
1006 "Convert NEW-SIGNATURE to a human readable string."
|
|
|
1007 (concat
|
|
|
1008 (cond ((eq (epg-new-signature-type new-signature) 'detached)
|
|
|
1009 "Detached signature ")
|
|
|
1010 ((eq (epg-new-signature-type new-signature) 'clear)
|
|
|
1011 "Cleartext signature ")
|
|
|
1012 (t
|
|
|
1013 "Signature "))
|
|
|
1014 (cdr (assq (epg-new-signature-pubkey-algorithm new-signature)
|
|
|
1015 epg-pubkey-algorithm-alist))
|
|
|
1016 "/"
|
|
|
1017 (cdr (assq (epg-new-signature-digest-algorithm new-signature)
|
|
|
1018 epg-digest-algorithm-alist))
|
|
|
1019 " "
|
|
|
1020 (format "%02X " (epg-new-signature-class new-signature))
|
|
|
1021 (epg-new-signature-fingerprint new-signature)))
|
|
|
1022
|
|
|
1023 (defun epg-import-result-to-string (import-result)
|
|
|
1024 "Convert IMPORT-RESULT to a human readable string."
|
|
|
1025 (concat (format "Total number processed: %d\n"
|
|
|
1026 (epg-import-result-considered import-result))
|
|
|
1027 (if (> (epg-import-result-not-imported import-result) 0)
|
|
|
1028 (format " skipped new keys: %d\n"
|
|
|
1029 (epg-import-result-not-imported import-result)))
|
|
|
1030 (if (> (epg-import-result-no-user-id import-result) 0)
|
|
|
1031 (format " w/o user IDs: %d\n"
|
|
|
1032 (epg-import-result-no-user-id import-result)))
|
|
|
1033 (if (> (epg-import-result-imported import-result) 0)
|
|
|
1034 (concat (format " imported: %d"
|
|
|
1035 (epg-import-result-imported import-result))
|
|
|
1036 (if (> (epg-import-result-imported-rsa import-result) 0)
|
|
|
1037 (format " (RSA: %d)"
|
|
|
1038 (epg-import-result-imported-rsa
|
|
|
1039 import-result)))
|
|
|
1040 "\n"))
|
|
|
1041 (if (> (epg-import-result-unchanged import-result) 0)
|
|
|
1042 (format " unchanged: %d\n"
|
|
|
1043 (epg-import-result-unchanged import-result)))
|
|
|
1044 (if (> (epg-import-result-new-user-ids import-result) 0)
|
|
|
1045 (format " new user IDs: %d\n"
|
|
|
1046 (epg-import-result-new-user-ids import-result)))
|
|
|
1047 (if (> (epg-import-result-new-sub-keys import-result) 0)
|
|
|
1048 (format " new subkeys: %d\n"
|
|
|
1049 (epg-import-result-new-sub-keys import-result)))
|
|
|
1050 (if (> (epg-import-result-new-signatures import-result) 0)
|
|
|
1051 (format " new signatures: %d\n"
|
|
|
1052 (epg-import-result-new-signatures import-result)))
|
|
|
1053 (if (> (epg-import-result-new-revocations import-result) 0)
|
|
|
1054 (format " new key revocations: %d\n"
|
|
|
1055 (epg-import-result-new-revocations import-result)))
|
|
|
1056 (if (> (epg-import-result-secret-read import-result) 0)
|
|
|
1057 (format " secret keys read: %d\n"
|
|
|
1058 (epg-import-result-secret-read import-result)))
|
|
|
1059 (if (> (epg-import-result-secret-imported import-result) 0)
|
|
|
1060 (format " secret keys imported: %d\n"
|
|
|
1061 (epg-import-result-secret-imported import-result)))
|
|
|
1062 (if (> (epg-import-result-secret-unchanged import-result) 0)
|
|
|
1063 (format " secret keys unchanged: %d\n"
|
|
|
1064 (epg-import-result-secret-unchanged import-result)))))
|
|
|
1065
|
|
|
1066 (defun epg--start (context args)
|
|
|
1067 "Start `epg-gpg-program' in a subprocess with given ARGS."
|
|
|
1068 (if (and (epg-context-process context)
|
|
|
1069 (eq (process-status (epg-context-process context)) 'run))
|
|
|
1070 (error "%s is already running in this context"
|
|
|
1071 (if (eq (epg-context-protocol context) 'CMS)
|
|
|
1072 epg-gpgsm-program
|
|
|
1073 epg-gpg-program)))
|
|
|
1074 (let* ((args (append (list "--no-tty"
|
|
|
1075 "--status-fd" "1"
|
|
|
1076 "--yes")
|
|
|
1077 (if (and (not (eq (epg-context-protocol context) 'CMS))
|
|
|
1078 (string-match ":" (or (getenv "GPG_AGENT_INFO")
|
|
|
1079 "")))
|
|
|
1080 '("--use-agent"))
|
|
|
1081 (if (and (not (eq (epg-context-protocol context) 'CMS))
|
|
|
1082 (epg-context-progress-callback context))
|
|
|
1083 '("--enable-progress-filter"))
|
|
|
1084 (if epg-gpg-home-directory
|
|
|
1085 (list "--homedir" epg-gpg-home-directory))
|
|
|
1086 (unless (eq (epg-context-protocol context) 'CMS)
|
|
|
1087 '("--command-fd" "0"))
|
|
|
1088 (if (epg-context-armor context) '("--armor"))
|
|
|
1089 (if (epg-context-textmode context) '("--textmode"))
|
|
|
1090 (if (epg-context-output-file context)
|
|
|
1091 (list "--output" (epg-context-output-file context)))
|
|
|
1092 args))
|
|
|
1093 (coding-system-for-write 'binary)
|
|
|
1094 (coding-system-for-read 'binary)
|
|
|
1095 process-connection-type
|
|
|
1096 (orig-mode (default-file-modes))
|
|
|
1097 (buffer (generate-new-buffer " *epg*"))
|
|
|
1098 process)
|
|
|
1099 (if epg-debug
|
|
|
1100 (save-excursion
|
|
|
1101 (unless epg-debug-buffer
|
|
|
1102 (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
|
|
|
1103 (set-buffer epg-debug-buffer)
|
|
|
1104 (goto-char (point-max))
|
|
|
1105 (insert (format "%s %s\n"
|
|
|
1106 (if (eq (epg-context-protocol context) 'CMS)
|
|
|
1107 epg-gpgsm-program
|
|
|
1108 epg-gpg-program)
|
|
|
1109 (mapconcat #'identity args " ")))))
|
|
|
1110 (with-current-buffer buffer
|
|
|
1111 (if (fboundp 'set-buffer-multibyte)
|
|
|
1112 (set-buffer-multibyte nil))
|
|
|
1113 (make-local-variable 'epg-last-status)
|
|
|
1114 (setq epg-last-status nil)
|
|
|
1115 (make-local-variable 'epg-read-point)
|
|
|
1116 (setq epg-read-point (point-min))
|
|
|
1117 (make-local-variable 'epg-process-filter-running)
|
|
|
1118 (setq epg-process-filter-running nil)
|
|
|
1119 (make-local-variable 'epg-pending-status-list)
|
|
|
1120 (setq epg-pending-status-list nil)
|
|
|
1121 (make-local-variable 'epg-key-id)
|
|
|
1122 (setq epg-key-id nil)
|
|
|
1123 (make-local-variable 'epg-context)
|
|
|
1124 (setq epg-context context))
|
|
|
1125 (unwind-protect
|
|
|
1126 (progn
|
|
|
1127 (set-default-file-modes 448)
|
|
|
1128 (setq process
|
|
|
1129 (apply #'start-process "epg" buffer
|
|
|
1130 (if (eq (epg-context-protocol context) 'CMS)
|
|
|
1131 epg-gpgsm-program
|
|
|
1132 epg-gpg-program)
|
|
|
1133 args)))
|
|
|
1134 (set-default-file-modes orig-mode))
|
|
|
1135 (set-process-filter process #'epg--process-filter)
|
|
|
1136 (epg-context-set-process context process)))
|
|
|
1137
|
|
|
1138 (defun epg--process-filter (process input)
|
|
|
1139 (if epg-debug
|
|
|
1140 (save-excursion
|
|
|
1141 (unless epg-debug-buffer
|
|
|
1142 (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
|
|
|
1143 (set-buffer epg-debug-buffer)
|
|
|
1144 (goto-char (point-max))
|
|
|
1145 (insert input)))
|
|
|
1146 (if (buffer-live-p (process-buffer process))
|
|
105994
|
1147 (with-current-buffer (process-buffer process)
|
|
91647
|
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)
|
108806
511da81b16c5
Change delete-by-moving-to-trash so Lisp calls explicitly request trashing.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
1902 (delete-file tempfile))
|
|
91647
|
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)))
|
|
105994
|
1930 (with-current-buffer (process-buffer (epg-context-process context))
|
|
91647
|
1931 (epg-context-set-result-for
|
|
|
1932 epg-context 'error
|
|
|
1933 (cons '(quit)
|
|
|
1934 (epg-context-result-for epg-context 'error)))))
|
|
|
1935 (if (eq (process-status (epg-context-process context)) 'run)
|
|
|
1936 (delete-process (epg-context-process context))))
|
|
|
1937
|
|
|
1938 (defun epg-start-decrypt (context cipher)
|
|
|
1939 "Initiate a decrypt operation on CIPHER.
|
|
|
1940 CIPHER must be a file data object.
|
|
|
1941
|
|
|
1942 If you use this function, you will need to wait for the completion of
|
|
|
1943 `epg-gpg-program' by using `epg-wait-for-completion' and call
|
|
|
1944 `epg-reset' to clear a temporaly output file.
|
|
|
1945 If you are unsure, use synchronous version of this function
|
|
|
1946 `epg-decrypt-file' or `epg-decrypt-string' instead."
|
|
|
1947 (unless (epg-data-file cipher)
|
|
|
1948 (error "Not a file"))
|
|
|
1949 (epg-context-set-operation context 'decrypt)
|
|
|
1950 (epg-context-set-result context nil)
|
|
|
1951 (epg--start context (list "--decrypt" "--" (epg-data-file cipher)))
|
|
|
1952 ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
|
|
|
1953 (unless (eq (epg-context-protocol context) 'CMS)
|
|
|
1954 (epg-wait-for-status context '("BEGIN_DECRYPTION"))))
|
|
|
1955
|
|
|
1956 (defun epg--check-error-for-decrypt (context)
|
|
|
1957 (if (epg-context-result-for context 'decryption-failed)
|
|
|
1958 (signal 'epg-error (list "Decryption failed")))
|
|
|
1959 (if (epg-context-result-for context 'no-secret-key)
|
|
|
1960 (signal 'epg-error
|
|
|
1961 (list "No secret key"
|
|
|
1962 (epg-context-result-for context 'no-secret-key))))
|
|
|
1963 (unless (epg-context-result-for context 'decryption-okay)
|
|
|
1964 (let* ((error (epg-context-result-for context 'error)))
|
|
|
1965 (if (assq 'no-data error)
|
|
|
1966 (signal 'epg-error (list "No data")))
|
|
|
1967 (signal 'epg-error (list "Can't decrypt" error)))))
|
|
|
1968
|
|
|
1969 (defun epg-decrypt-file (context cipher plain)
|
|
|
1970 "Decrypt a file CIPHER and store the result to a file PLAIN.
|
|
|
1971 If PLAIN is nil, it returns the result as a string."
|
|
|
1972 (unwind-protect
|
|
|
1973 (progn
|
|
|
1974 (if plain
|
|
|
1975 (epg-context-set-output-file context plain)
|
|
|
1976 (epg-context-set-output-file context
|
|
|
1977 (epg--make-temp-file "epg-output")))
|
|
|
1978 (epg-start-decrypt context (epg-make-data-from-file cipher))
|
|
|
1979 (epg-wait-for-completion context)
|
|
|
1980 (epg--check-error-for-decrypt context)
|
|
|
1981 (unless plain
|
|
|
1982 (epg-read-output context)))
|
|
|
1983 (unless plain
|
|
|
1984 (epg-delete-output-file context))
|
|
|
1985 (epg-reset context)))
|
|
|
1986
|
|
|
1987 (defun epg-decrypt-string (context cipher)
|
|
|
1988 "Decrypt a string CIPHER and return the plain text."
|
|
|
1989 (let ((input-file (epg--make-temp-file "epg-input"))
|
|
|
1990 (coding-system-for-write 'binary))
|
|
|
1991 (unwind-protect
|
|
|
1992 (progn
|
|
|
1993 (write-region cipher nil input-file nil 'quiet)
|
|
|
1994 (epg-context-set-output-file context
|
|
|
1995 (epg--make-temp-file "epg-output"))
|
|
|
1996 (epg-start-decrypt context (epg-make-data-from-file input-file))
|
|
|
1997 (epg-wait-for-completion context)
|
|
|
1998 (epg--check-error-for-decrypt context)
|
|
|
1999 (epg-read-output context))
|
|
|
2000 (epg-delete-output-file context)
|
|
|
2001 (if (file-exists-p input-file)
|
108806
511da81b16c5
Change delete-by-moving-to-trash so Lisp calls explicitly request trashing.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2002 (delete-file input-file))
|
|
91647
|
2003 (epg-reset context))))
|
|
|
2004
|
|
|
2005 (defun epg-start-verify (context signature &optional signed-text)
|
|
|
2006 "Initiate a verify operation on SIGNATURE.
|
|
|
2007 SIGNATURE and SIGNED-TEXT are a data object if they are specified.
|
|
|
2008
|
|
|
2009 For a detached signature, both SIGNATURE and SIGNED-TEXT should be set.
|
|
|
2010 For a normal or a cleartext signature, SIGNED-TEXT should be nil.
|
|
|
2011
|
|
|
2012 If you use this function, you will need to wait for the completion of
|
|
|
2013 `epg-gpg-program' by using `epg-wait-for-completion' and call
|
|
|
2014 `epg-reset' to clear a temporaly output file.
|
|
|
2015 If you are unsure, use synchronous version of this function
|
|
|
2016 `epg-verify-file' or `epg-verify-string' instead."
|
|
|
2017 (epg-context-set-operation context 'verify)
|
|
|
2018 (epg-context-set-result context nil)
|
|
|
2019 (if signed-text
|
|
|
2020 ;; Detached signature.
|
|
|
2021 (if (epg-data-file signed-text)
|
|
|
2022 (epg--start context (list "--verify" "--" (epg-data-file signature)
|
|
|
2023 (epg-data-file signed-text)))
|
|
|
2024 (epg--start context (list "--verify" "--" (epg-data-file signature)
|
|
|
2025 "-"))
|
|
|
2026 (if (eq (process-status (epg-context-process context)) 'run)
|
|
|
2027 (process-send-string (epg-context-process context)
|
|
|
2028 (epg-data-string signed-text)))
|
|
|
2029 (if (eq (process-status (epg-context-process context)) 'run)
|
|
|
2030 (process-send-eof (epg-context-process context))))
|
|
|
2031 ;; Normal (or cleartext) signature.
|
|
|
2032 (if (epg-data-file signature)
|
|
98188
|
2033 (epg--start context (if (eq (epg-context-protocol context) 'CMS)
|
|
|
2034 (list "--verify" "--" (epg-data-file signature))
|
|
|
2035 (list "--" (epg-data-file signature))))
|
|
|
2036 (epg--start context (if (eq (epg-context-protocol context) 'CMS)
|
|
|
2037 '("--verify" "-")
|
|
|
2038 '("-")))
|
|
91647
|
2039 (if (eq (process-status (epg-context-process context)) 'run)
|
|
|
2040 (process-send-string (epg-context-process context)
|
|
|
2041 (epg-data-string signature)))
|
|
|
2042 (if (eq (process-status (epg-context-process context)) 'run)
|
|
|
2043 (process-send-eof (epg-context-process context))))))
|
|
|
2044
|
|
|
2045 (defun epg-verify-file (context signature &optional signed-text plain)
|
|
|
2046 "Verify a file SIGNATURE.
|
|
|
2047 SIGNED-TEXT and PLAIN are also a file if they are specified.
|
|
|
2048
|
|
|
2049 For a detached signature, both SIGNATURE and SIGNED-TEXT should be
|
|
|
2050 string. For a normal or a cleartext signature, SIGNED-TEXT should be
|
|
|
2051 nil. In the latter case, if PLAIN is specified, the plaintext is
|
|
|
2052 stored into the file after successful verification."
|
|
|
2053 (unwind-protect
|
|
|
2054 (progn
|
|
|
2055 (if plain
|
|
|
2056 (epg-context-set-output-file context plain)
|
|
|
2057 (epg-context-set-output-file context
|
|
|
2058 (epg--make-temp-file "epg-output")))
|
|
|
2059 (if signed-text
|
|
|
2060 (epg-start-verify context
|
|
|
2061 (epg-make-data-from-file signature)
|
|
|
2062 (epg-make-data-from-file signed-text))
|
|
|
2063 (epg-start-verify context
|
|
|
2064 (epg-make-data-from-file signature)))
|
|
|
2065 (epg-wait-for-completion context)
|
|
|
2066 (unless plain
|
|
|
2067 (epg-read-output context)))
|
|
|
2068 (unless plain
|
|
|
2069 (epg-delete-output-file context))
|
|
|
2070 (epg-reset context)))
|
|
|
2071
|
|
|
2072 (defun epg-verify-string (context signature &optional signed-text)
|
|
|
2073 "Verify a string SIGNATURE.
|
|
|
2074 SIGNED-TEXT is a string if it is specified.
|
|
|
2075
|
|
|
2076 For a detached signature, both SIGNATURE and SIGNED-TEXT should be
|
|
|
2077 string. For a normal or a cleartext signature, SIGNED-TEXT should be
|
|
|
2078 nil. In the latter case, this function returns the plaintext after
|
|
|
2079 successful verification."
|
|
|
2080 (let ((coding-system-for-write 'binary)
|
|
|
2081 input-file)
|
|
|
2082 (unwind-protect
|
|
|
2083 (progn
|
|
|
2084 (epg-context-set-output-file context
|
|
|
2085 (epg--make-temp-file "epg-output"))
|
|
|
2086 (if signed-text
|
|
|
2087 (progn
|
|
|
2088 (setq input-file (epg--make-temp-file "epg-signature"))
|
|
|
2089 (write-region signature nil input-file nil 'quiet)
|
|
|
2090 (epg-start-verify context
|
|
|
2091 (epg-make-data-from-file input-file)
|
|
|
2092 (epg-make-data-from-string signed-text)))
|
|
|
2093 (epg-start-verify context (epg-make-data-from-string signature)))
|
|
|
2094 (epg-wait-for-completion context)
|
|
|
2095 (epg-read-output context))
|
|
|
2096 (epg-delete-output-file context)
|
|
|
2097 (if (and input-file
|
|
|
2098 (file-exists-p input-file))
|
108223
261591829d04
Add optional arg to delete-file to force deletion (Bug#6070).
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2099 (delete-file input-file))
|
|
91647
|
2100 (epg-reset context))))
|
|
|
2101
|
|
|
2102 (defun epg-start-sign (context plain &optional mode)
|
|
|
2103 "Initiate a sign operation on PLAIN.
|
|
|
2104 PLAIN is a data object.
|
|
|
2105
|
|
|
2106 If optional 3rd argument MODE is t or 'detached, it makes a detached signature.
|
|
|
2107 If it is nil or 'normal, it makes a normal signature.
|
|
|
2108 Otherwise, it makes a cleartext signature.
|
|
|
2109
|
|
|
2110 If you use this function, you will need to wait for the completion of
|
|
|
2111 `epg-gpg-program' by using `epg-wait-for-completion' and call
|
|
|
2112 `epg-reset' to clear a temporaly output file.
|
|
|
2113 If you are unsure, use synchronous version of this function
|
|
|
2114 `epg-sign-file' or `epg-sign-string' instead."
|
|
|
2115 (epg-context-set-operation context 'sign)
|
|
|
2116 (epg-context-set-result context nil)
|
|
|
2117 (unless (memq mode '(t detached nil normal)) ;i.e. cleartext
|
|
|
2118 (epg-context-set-armor context nil)
|
|
|
2119 (epg-context-set-textmode context nil))
|
|
|
2120 (epg--start context
|
|
|
2121 (append (list (if (memq mode '(t detached))
|
|
|
2122 "--detach-sign"
|
|
|
2123 (if (memq mode '(nil normal))
|
|
|
2124 "--sign"
|
|
|
2125 "--clearsign")))
|
|
|
2126 (apply #'nconc
|
|
|
2127 (mapcar
|
|
|
2128 (lambda (signer)
|
|
|
2129 (list "-u"
|
|
|
2130 (epg-sub-key-id
|
|
|
2131 (car (epg-key-sub-key-list signer)))))
|
|
|
2132 (epg-context-signers context)))
|
|
|
2133 (epg--args-from-sig-notations
|
|
|
2134 (epg-context-sig-notations context))
|
|
|
2135 (if (epg-data-file plain)
|
|
|
2136 (list "--" (epg-data-file plain)))))
|
|
|
2137 ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
|
|
|
2138 (unless (eq (epg-context-protocol context) 'CMS)
|
|
|
2139 (epg-wait-for-status context '("BEGIN_SIGNING")))
|
|
|
2140 (when (epg-data-string plain)
|
|
|
2141 (if (eq (process-status (epg-context-process context)) 'run)
|
|
|
2142 (process-send-string (epg-context-process context)
|
|
|
2143 (epg-data-string plain)))
|
|
|
2144 (if (eq (process-status (epg-context-process context)) 'run)
|
|
|
2145 (process-send-eof (epg-context-process context)))))
|
|
|
2146
|
|
|
2147 (defun epg-sign-file (context plain signature &optional mode)
|
|
|
2148 "Sign a file PLAIN and store the result to a file SIGNATURE.
|
|
|
2149 If SIGNATURE is nil, it returns the result as a string.
|
|
|
2150 If optional 3rd argument MODE is t or 'detached, it makes a detached signature.
|
|
|
2151 If it is nil or 'normal, it makes a normal signature.
|
|
|
2152 Otherwise, it makes a cleartext signature."
|
|
|
2153 (unwind-protect
|
|
|
2154 (progn
|
|
|
2155 (if signature
|
|
|
2156 (epg-context-set-output-file context signature)
|
|
|
2157 (epg-context-set-output-file context
|
|
|
2158 (epg--make-temp-file "epg-output")))
|
|
|
2159 (epg-start-sign context (epg-make-data-from-file plain) mode)
|
|
|
2160 (epg-wait-for-completion context)
|
|
|
2161 (unless (epg-context-result-for context 'sign)
|
|
|
2162 (if (epg-context-result-for context 'error)
|
|
|
2163 (error "Sign failed: %S"
|
|
|
2164 (epg-context-result-for context 'error))
|
|
|
2165 (error "Sign failed")))
|
|
|
2166 (unless signature
|
|
|
2167 (epg-read-output context)))
|
|
|
2168 (unless signature
|
|
|
2169 (epg-delete-output-file context))
|
|
|
2170 (epg-reset context)))
|
|
|
2171
|
|
|
2172 (defun epg-sign-string (context plain &optional mode)
|
|
|
2173 "Sign a string PLAIN and return the output as string.
|
|
|
2174 If optional 3rd argument MODE is t or 'detached, it makes a detached signature.
|
|
|
2175 If it is nil or 'normal, it makes a normal signature.
|
|
|
2176 Otherwise, it makes a cleartext signature."
|
|
|
2177 (let ((input-file
|
|
|
2178 (unless (or (eq (epg-context-protocol context) 'CMS)
|
|
|
2179 (condition-case nil
|
|
|
2180 (progn
|
|
|
2181 (epg-check-configuration (epg-configuration))
|
|
|
2182 t)
|
|
|
2183 (error)))
|
|
|
2184 (epg--make-temp-file "epg-input")))
|
|
|
2185 (coding-system-for-write 'binary))
|
|
|
2186 (unwind-protect
|
|
|
2187 (progn
|
|
|
2188 (epg-context-set-output-file context
|
|
|
2189 (epg--make-temp-file "epg-output"))
|
|
|
2190 (if input-file
|
|
|
2191 (write-region plain nil input-file nil 'quiet))
|
|
|
2192 (epg-start-sign context
|
|
|
2193 (if input-file
|
|
|
2194 (epg-make-data-from-file input-file)
|
|
|
2195 (epg-make-data-from-string plain))
|
|
|
2196 mode)
|
|
|
2197 (epg-wait-for-completion context)
|
|
|
2198 (unless (epg-context-result-for context 'sign)
|
|
|
2199 (if (epg-context-result-for context 'error)
|
|
|
2200 (error "Sign failed: %S"
|
|
|
2201 (epg-context-result-for context 'error))
|
|
|
2202 (error "Sign failed")))
|
|
|
2203 (epg-read-output context))
|
|
|
2204 (epg-delete-output-file context)
|
|
|
2205 (if input-file
|
108806
511da81b16c5
Change delete-by-moving-to-trash so Lisp calls explicitly request trashing.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2206 (delete-file input-file))
|
|
91647
|
2207 (epg-reset context))))
|
|
|
2208
|
|
|
2209 (defun epg-start-encrypt (context plain recipients
|
|
|
2210 &optional sign always-trust)
|
|
|
2211 "Initiate an encrypt operation on PLAIN.
|
|
|
2212 PLAIN is a data object.
|
|
|
2213 If RECIPIENTS is nil, it performs symmetric encryption.
|
|
|
2214
|
|
|
2215 If you use this function, you will need to wait for the completion of
|
|
|
2216 `epg-gpg-program' by using `epg-wait-for-completion' and call
|
|
|
2217 `epg-reset' to clear a temporaly output file.
|
|
|
2218 If you are unsure, use synchronous version of this function
|
|
|
2219 `epg-encrypt-file' or `epg-encrypt-string' instead."
|
|
|
2220 (epg-context-set-operation context 'encrypt)
|
|
|
2221 (epg-context-set-result context nil)
|
|
|
2222 (epg--start context
|
|
|
2223 (append (if always-trust '("--always-trust"))
|
|
|
2224 (if recipients '("--encrypt") '("--symmetric"))
|
|
|
2225 (if sign '("--sign"))
|
|
|
2226 (if sign
|
|
|
2227 (apply #'nconc
|
|
|
2228 (mapcar
|
|
|
2229 (lambda (signer)
|
|
|
2230 (list "-u"
|
|
|
2231 (epg-sub-key-id
|
|
|
2232 (car (epg-key-sub-key-list
|
|
|
2233 signer)))))
|
|
|
2234 (epg-context-signers context))))
|
|
|
2235 (if sign
|
|
|
2236 (epg--args-from-sig-notations
|
|
|
2237 (epg-context-sig-notations context)))
|
|
|
2238 (apply #'nconc
|
|
|
2239 (mapcar
|
|
|
2240 (lambda (recipient)
|
|
|
2241 (list "-r"
|
|
|
2242 (epg-sub-key-id
|
|
|
2243 (car (epg-key-sub-key-list recipient)))))
|
|
|
2244 recipients))
|
|
|
2245 (if (epg-data-file plain)
|
|
|
2246 (list "--" (epg-data-file plain)))))
|
|
|
2247 ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
|
|
|
2248 (unless (eq (epg-context-protocol context) 'CMS)
|
|
|
2249 (if sign
|
|
|
2250 (epg-wait-for-status context '("BEGIN_SIGNING"))
|
|
|
2251 (epg-wait-for-status context '("BEGIN_ENCRYPTION"))))
|
|
|
2252 (when (epg-data-string plain)
|
|
|
2253 (if (eq (process-status (epg-context-process context)) 'run)
|
|
|
2254 (process-send-string (epg-context-process context)
|
|
|
2255 (epg-data-string plain)))
|
|
|
2256 (if (eq (process-status (epg-context-process context)) 'run)
|
|
|
2257 (process-send-eof (epg-context-process context)))))
|
|
|
2258
|
|
|
2259 (defun epg-encrypt-file (context plain recipients
|
|
|
2260 cipher &optional sign always-trust)
|
|
|
2261 "Encrypt a file PLAIN and store the result to a file CIPHER.
|
|
|
2262 If CIPHER is nil, it returns the result as a string.
|
|
|
2263 If RECIPIENTS is nil, it performs symmetric encryption."
|
|
|
2264 (unwind-protect
|
|
|
2265 (progn
|
|
|
2266 (if cipher
|
|
|
2267 (epg-context-set-output-file context cipher)
|
|
|
2268 (epg-context-set-output-file context
|
|
|
2269 (epg--make-temp-file "epg-output")))
|
|
|
2270 (epg-start-encrypt context (epg-make-data-from-file plain)
|
|
|
2271 recipients sign always-trust)
|
|
|
2272 (epg-wait-for-completion context)
|
|
|
2273 (if (and sign
|
|
|
2274 (not (epg-context-result-for context 'sign)))
|
|
|
2275 (if (epg-context-result-for context 'error)
|
|
|
2276 (error "Sign failed: %S"
|
|
|
2277 (epg-context-result-for context 'error))
|
|
|
2278 (error "Sign failed")))
|
|
|
2279 (if (epg-context-result-for context 'error)
|
|
|
2280 (error "Encrypt failed: %S"
|
|
|
2281 (epg-context-result-for context 'error)))
|
|
|
2282 (unless cipher
|
|
|
2283 (epg-read-output context)))
|
|
|
2284 (unless cipher
|
|
|
2285 (epg-delete-output-file context))
|
|
|
2286 (epg-reset context)))
|
|
|
2287
|
|
|
2288 (defun epg-encrypt-string (context plain recipients
|
|
|
2289 &optional sign always-trust)
|
|
|
2290 "Encrypt a string PLAIN.
|
|
|
2291 If RECIPIENTS is nil, it performs symmetric encryption."
|
|
|
2292 (let ((input-file
|
|
|
2293 (unless (or (not sign)
|
|
|
2294 (eq (epg-context-protocol context) 'CMS)
|
|
|
2295 (condition-case nil
|
|
|
2296 (progn
|
|
|
2297 (epg-check-configuration (epg-configuration))
|
|
|
2298 t)
|
|
|
2299 (error)))
|
|
|
2300 (epg--make-temp-file "epg-input")))
|
|
|
2301 (coding-system-for-write 'binary))
|
|
|
2302 (unwind-protect
|
|
|
2303 (progn
|
|
|
2304 (epg-context-set-output-file context
|
|
|
2305 (epg--make-temp-file "epg-output"))
|
|
|
2306 (if input-file
|
|
|
2307 (write-region plain nil input-file nil 'quiet))
|
|
|
2308 (epg-start-encrypt context
|
|
|
2309 (if input-file
|
|
|
2310 (epg-make-data-from-file input-file)
|
|
|
2311 (epg-make-data-from-string plain))
|
|
|
2312 recipients sign always-trust)
|
|
|
2313 (epg-wait-for-completion context)
|
|
|
2314 (if (and sign
|
|
|
2315 (not (epg-context-result-for context 'sign)))
|
|
|
2316 (if (epg-context-result-for context 'error)
|
|
|
2317 (error "Sign failed: %S"
|
|
|
2318 (epg-context-result-for context 'error))
|
|
|
2319 (error "Sign failed")))
|
|
|
2320 (if (epg-context-result-for context 'error)
|
|
|
2321 (error "Encrypt failed: %S"
|
|
|
2322 (epg-context-result-for context 'error)))
|
|
|
2323 (epg-read-output context))
|
|
|
2324 (epg-delete-output-file context)
|
|
|
2325 (if input-file
|
108806
511da81b16c5
Change delete-by-moving-to-trash so Lisp calls explicitly request trashing.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2326 (delete-file input-file))
|
|
91647
|
2327 (epg-reset context))))
|
|
|
2328
|
|
|
2329 (defun epg-start-export-keys (context keys)
|
|
|
2330 "Initiate an export keys operation.
|
|
|
2331
|
|
|
2332 If you use this function, you will need to wait for the completion of
|
|
|
2333 `epg-gpg-program' by using `epg-wait-for-completion' and call
|
|
|
2334 `epg-reset' to clear a temporaly output file.
|
|
|
2335 If you are unsure, use synchronous version of this function
|
|
|
2336 `epg-export-keys-to-file' or `epg-export-keys-to-string' instead."
|
|
|
2337 (epg-context-set-operation context 'export-keys)
|
|
|
2338 (epg-context-set-result context nil)
|
|
|
2339 (epg--start context (cons "--export"
|
|
|
2340 (mapcar
|
|
|
2341 (lambda (key)
|
|
|
2342 (epg-sub-key-id
|
|
|
2343 (car (epg-key-sub-key-list key))))
|
|
|
2344 keys))))
|
|
|
2345
|
|
|
2346 (defun epg-export-keys-to-file (context keys file)
|
|
|
2347 "Extract public KEYS."
|
|
|
2348 (unwind-protect
|
|
|
2349 (progn
|
|
|
2350 (if file
|
|
|
2351 (epg-context-set-output-file context file)
|
|
|
2352 (epg-context-set-output-file context
|
|
|
2353 (epg--make-temp-file "epg-output")))
|
|
|
2354 (epg-start-export-keys context keys)
|
|
|
2355 (epg-wait-for-completion context)
|
|
|
2356 (if (epg-context-result-for context 'error)
|
|
|
2357 (error "Export keys failed: %S"
|
|
|
2358 (epg-context-result-for context 'error)))
|
|
|
2359 (unless file
|
|
|
2360 (epg-read-output context)))
|
|
|
2361 (unless file
|
|
|
2362 (epg-delete-output-file context))
|
|
|
2363 (epg-reset context)))
|
|
|
2364
|
|
|
2365 (defun epg-export-keys-to-string (context keys)
|
|
|
2366 "Extract public KEYS and return them as a string."
|
|
|
2367 (epg-export-keys-to-file context keys nil))
|
|
|
2368
|
|
|
2369 (defun epg-start-import-keys (context keys)
|
|
|
2370 "Initiate an import keys operation.
|
|
|
2371 KEYS is a data object.
|
|
|
2372
|
|
|
2373 If you use this function, you will need to wait for the completion of
|
|
|
2374 `epg-gpg-program' by using `epg-wait-for-completion' and call
|
|
|
2375 `epg-reset' to clear a temporaly output file.
|
|
|
2376 If you are unsure, use synchronous version of this function
|
|
|
2377 `epg-import-keys-from-file' or `epg-import-keys-from-string' instead."
|
|
|
2378 (epg-context-set-operation context 'import-keys)
|
|
|
2379 (epg-context-set-result context nil)
|
|
|
2380 (epg--start context (if (epg-data-file keys)
|
|
|
2381 (list "--import" "--" (epg-data-file keys))
|
|
|
2382 (list "--import")))
|
|
|
2383 (when (epg-data-string keys)
|
|
|
2384 (if (eq (process-status (epg-context-process context)) 'run)
|
|
|
2385 (process-send-string (epg-context-process context)
|
|
|
2386 (epg-data-string keys)))
|
|
|
2387 (if (eq (process-status (epg-context-process context)) 'run)
|
|
|
2388 (process-send-eof (epg-context-process context)))))
|
|
|
2389
|
|
|
2390 (defun epg--import-keys-1 (context keys)
|
|
|
2391 (unwind-protect
|
|
|
2392 (progn
|
|
|
2393 (epg-start-import-keys context keys)
|
|
|
2394 (epg-wait-for-completion context)
|
|
|
2395 (if (epg-context-result-for context 'error)
|
|
|
2396 (error "Import keys failed: %S"
|
|
|
2397 (epg-context-result-for context 'error))))
|
|
|
2398 (epg-reset context)))
|
|
|
2399
|
|
|
2400 (defun epg-import-keys-from-file (context keys)
|
|
|
2401 "Add keys from a file KEYS."
|
|
|
2402 (epg--import-keys-1 context (epg-make-data-from-file keys)))
|
|
|
2403
|
|
|
2404 (defun epg-import-keys-from-string (context keys)
|
|
|
2405 "Add keys from a string KEYS."
|
|
|
2406 (epg--import-keys-1 context (epg-make-data-from-string keys)))
|
|
|
2407
|
|
|
2408 (defun epg-start-receive-keys (context key-id-list)
|
|
|
2409 "Initiate a receive key operation.
|
|
|
2410 KEY-ID-LIST is a list of key IDs.
|
|
|
2411
|
|
|
2412 If you use this function, you will need to wait for the completion of
|
|
|
2413 `epg-gpg-program' by using `epg-wait-for-completion' and call
|
|
|
2414 `epg-reset' to clear a temporaly output file.
|
|
|
2415 If you are unsure, use synchronous version of this function
|
|
93506
|
2416 `epg-receive-keys' instead."
|
|
91647
|
2417 (epg-context-set-operation context 'receive-keys)
|
|
|
2418 (epg-context-set-result context nil)
|
|
|
2419 (epg--start context (cons "--recv-keys" key-id-list)))
|
|
|
2420
|
|
|
2421 (defun epg-receive-keys (context keys)
|
|
|
2422 "Add keys from server.
|
|
|
2423 KEYS is a list of key IDs"
|
|
|
2424 (unwind-protect
|
|
|
2425 (progn
|
|
|
2426 (epg-start-receive-keys context keys)
|
|
|
2427 (epg-wait-for-completion context)
|
|
|
2428 (if (epg-context-result-for context 'error)
|
|
|
2429 (error "Receive keys failed: %S"
|
|
|
2430 (epg-context-result-for context 'error))))
|
|
|
2431 (epg-reset context)))
|
|
|
2432
|
|
|
2433 (defalias 'epg-import-keys-from-server 'epg-receive-keys)
|
|
|
2434
|
|
|
2435 (defun epg-start-delete-keys (context keys &optional allow-secret)
|
|
92510
|
2436 "Initiate a delete keys operation.
|
|
91647
|
2437
|
|
|
2438 If you use this function, you will need to wait for the completion of
|
|
|
2439 `epg-gpg-program' by using `epg-wait-for-completion' and call
|
|
|
2440 `epg-reset' to clear a temporaly output file.
|
|
|
2441 If you are unsure, use synchronous version of this function
|
|
|
2442 `epg-delete-keys' instead."
|
|
|
2443 (epg-context-set-operation context 'delete-keys)
|
|
|
2444 (epg-context-set-result context nil)
|
|
|
2445 (epg--start context (cons (if allow-secret
|
|
|
2446 "--delete-secret-key"
|
|
|
2447 "--delete-key")
|
|
|
2448 (mapcar
|
|
|
2449 (lambda (key)
|
|
|
2450 (epg-sub-key-id
|
|
|
2451 (car (epg-key-sub-key-list key))))
|
|
|
2452 keys))))
|
|
|
2453
|
|
|
2454 (defun epg-delete-keys (context keys &optional allow-secret)
|
|
|
2455 "Delete KEYS from the key ring."
|
|
|
2456 (unwind-protect
|
|
|
2457 (progn
|
|
|
2458 (epg-start-delete-keys context keys allow-secret)
|
|
|
2459 (epg-wait-for-completion context)
|
|
|
2460 (let ((entry (assq 'delete-problem
|
|
|
2461 (epg-context-result-for context 'error))))
|
|
|
2462 (if entry
|
|
|
2463 (if (setq entry (assq (cdr entry)
|
|
|
2464 epg-delete-problem-reason-alist))
|
|
|
2465 (error "Delete keys failed: %s" (cdr entry))
|
|
|
2466 (error "Delete keys failed")))))
|
|
|
2467 (epg-reset context)))
|
|
|
2468
|
|
|
2469 (defun epg-start-sign-keys (context keys &optional local)
|
|
|
2470 "Initiate a sign keys operation.
|
|
|
2471
|
|
|
2472 If you use this function, you will need to wait for the completion of
|
|
|
2473 `epg-gpg-program' by using `epg-wait-for-completion' and call
|
|
|
2474 `epg-reset' to clear a temporaly output file.
|
|
|
2475 If you are unsure, use synchronous version of this function
|
|
|
2476 `epg-sign-keys' instead."
|
|
|
2477 (epg-context-set-operation context 'sign-keys)
|
|
|
2478 (epg-context-set-result context nil)
|
|
|
2479 (epg--start context (cons (if local
|
|
|
2480 "--lsign-key"
|
|
|
2481 "--sign-key")
|
|
|
2482 (mapcar
|
|
|
2483 (lambda (key)
|
|
|
2484 (epg-sub-key-id
|
|
|
2485 (car (epg-key-sub-key-list key))))
|
|
|
2486 keys))))
|
|
104395
|
2487 (make-obsolete 'epg-start-sign-keys "do not use." "23.1")
|
|
91647
|
2488
|
|
|
2489 (defun epg-sign-keys (context keys &optional local)
|
|
|
2490 "Sign KEYS from the key ring."
|
|
|
2491 (unwind-protect
|
|
|
2492 (progn
|
|
|
2493 (epg-start-sign-keys context keys local)
|
|
|
2494 (epg-wait-for-completion context)
|
|
|
2495 (if (epg-context-result-for context 'error)
|
|
|
2496 (error "Sign keys failed: %S"
|
|
|
2497 (epg-context-result-for context 'error))))
|
|
|
2498 (epg-reset context)))
|
|
104395
|
2499 (make-obsolete 'epg-sign-keys "do not use." "23.1")
|
|
91647
|
2500
|
|
|
2501 (defun epg-start-generate-key (context parameters)
|
|
|
2502 "Initiate a key generation.
|
|
|
2503 PARAMETERS specifies parameters for the key.
|
|
|
2504
|
|
|
2505 If you use this function, you will need to wait for the completion of
|
|
|
2506 `epg-gpg-program' by using `epg-wait-for-completion' and call
|
|
|
2507 `epg-reset' to clear a temporaly output file.
|
|
|
2508 If you are unsure, use synchronous version of this function
|
|
|
2509 `epg-generate-key-from-file' or `epg-generate-key-from-string' instead."
|
|
|
2510 (epg-context-set-operation context 'generate-key)
|
|
|
2511 (epg-context-set-result context nil)
|
|
|
2512 (if (epg-data-file parameters)
|
|
|
2513 (epg--start context (list "--batch" "--genkey" "--"
|
|
|
2514 (epg-data-file parameters)))
|
|
|
2515 (epg--start context '("--batch" "--genkey"))
|
|
|
2516 (if (eq (process-status (epg-context-process context)) 'run)
|
|
|
2517 (process-send-string (epg-context-process context)
|
|
|
2518 (epg-data-string parameters)))
|
|
|
2519 (if (eq (process-status (epg-context-process context)) 'run)
|
|
|
2520 (process-send-eof (epg-context-process context)))))
|
|
|
2521
|
|
|
2522 (defun epg-generate-key-from-file (context parameters)
|
|
|
2523 "Generate a new key pair.
|
|
|
2524 PARAMETERS is a file which tells how to create the key."
|
|
|
2525 (unwind-protect
|
|
|
2526 (progn
|
|
|
2527 (epg-start-generate-key context (epg-make-data-from-file parameters))
|
|
|
2528 (epg-wait-for-completion context)
|
|
|
2529 (if (epg-context-result-for context 'error)
|
|
|
2530 (error "Generate key failed: %S"
|
|
|
2531 (epg-context-result-for context 'error))))
|
|
|
2532 (epg-reset context)))
|
|
|
2533
|
|
|
2534 (defun epg-generate-key-from-string (context parameters)
|
|
|
2535 "Generate a new key pair.
|
|
|
2536 PARAMETERS is a string which tells how to create the key."
|
|
|
2537 (unwind-protect
|
|
|
2538 (progn
|
|
|
2539 (epg-start-generate-key context (epg-make-data-from-string parameters))
|
|
|
2540 (epg-wait-for-completion context)
|
|
|
2541 (if (epg-context-result-for context 'error)
|
|
|
2542 (error "Generate key failed: %S"
|
|
|
2543 (epg-context-result-for context 'error))))
|
|
|
2544 (epg-reset context)))
|
|
|
2545
|
|
|
2546 (defun epg--decode-percent-escape (string)
|
|
|
2547 (let ((index 0))
|
|
|
2548 (while (string-match "%\\(\\(%\\)\\|\\([0-9A-Fa-f][0-9A-Fa-f]\\)\\)"
|
|
|
2549 string index)
|
|
|
2550 (if (match-beginning 2)
|
|
|
2551 (setq string (replace-match "%" t t string)
|
|
|
2552 index (1- (match-end 0)))
|
|
|
2553 (setq string (replace-match
|
|
|
2554 (string (string-to-number (match-string 3 string) 16))
|
|
|
2555 t t string)
|
|
|
2556 index (- (match-end 0) 2))))
|
|
|
2557 string))
|
|
|
2558
|
|
|
2559 (defun epg--decode-hexstring (string)
|
|
|
2560 (let ((index 0))
|
|
|
2561 (while (eq index (string-match "[0-9A-Fa-f][0-9A-Fa-f]" string index))
|
|
|
2562 (setq string (replace-match (string (string-to-number
|
|
|
2563 (match-string 0 string) 16))
|
|
|
2564 t t string)
|
|
|
2565 index (1- (match-end 0))))
|
|
|
2566 string))
|
|
|
2567
|
|
|
2568 (defun epg--decode-quotedstring (string)
|
|
|
2569 (let ((index 0))
|
|
|
2570 (while (string-match "\\\\\\(\\([,=+<>#;\\\"]\\)\\|\
|
|
|
2571 \\([0-9A-Fa-f][0-9A-Fa-f]\\)\\)"
|
|
|
2572 string index)
|
|
|
2573 (if (match-beginning 2)
|
|
|
2574 (setq string (replace-match "\\2" t nil string)
|
|
|
2575 index (1- (match-end 0)))
|
|
|
2576 (if (match-beginning 3)
|
|
|
2577 (setq string (replace-match (string (string-to-number
|
|
|
2578 (match-string 0 string) 16))
|
|
|
2579 t t string)
|
|
|
2580 index (- (match-end 0) 2)))))
|
|
|
2581 string))
|
|
|
2582
|
|
|
2583 (defun epg-dn-from-string (string)
|
|
|
2584 "Parse STRING as LADPv3 Distinguished Names (RFC2253).
|
|
|
2585 The return value is an alist mapping from types to values."
|
|
|
2586 (let ((index 0)
|
|
|
2587 (length (length string))
|
|
|
2588 alist type value group)
|
|
|
2589 (while (< index length)
|
|
|
2590 (if (eq index (string-match "[ \t\n\r]*" string index))
|
|
|
2591 (setq index (match-end 0)))
|
|
|
2592 (if (eq index (string-match
|
|
|
2593 "\\([0-9]+\\(\\.[0-9]+\\)*\\)\[ \t\n\r]*=[ \t\n\r]*"
|
|
|
2594 string index))
|
|
|
2595 (setq type (match-string 1 string)
|
|
|
2596 index (match-end 0))
|
|
|
2597 (if (eq index (string-match "\\([0-9A-Za-z]+\\)[ \t\n\r]*=[ \t\n\r]*"
|
|
|
2598 string index))
|
|
|
2599 (setq type (match-string 1 string)
|
|
|
2600 index (match-end 0))))
|
|
|
2601 (unless type
|
|
|
2602 (error "Invalid type"))
|
|
|
2603 (if (eq index (string-match
|
|
|
2604 "\\([^,=+<>#;\\\"]\\|\\\\.\\)+"
|
|
|
2605 string index))
|
|
|
2606 (setq index (match-end 0)
|
|
|
2607 value (epg--decode-quotedstring (match-string 0 string)))
|
|
|
2608 (if (eq index (string-match "#\\([0-9A-Fa-f]+\\)" string index))
|
|
|
2609 (setq index (match-end 0)
|
|
|
2610 value (epg--decode-hexstring (match-string 1 string)))
|
|
|
2611 (if (eq index (string-match "\"\\([^\\\"]\\|\\\\.\\)*\""
|
|
|
2612 string index))
|
|
|
2613 (setq index (match-end 0)
|
|
|
2614 value (epg--decode-quotedstring
|
|
|
2615 (match-string 0 string))))))
|
|
|
2616 (if group
|
|
|
2617 (if (stringp (car (car alist)))
|
|
|
2618 (setcar alist (list (cons type value) (car alist)))
|
|
|
2619 (setcar alist (cons (cons type value) (car alist))))
|
|
|
2620 (if (consp (car (car alist)))
|
|
|
2621 (setcar alist (nreverse (car alist))))
|
|
|
2622 (setq alist (cons (cons type value) alist)
|
|
|
2623 type nil
|
|
|
2624 value nil))
|
|
|
2625 (if (eq index (string-match "[ \t\n\r]*\\([,;+]\\)" string index))
|
|
|
2626 (setq index (match-end 0)
|
|
|
2627 group (eq (aref string (match-beginning 1)) ?+))))
|
|
|
2628 (nreverse alist)))
|
|
|
2629
|
|
|
2630 (defun epg-decode-dn (alist)
|
|
|
2631 "Convert ALIST returned by `epg-dn-from-string' to a human readable form.
|
|
|
2632 Type names are resolved using `epg-dn-type-alist'."
|
|
|
2633 (mapconcat
|
|
|
2634 (lambda (rdn)
|
|
|
2635 (if (stringp (car rdn))
|
|
|
2636 (let ((entry (assoc (car rdn) epg-dn-type-alist)))
|
|
|
2637 (if entry
|
|
|
2638 (format "%s=%s" (cdr entry) (cdr rdn))
|
|
|
2639 (format "%s=%s" (car rdn) (cdr rdn))))
|
|
|
2640 (concat "(" (epg-decode-dn rdn) ")")))
|
|
|
2641 alist
|
|
|
2642 ", "))
|
|
|
2643
|
|
|
2644 (provide 'epg)
|
|
|
2645
|
|
91687
|
2646 ;; arch-tag: de8f0acc-1bcf-4c14-a09e-bfffe1b579b7
|
|
91647
|
2647 ;;; epg.el ends here
|
