code.delx.au - gnu-emacs/blob - lisp/epg.el

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