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