lisp/epg.el

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