lisp/epg.el

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