epg.el

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