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      (if user-id
 763          (concat " "
 764                  (if (stringp user-id)
 765                      user-id
 766                    (epg-decode-dn user-id)))
 767        "")
 768      (if (epg-signature-validity signature)
 769          (format " (trust %s)"  (epg-signature-validity signature))
 770        ""))))
 771
 772 (defun epg-verify-result-to-string (verify-result)
 773   "Convert VERIFY-RESULT to a human readable string."
 774   (mapconcat #'epg-signature-to-string verify-result "\n"))
 775
 776 (defun epg-new-signature-to-string (new-signature)
 777   "Convert NEW-SIGNATURE to a human readable string."
 778   (concat
 779    (cond ((eq (epg-new-signature-type new-signature) 'detached)
 780           "Detached signature ")
 781          ((eq (epg-new-signature-type new-signature) 'clear)
 782           "Clear text signature ")
 783          (t
 784           "Signature "))
 785    (cdr (assq (epg-new-signature-pubkey-algorithm new-signature)
 786               epg-pubkey-algorithm-alist))
 787    "/"
 788    (cdr (assq (epg-new-signature-digest-algorithm new-signature)
 789               epg-digest-algorithm-alist))
 790    " "
 791    (format "%02X " (epg-new-signature-class new-signature))
 792    (epg-new-signature-fingerprint new-signature)))
 793
 794 (defun epg--start (context args)
 795   "Start `epg-gpg-program' in a subprocess with given ARGS."
 796   (if (and (epg-context-process context)
 797            (eq (process-status (epg-context-process context)) 'run))
 798       (error "%s is already running in this context"
 799              (if (eq (epg-context-protocol context) 'CMS)
 800                  epg-gpgsm-program
 801                epg-gpg-program)))
 802   (let* ((args (append (list "--no-tty"
 803                              "--status-fd" "1"
 804                              "--yes")
 805                        (unless (eq (epg-context-protocol context) 'CMS)
 806                          (list "--command-fd" "0"))
 807                        (if (epg-context-armor context) '("--armor"))
 808                        (if (epg-context-textmode context) '("--textmode"))
 809                        (if (epg-context-output-file context)
 810                            (list "--output" (epg-context-output-file context)))
 811                        args))
 812          (coding-system-for-write 'binary)
 813          process-connection-type
 814          (orig-mode (default-file-modes))
 815          (buffer (generate-new-buffer " *epg*"))
 816          process)
 817     (if epg-debug
 818         (save-excursion
 819           (unless epg-debug-buffer
 820             (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
 821           (set-buffer epg-debug-buffer)
 822           (goto-char (point-max))
 823           (insert (format "%s %s\n"
 824                           (if (eq (epg-context-protocol context) 'CMS)
 825                               epg-gpgsm-program
 826                            epg-gpg-program)
 827                           (mapconcat #'identity args " ")))))
 828     (with-current-buffer buffer
 829       (make-local-variable 'epg-read-point)
 830       (setq epg-read-point (point-min))
 831       (make-local-variable 'epg-pending-status-list)
 832       (setq epg-pending-status-list nil)
 833       (make-local-variable 'epg-key-id)
 834       (setq epg-key-id nil)
 835       (make-local-variable 'epg-context)
 836       (setq epg-context context))
 837     (unwind-protect
 838         (progn
 839           (set-default-file-modes 448)
 840           (setq process
 841                 (apply #'start-process "epg" buffer
 842                        (if (eq (epg-context-protocol context) 'CMS)
 843                            epg-gpgsm-program
 844                          epg-gpg-program)
 845                        args)))
 846       (set-default-file-modes orig-mode))
 847     (set-process-filter process #'epg--process-filter)
 848     (epg-context-set-process context process)))
 849
 850 (defun epg--process-filter (process input)
 851   (if epg-debug
 852       (save-excursion
 853         (unless epg-debug-buffer
 854           (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
 855         (set-buffer epg-debug-buffer)
 856         (goto-char (point-max))
 857         (insert input)))
 858   (if (buffer-live-p (process-buffer process))
 859       (save-excursion
 860         (set-buffer (process-buffer process))
 861         (goto-char (point-max))
 862         (insert input)
 863         (goto-char epg-read-point)
 864         (beginning-of-line)
 865         (while (looking-at ".*\n")      ;the input line finished
 866           (save-excursion
 867             (if (looking-at "\\[GNUPG:] \\([A-Z_]+\\) ?\\(.*\\)")
 868                 (let* ((status (match-string 1))
 869                        (string (match-string 2))
 870                        (symbol (intern-soft (concat "epg--status-" status))))
 871                   (if (member status epg-pending-status-list)
 872                       (setq epg-pending-status-list nil))
 873                   (if (and symbol
 874                            (fboundp symbol))
 875                       (funcall symbol epg-context string)))))
 876           (forward-line))
 877         (setq epg-read-point (point)))))
 878
 879 (defun epg-read-output (context)
 880   "Read the output file CONTEXT and return the content as a string."
 881   (with-temp-buffer
 882     (if (fboundp 'set-buffer-multibyte)
 883         (set-buffer-multibyte nil))
 884     (if (file-exists-p (epg-context-output-file context))
 885         (let ((coding-system-for-read 'binary))
 886           (insert-file-contents (epg-context-output-file context))
 887           (buffer-string)))))
 888
 889 (defun epg-wait-for-status (context status-list)
 890   "Wait until one of elements in STATUS-LIST arrives."
 891   (with-current-buffer (process-buffer (epg-context-process context))
 892     (setq epg-pending-status-list status-list)
 893     (while (and (eq (process-status (epg-context-process context)) 'run)
 894                 epg-pending-status-list)
 895       (accept-process-output (epg-context-process context) 1))))
 896
 897 (defun epg-wait-for-completion (context)
 898   "Wait until the `epg-gpg-program' process completes."
 899   (while (eq (process-status (epg-context-process context)) 'run)
 900     (accept-process-output (epg-context-process context) 1)))
 901
 902 (defun epg-reset (context)
 903   "Reset the CONTEXT."
 904   (if (and (epg-context-process context)
 905            (buffer-live-p (process-buffer (epg-context-process context))))
 906       (kill-buffer (process-buffer (epg-context-process context))))
 907   (epg-context-set-process context nil))
 908
 909 (defun epg-delete-output-file (context)
 910   "Delete the output file of CONTEXT."
 911   (if (and (epg-context-output-file context)
 912            (file-exists-p (epg-context-output-file context)))
 913       (delete-file (epg-context-output-file context))))
 914
 915 (defun epg--status-USERID_HINT (context string)
 916   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
 917       (let* ((key-id (match-string 1 string))
 918              (user-id (match-string 2 string))
 919              (entry (assoc key-id epg-user-id-alist)))
 920         (if entry
 921             (setcdr entry user-id)
 922           (setq epg-user-id-alist (cons (cons key-id user-id)
 923                                         epg-user-id-alist))))))
 924
 925 (defun epg--status-NEED_PASSPHRASE (context string)
 926   (if (string-match "\\`\\([^ ]+\\)" string)
 927       (setq epg-key-id (match-string 1 string))))
 928
 929 (defun epg--status-NEED_PASSPHRASE_SYM (context string)
 930   (setq epg-key-id 'SYM))
 931
 932 (defun epg--status-NEED_PASSPHRASE_PIN (context string)
 933   (setq epg-key-id 'PIN))
 934
 935 (defun epg--status-GET_HIDDEN (context string)
 936   (if (and epg-key-id
 937            (string-match "\\`passphrase\\." string))
 938       (let (inhibit-quit
 939             passphrase
 940             passphrase-with-new-line)
 941         (unwind-protect
 942             (condition-case nil
 943                 (progn
 944                   (setq passphrase
 945                         (funcall
 946                          (if (consp (epg-context-passphrase-callback context))
 947                              (car (epg-context-passphrase-callback context))
 948                            (epg-context-passphrase-callback context))
 949                          context
 950                          epg-key-id
 951                          (if (consp (epg-context-passphrase-callback context))
 952                              (cdr (epg-context-passphrase-callback context)))))
 953                   (when passphrase
 954                     (setq passphrase-with-new-line (concat passphrase "\n"))
 955                     (fillarray passphrase 0)
 956                     (setq passphrase nil)
 957                     (process-send-string (epg-context-process context)
 958                                          passphrase-with-new-line)))
 959               (quit
 960                (epg-context-set-result-for
 961                 context 'error
 962                 (cons '(quit)
 963                       (epg-context-result-for context 'error)))
 964                (delete-process (epg-context-process context))))
 965           (if passphrase
 966               (fillarray passphrase 0))
 967           (if passphrase-with-new-line
 968               (fillarray passphrase-with-new-line 0))))))
 969
 970 (defun epg--status-GET_BOOL (context string)
 971   (let ((entry (assoc string epg-prompt-alist))
 972         inhibit-quit)
 973     (condition-case nil
 974       (if (y-or-n-p (if entry (cdr entry) (concat string "? ")))
 975           (process-send-string (epg-context-process context) "y\n")
 976         (process-send-string (epg-context-process context) "n\n"))
 977       (quit
 978        (epg-context-set-result-for
 979         context 'error
 980         (cons '(quit)
 981               (epg-context-result-for context 'error)))
 982        (delete-process (epg-context-process context))))))
 983
 984 (defun epg--status-GET_LINE (context string)
 985   (let ((entry (assoc string epg-prompt-alist))
 986         inhibit-quit)
 987     (condition-case nil
 988         (process-send-string (epg-context-process context)
 989                              (concat (read-string
 990                                       (if entry
 991                                           (cdr entry)
 992                                         (concat string ": ")))
 993                                      "\n"))
 994       (quit
 995        (epg-context-set-result-for
 996         context 'error
 997         (cons '(quit)
 998               (epg-context-result-for context 'error)))
 999        (delete-process (epg-context-process context))))))
1000
1001 (defun epg--status-*SIG (context status string)
1002   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
1003       (let* ((key-id (match-string 1 string))
1004              (user-id (match-string 2 string))
1005              (entry (assoc key-id epg-user-id-alist)))
1006         (epg-context-set-result-for
1007          context
1008          'verify
1009          (cons (epg-make-signature status key-id)
1010                (epg-context-result-for context 'verify)))
1011         (if (eq (epg-context-protocol context) 'CMS)
1012             (condition-case nil
1013                 (setq user-id (epg-dn-from-string user-id))
1014               (error)))
1015         (if entry
1016             (setcdr entry user-id)
1017           (setq epg-user-id-alist
1018                 (cons (cons key-id user-id) epg-user-id-alist))))
1019     (epg-context-set-result-for
1020      context
1021      'verify
1022      (cons (epg-make-signature status)
1023            (epg-context-result-for context 'verify)))))
1024
1025 (defun epg--status-GOODSIG (context string)
1026   (epg--status-*SIG context 'good string))
1027
1028 (defun epg--status-EXPSIG (context string)
1029   (epg--status-*SIG context 'expired string))
1030
1031 (defun epg--status-EXPKEYSIG (context string)
1032   (epg--status-*SIG context 'expired-key string))
1033
1034 (defun epg--status-REVKEYSIG (context string)
1035   (epg--status-*SIG context 'revoked-key string))
1036
1037 (defun epg--status-BADSIG (context string)
1038   (epg--status-*SIG context 'bad string))
1039
1040 (defun epg--status-NO_PUBKEY (context string)
1041   (let ((signature (car (epg-context-result-for context 'verify))))
1042     (if (and signature
1043              (eq (epg-signature-status signature) 'error)
1044              (equal (epg-signature-key-id signature) string))
1045         (epg-signature-set-status signature 'no-pubkey))))
1046
1047 (defun epg--time-from-seconds (seconds)
1048   (let ((number-seconds (string-to-number (concat seconds ".0"))))
1049     (cons (floor (/ number-seconds 65536))
1050           (floor (mod number-seconds 65536)))))
1051
1052 (defun epg--status-ERRSIG (context string)
1053   (if (string-match "\\`\\([^ ]+\\) \\([0-9]+\\) \\([0-9]+\\) \
1054 \\([0-9A-Fa-f][0-9A-Fa-f]\\) \\([^ ]+\\) \\([0-9]+\\)"
1055                     string)
1056       (let ((signature (epg-make-signature 'error)))
1057         (epg-context-set-result-for
1058          context
1059          'verify
1060          (cons signature
1061                (epg-context-result-for context 'verify)))
1062         (epg-signature-set-key-id
1063          signature
1064          (match-string 1 string))
1065         (epg-signature-set-pubkey-algorithm
1066          signature
1067          (string-to-number (match-string 2 string)))
1068         (epg-signature-set-digest-algorithm
1069          signature
1070          (string-to-number (match-string 3 string)))
1071         (epg-signature-set-class
1072          signature
1073          (string-to-number (match-string 4 string) 16))
1074         (epg-signature-set-creation-time
1075          signature
1076          (epg--time-from-seconds (match-string 5 string))))))
1077
1078 (defun epg--status-VALIDSIG (context string)
1079   (let ((signature (car (epg-context-result-for context 'verify))))
1080     (when (and signature
1081                (eq (epg-signature-status signature) 'good)
1082                (string-match "\\`\\([^ ]+\\) [^ ]+ \\([^ ]+\\) \\([^ ]+\\) \
1083 \\([0-9]+\\) [^ ]+ \\([0-9]+\\) \\([0-9]+\\) \\([0-9A-Fa-f][0-9A-Fa-f]\\) \
1084 \\(.*\\)"
1085                            string))
1086       (epg-signature-set-fingerprint
1087        signature
1088        (match-string 1 string))
1089       (epg-signature-set-creation-time
1090        signature
1091        (epg--time-from-seconds (match-string 2 string)))
1092       (epg-signature-set-expiration-time
1093        signature
1094        (epg--time-from-seconds (match-string 3 string)))
1095       (epg-signature-set-version
1096        signature
1097        (string-to-number (match-string 4 string)))
1098       (epg-signature-set-pubkey-algorithm
1099        signature
1100        (string-to-number (match-string 5 string)))
1101       (epg-signature-set-digest-algorithm
1102        signature
1103        (string-to-number (match-string 6 string)))
1104       (epg-signature-set-class
1105        signature
1106        (string-to-number (match-string 7 string) 16)))))
1107
1108 (defun epg--status-TRUST_UNDEFINED (context string)
1109   (let ((signature (car (epg-context-result-for context 'verify))))
1110     (if (and signature
1111              (eq (epg-signature-status signature) 'good))
1112         (epg-signature-set-validity signature 'undefined))))
1113
1114 (defun epg--status-TRUST_NEVER (context string)
1115   (let ((signature (car (epg-context-result-for context 'verify))))
1116     (if (and signature
1117              (eq (epg-signature-status signature) 'good))
1118         (epg-signature-set-validity signature 'never))))
1119
1120 (defun epg--status-TRUST_MARGINAL (context string)
1121   (let ((signature (car (epg-context-result-for context 'verify))))
1122     (if (and signature
1123              (eq (epg-signature-status signature) 'marginal))
1124         (epg-signature-set-validity signature 'marginal))))
1125
1126 (defun epg--status-TRUST_FULLY (context string)
1127   (let ((signature (car (epg-context-result-for context 'verify))))
1128     (if (and signature
1129              (eq (epg-signature-status signature) 'good))
1130         (epg-signature-set-validity signature 'full))))
1131
1132 (defun epg--status-TRUST_ULTIMATE (context string)
1133   (let ((signature (car (epg-context-result-for context 'verify))))
1134     (if (and signature
1135              (eq (epg-signature-status signature) 'good))
1136         (epg-signature-set-validity signature 'ultimate))))
1137
1138 (defun epg--status-PROGRESS (context string)
1139   (if (string-match "\\`\\([^ ]+\\) \\([^ ]\\) \\([0-9]+\\) \\([0-9]+\\)"
1140                     string)
1141       (funcall (if (consp (epg-context-progress-callback context))
1142                    (car (epg-context-progress-callback context))
1143                  (epg-context-progress-callback context))
1144                context
1145                (match-string 1 string)
1146                (match-string 2 string)
1147                (string-to-number (match-string 3 string))
1148                (string-to-number (match-string 4 string))
1149                (if (consp (epg-context-progress-callback context))
1150                    (cdr (epg-context-progress-callback context))))))
1151
1152 (defun epg--status-DECRYPTION_FAILED (context string)
1153   (epg-context-set-result-for
1154    context 'error
1155    (cons '(decryption-failed)
1156          (epg-context-result-for context 'error))))
1157
1158 (defun epg--status-NODATA (context string)
1159   (epg-context-set-result-for
1160    context 'error
1161    (cons (list 'no-data (cons 'reason (string-to-number string)))
1162          (epg-context-result-for context 'error))))
1163
1164 (defun epg--status-UNEXPECTED (context string)
1165   (epg-context-set-result-for
1166    context 'error
1167    (cons (list 'unexpected (cons 'reason (string-to-number string)))
1168          (epg-context-result-for context 'error))))
1169
1170 (defun epg--status-KEYEXPIRED (context string)
1171   (epg-context-set-result-for
1172    context 'error
1173    (cons (list 'key-expired (cons 'expiration-time
1174                                   (epg--time-from-seconds string)))
1175          (epg-context-result-for context 'error))))
1176
1177 (defun epg--status-KEYREVOKED (context string)
1178   (epg-context-set-result-for
1179    context 'error
1180    (cons '(key-revoked)
1181          (epg-context-result-for context 'error))))
1182
1183 (defun epg--status-BADARMOR (context string)
1184   (epg-context-set-result-for
1185    context 'error
1186    (cons '(bad-armor)
1187          (epg-context-result-for context 'error))))
1188
1189 (defun epg--status-INV_RECP (context string)
1190   (if (string-match "\\`\\([0-9]+\\) \\(.*\\)" string)
1191       (epg-context-set-result-for
1192        context 'error
1193        (cons (list 'invalid-recipient
1194                    (cons 'reason
1195                          (string-to-number (match-string 1 string)))
1196                    (cons 'requested-recipient
1197                          (match-string 2 string)))
1198              (epg-context-result-for context 'error)))))
1199
1200 (defun epg--status-NO_RECP (context string)
1201   (epg-context-set-result-for
1202    context 'error
1203    (cons '(no-recipients)
1204          (epg-context-result-for context 'error))))
1205
1206 (defun epg--status-DELETE_PROBLEM (context string)
1207   (if (string-match "\\`\\([0-9]+\\)" string)
1208       (epg-context-set-result-for
1209        context 'error
1210        (cons (list 'delete-problem
1211                    (cons 'reason (string-to-number (match-string 1 string))))
1212              (epg-context-result-for context 'error)))))
1213
1214 (defun epg--status-SIG_CREATED (context string)
1215   (if (string-match "\\`\\([DCS]\\) \\([0-9]+\\) \\([0-9]+\\) \
1216 \\([0-9A-Fa-F][0-9A-Fa-F]\\) \\(.*\\) " string)
1217       (epg-context-set-result-for
1218        context 'sign
1219        (cons (epg-make-new-signature
1220               (cdr (assq (aref (match-string 1 string) 0)
1221                          epg-new-signature-type-alist))
1222               (string-to-number (match-string 2 string))
1223               (string-to-number (match-string 3 string))
1224               (string-to-number (match-string 4 string) 16)
1225               (epg--time-from-seconds (match-string 5 string))
1226               (substring string (match-end 0)))
1227              (epg-context-result-for context 'sign)))))
1228
1229 (defun epg--status-KEY_CREATED (context string)
1230   (if (string-match "\\`\\([BPS]\\) \\([^ ]+\\)" string)
1231       (epg-context-set-result-for
1232        context 'generate-key
1233        (cons (list (cons 'type (string-to-char (match-string 1 string)))
1234                    (cons 'fingerprint (match-string 2 string)))
1235              (epg-context-result-for context 'generate-key)))))
1236
1237 (defun epg--status-KEY_NOT_CREATED (context string)
1238   (epg-context-set-result-for
1239    context 'error
1240    (cons '(key-not-created)
1241          (epg-context-result-for context 'error))))
1242
1243 (defun epg--status-IMPORTED (context string)
1244   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
1245       (let* ((key-id (match-string 1 string))
1246              (user-id (match-string 2 string))
1247              (entry (assoc key-id epg-user-id-alist)))
1248         (if entry
1249             (setcdr entry user-id)
1250           (setq epg-user-id-alist (cons (cons key-id user-id)
1251                                         epg-user-id-alist)))
1252         (epg-context-set-result-for
1253          context 'import
1254          (cons (list (cons 'key-id key-id)
1255                      (cons 'user-id user-id))
1256                (epg-context-result-for context 'import))))))
1257
1258 (defun epg--status-IMPORT_OK (context string)
1259   (let ((result (epg-context-result-for context 'import)))
1260     (if (and result
1261              (string-match "\\`\\([0-9]+\\)\\( \\(.+\\)\\)?" string))
1262         (setcar result
1263                 (append (list (cons 'reason
1264                                     (string-to-number
1265                                      (match-string 1 string))))
1266                         (if (match-beginning 2)
1267                             (list (cons 'fingerprint
1268                                         (match-string 3 string))))
1269                         (car result))))))
1270
1271 (defun epg--status-IMPORT_PROBLEM (context string)
1272   (if (string-match "\\`\\([0-9]+\\)\\( \\(.+\\)\\)?" string)
1273       (epg-context-set-result-for
1274        context 'error
1275        (cons (cons 'import-problem
1276                    (append (list (cons 'reason
1277                                        (string-to-number
1278                                         (match-string 1 string))))
1279                            (if (match-beginning 2)
1280                                (list (cons 'fingerprint
1281                                            (match-string 3 string))))))
1282              (epg-context-result-for context 'error)))))
1283
1284 (defun epg-passphrase-callback-function (context key-id handback)
1285   (if (eq key-id 'SYM)
1286       (read-passwd "Passphrase for symmetric encryption: "
1287                    (eq (epg-context-operation context) 'encrypt))
1288     (read-passwd
1289      (if (eq key-id 'PIN)
1290         "Passphrase for PIN: "
1291        (let ((entry (assoc key-id epg-user-id-alist)))
1292          (if entry
1293              (format "Passphrase for %s %s: " key-id (cdr entry))
1294            (format "Passphrase for %s: " key-id)))))))
1295
1296 (defun epg-progress-callback-function (context what char current total
1297                                                handback)
1298   (message "%s: %d%%/%d%%" what current total))
1299
1300 (defun epg-configuration ()
1301   "Return a list of internal configuration parameters of `epg-gpg-program'."
1302   (let (config type)
1303     (with-temp-buffer
1304       (apply #'call-process epg-gpg-program nil (list t nil) nil
1305              '("--with-colons" "--list-config"))
1306       (goto-char (point-min))
1307       (while (re-search-forward "^cfg:\\([^:]+\\):\\(.*\\)" nil t)
1308         (setq type (intern (match-string 1))
1309               config (cons (cons type
1310                                  (if (memq type
1311                                            '(pubkey cipher digest compress))
1312                                      (mapcar #'string-to-number
1313                                              (delete "" (split-string
1314                                                          (match-string 2)
1315                                                          ";")))
1316                                    (match-string 2)))
1317                            config))))
1318     config))
1319
1320 (defun epg--list-keys-1 (context name mode)
1321   (let ((args (append (list "--with-colons" "--no-greeting" "--batch"
1322                             "--with-fingerprint"
1323                             "--with-fingerprint"
1324                             (if (memq mode '(t secret))
1325                                 "--list-secret-keys"
1326                               (if (memq mode '(nil public))
1327                                   "--list-keys"
1328                                 "--list-sigs")))
1329                       (unless (eq (epg-context-protocol context) 'CMS)
1330                         '("--fixed-list-mode"))
1331                       (if name (list name))))
1332         keys string field index)
1333     (with-temp-buffer
1334       (apply #'call-process
1335              (if (eq (epg-context-protocol context) 'CMS)
1336                  epg-gpgsm-program
1337                epg-gpg-program)
1338              nil (list t nil) nil args)
1339       (goto-char (point-min))
1340       (while (re-search-forward "^[a-z][a-z][a-z]:.*" nil t)
1341         (setq keys (cons (make-vector 15 nil) keys)
1342               string (match-string 0)
1343               index 0
1344               field 0)
1345         (while (eq index
1346                    (string-match "\\([^:]+\\)?:" string index))
1347           (setq index (match-end 0))
1348           (aset (car keys) field (match-string 1 string))
1349           (setq field (1+ field))))
1350       (nreverse keys))))
1351
1352 (defun epg--make-sub-key-1 (line)
1353   (epg-make-sub-key
1354    (if (aref line 1)
1355        (cdr (assq (string-to-char (aref line 1)) epg-key-validity-alist)))
1356    (delq nil
1357          (mapcar (lambda (char) (cdr (assq char epg-key-capablity-alist)))
1358                  (aref line 11)))
1359    (member (aref line 0) '("sec" "ssb"))
1360    (string-to-number (aref line 3))
1361    (string-to-number (aref line 2))
1362    (aref line 4)
1363    (epg--time-from-seconds (aref line 5))
1364    (epg--time-from-seconds (aref line 6))))
1365
1366 ;;;###autoload
1367 (defun epg-list-keys (context &optional name mode)
1368   "Return a list of epg-key objects matched with NAME.
1369 If MODE is nil or 'public, only public keyring should be searched.
1370 If MODE is t or 'secret, only secret keyring should be searched.
1371 Otherwise, only public keyring should be searched and the key
1372 signatures should be included."
1373   (let ((lines (epg--list-keys-1 context name mode))
1374         keys cert pointer pointer-1)
1375     (while lines
1376       (cond
1377        ((member (aref (car lines) 0) '("pub" "sec" "crt" "crs"))
1378         (setq cert (member (aref (car lines) 0) '("crt" "crs"))
1379               keys (cons (epg-make-key
1380                           (if (aref (car lines) 8)
1381                               (cdr (assq (string-to-char (aref (car lines) 8))
1382                                          epg-key-validity-alist))))
1383                          keys))
1384         (epg-key-set-sub-key-list
1385          (car keys)
1386          (cons (epg--make-sub-key-1 (car lines))
1387                (epg-key-sub-key-list (car keys)))))
1388        ((member (aref (car lines) 0) '("sub" "ssb"))
1389         (epg-key-set-sub-key-list
1390          (car keys)
1391          (cons (epg--make-sub-key-1 (car lines))
1392                (epg-key-sub-key-list (car keys)))))
1393        ((equal (aref (car lines) 0) "uid")
1394         (epg-key-set-user-id-list
1395          (car keys)
1396          (cons (epg-make-user-id
1397                 (if (aref (car lines) 1)
1398                     (cdr (assq (string-to-char (aref (car lines) 1))
1399                                epg-key-validity-alist)))
1400                 (if cert
1401                     (condition-case nil
1402                         (epg-dn-from-string (aref (car lines) 9))
1403                       (error (aref (car lines) 9)))
1404                   (aref (car lines) 9)))
1405                (epg-key-user-id-list (car keys)))))
1406        ((equal (aref (car lines) 0) "fpr")
1407         (epg-sub-key-set-fingerprint (car (epg-key-sub-key-list (car keys)))
1408                                      (aref (car lines) 9)))
1409        ((equal (aref (car lines) 0) "sig")
1410         (epg-user-id-set-signature-list
1411          (car (epg-key-user-id-list (car keys)))
1412          (cons
1413           (epg-make-key-signature
1414            (if (aref (car lines) 1)
1415                (cdr (assq (string-to-char (aref (car lines) 1))
1416                           epg-key-validity-alist)))
1417            (string-to-number (aref (car lines) 3))
1418            (aref (car lines) 4)
1419            (epg--time-from-seconds (aref (car lines) 5))
1420            (epg--time-from-seconds (aref (car lines) 6))
1421            (aref (car lines) 9)
1422            (string-to-number (aref (car lines) 10) 16)
1423            (eq (aref (aref (car lines) 10) 2) ?x))
1424           (epg-user-id-signature-list
1425            (car (epg-key-user-id-list (car keys))))))))
1426       (setq lines (cdr lines)))
1427     (setq keys (nreverse keys)
1428           pointer keys)
1429     (while pointer
1430       (epg-key-set-sub-key-list
1431        (car pointer)
1432        (nreverse (epg-key-sub-key-list (car pointer))))
1433       (setq pointer-1 (epg-key-set-user-id-list
1434                           (car pointer)
1435                           (nreverse (epg-key-user-id-list (car pointer)))))
1436       (while pointer-1
1437         (epg-user-id-set-signature-list
1438          (car pointer-1)
1439          (nreverse (epg-user-id-signature-list (car pointer-1))))
1440         (setq pointer-1 (cdr pointer-1)))
1441       (setq pointer (cdr pointer)))
1442     keys))
1443
1444 (if (fboundp 'make-temp-file)
1445     (defalias 'epg--make-temp-file 'make-temp-file)
1446   (defvar temporary-file-directory)
1447   ;; stolen from poe.el.
1448   (defun epg--make-temp-file (prefix)
1449     "Create a temporary file.
1450 The returned file name (created by appending some random characters at the end
1451 of PREFIX, and expanding against `temporary-file-directory' if necessary),
1452 is guaranteed to point to a newly created empty file.
1453 You can then use `write-region' to write new data into the file."
1454     (let (tempdir tempfile)
1455       (setq prefix (expand-file-name prefix
1456                                      (if (featurep 'xemacs)
1457                                          (temp-directory)
1458                                        temporary-file-directory)))
1459       (unwind-protect
1460           (let (file)
1461             ;; First, create a temporary directory.
1462             (while (condition-case ()
1463                        (progn
1464                          (setq tempdir (make-temp-name
1465                                         (concat
1466                                          (file-name-directory prefix)
1467                                          "DIR")))
1468                          ;; return nil or signal an error.
1469                          (make-directory tempdir))
1470                      ;; let's try again.
1471                      (file-already-exists t)))
1472             (set-file-modes tempdir 448)
1473             ;; Second, create a temporary file in the tempdir.
1474             ;; There *is* a race condition between `make-temp-name'
1475             ;; and `write-region', but we don't care it since we are
1476             ;; in a private directory now.
1477             (setq tempfile (make-temp-name (concat tempdir "/EMU")))
1478             (write-region "" nil tempfile nil 'silent)
1479             (set-file-modes tempfile 384)
1480             ;; Finally, make a hard-link from the tempfile.
1481             (while (condition-case ()
1482                        (progn
1483                          (setq file (make-temp-name prefix))
1484                          ;; return nil or signal an error.
1485                          (add-name-to-file tempfile file))
1486                      ;; let's try again.
1487                      (file-already-exists t)))
1488             file)
1489         ;; Cleanup the tempfile.
1490         (and tempfile
1491              (file-exists-p tempfile)
1492              (delete-file tempfile))
1493         ;; Cleanup the tempdir.
1494         (and tempdir
1495              (file-directory-p tempdir)
1496              (delete-directory tempdir))))))
1497
1498 ;;;###autoload
1499 (defun epg-cancel (context)
1500   (if (buffer-live-p (process-buffer (epg-context-process context)))
1501       (save-excursion
1502         (set-buffer (process-buffer (epg-context-process context)))
1503         (epg-context-set-result-for
1504          epg-context 'error
1505          (cons '(quit)
1506                (epg-context-result-for epg-context 'error)))))
1507   (if (eq (process-status (epg-context-process context)) 'run)
1508       (delete-process (epg-context-process context))))
1509
1510 ;;;###autoload
1511 (defun epg-start-decrypt (context cipher)
1512   "Initiate a decrypt operation on CIPHER.
1513 CIPHER is a data object.
1514
1515 If you use this function, you will need to wait for the completion of
1516 `epg-gpg-program' by using `epg-wait-for-completion' and call
1517 `epg-reset' to clear a temporaly output file.
1518 If you are unsure, use synchronous version of this function
1519 `epg-decrypt-file' or `epg-decrypt-string' instead."
1520   (unless (epg-data-file cipher)
1521     (error "Not a file"))
1522   (epg-context-set-operation context 'decrypt)
1523   (epg-context-set-result context nil)
1524   (epg--start context (list "--decrypt" (epg-data-file cipher)))
1525   ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
1526   (unless (eq (epg-context-protocol context) 'CMS)
1527     (epg-wait-for-status context '("BEGIN_DECRYPTION"))))
1528
1529 ;;;###autoload
1530 (defun epg-decrypt-file (context cipher plain)
1531   "Decrypt a file CIPHER and store the result to a file PLAIN.
1532 If PLAIN is nil, it returns the result as a string."
1533   (unwind-protect
1534       (progn
1535         (if plain
1536             (epg-context-set-output-file context plain)
1537           (epg-context-set-output-file context
1538                                        (epg--make-temp-file "epg-output")))
1539         (epg-start-decrypt context (epg-make-data-from-file cipher))
1540         (epg-wait-for-completion context)
1541         (if (epg-context-result-for context 'error)
1542             (error "Decrypt failed: %S"
1543                    (epg-context-result-for context 'error)))
1544         (unless plain
1545           (epg-read-output context)))
1546     (unless plain
1547       (epg-delete-output-file context))
1548     (epg-reset context)))
1549
1550 ;;;###autoload
1551 (defun epg-decrypt-string (context cipher)
1552   "Decrypt a string CIPHER and return the plain text."
1553   (let ((input-file (epg--make-temp-file "epg-input"))
1554         (coding-system-for-write 'binary))
1555     (unwind-protect
1556         (progn
1557           (write-region cipher nil input-file nil 'quiet)
1558           (epg-context-set-output-file context
1559                                        (epg--make-temp-file "epg-output"))
1560           (epg-start-decrypt context (epg-make-data-from-file input-file))
1561           (epg-wait-for-completion context)
1562           (if (epg-context-result-for context 'error)
1563               (error "Decrypt failed: %S"
1564                      (epg-context-result-for context 'error)))
1565           (epg-read-output context))
1566       (epg-delete-output-file context)
1567       (if (file-exists-p input-file)
1568           (delete-file input-file))
1569       (epg-reset context))))
1570
1571 ;;;###autoload
1572 (defun epg-start-verify (context signature &optional signed-text)
1573   "Initiate a verify operation on SIGNATURE.
1574 SIGNATURE and SIGNED-TEXT are a data object if they are specified.
1575
1576 For a detached signature, both SIGNATURE and SIGNED-TEXT should be set.
1577 For a normal or a clear text signature, SIGNED-TEXT should be nil.
1578
1579 If you use this function, you will need to wait for the completion of
1580 `epg-gpg-program' by using `epg-wait-for-completion' and call
1581 `epg-reset' to clear a temporaly output file.
1582 If you are unsure, use synchronous version of this function
1583 `epg-verify-file' or `epg-verify-string' instead."
1584   (epg-context-set-operation context 'verify)
1585   (epg-context-set-result context nil)
1586   (if signed-text
1587       ;; Detached signature.
1588       (if (epg-data-file signed-text)
1589           (epg--start context (list "--verify" (epg-data-file signature)
1590                                    (epg-data-file signed-text)))
1591         (epg--start context (list "--verify" (epg-data-file signature) "-"))
1592         (if (eq (process-status (epg-context-process context)) 'run)
1593             (process-send-string (epg-context-process context)
1594                                  (epg-data-string signed-text)))
1595         (if (eq (process-status (epg-context-process context)) 'run)
1596             (process-send-eof (epg-context-process context))))
1597     ;; Normal (or cleartext) signature.
1598     (if (epg-data-file signature)
1599         (epg--start context (list "--verify" (epg-data-file signature)))
1600       (epg--start context (list "--verify"))
1601       (if (eq (process-status (epg-context-process context)) 'run)
1602           (process-send-string (epg-context-process context)
1603                                (epg-data-string signature)))
1604       (if (eq (process-status (epg-context-process context)) 'run)
1605           (process-send-eof (epg-context-process context))))))
1606
1607 ;;;###autoload
1608 (defun epg-verify-file (context signature &optional signed-text plain)
1609   "Verify a file SIGNATURE.
1610 SIGNED-TEXT and PLAIN are also a file if they are specified.
1611
1612 For a detached signature, both SIGNATURE and SIGNED-TEXT should be string.
1613 For a normal or a clear text signature, SIGNED-TEXT should be nil."
1614   (unwind-protect
1615       (progn
1616         (if plain
1617             (epg-context-set-output-file context plain)
1618           (epg-context-set-output-file context
1619                                        (epg--make-temp-file "epg-output")))
1620         (if signed-text
1621             (epg-start-verify context
1622                               (epg-make-data-from-file signature)
1623                               (epg-make-data-from-file signed-text))
1624           (epg-start-verify context
1625                             (epg-make-data-from-file signature)))
1626         (epg-wait-for-completion context)
1627 ;       (if (epg-context-result-for context 'error)
1628 ;           (error "Verify failed: %S"
1629 ;                  (epg-context-result-for context 'error)))
1630         (unless plain
1631           (epg-read-output context)))
1632     (unless plain
1633       (epg-delete-output-file context))
1634     (epg-reset context)))
1635
1636 ;;;###autoload
1637 (defun epg-verify-string (context signature &optional signed-text)
1638   "Verify a string SIGNATURE.
1639 SIGNED-TEXT is a string if it is specified.
1640
1641 For a detached signature, both SIGNATURE and SIGNED-TEXT should be string.
1642 For a normal or a clear text signature, SIGNED-TEXT should be nil."
1643   (let ((coding-system-for-write 'binary)
1644         input-file)
1645     (unwind-protect
1646         (progn
1647           (epg-context-set-output-file context
1648                                        (epg--make-temp-file "epg-output"))
1649           (if signed-text
1650               (progn
1651                 (setq input-file (epg--make-temp-file "epg-signature"))
1652                 (write-region signature nil input-file nil 'quiet)
1653                 (epg-start-verify context
1654                                   (epg-make-data-from-file input-file)
1655                                   (epg-make-data-from-string signed-text)))
1656             (epg-start-verify context (epg-make-data-from-string signature)))
1657           (epg-wait-for-completion context)
1658 ;         (if (epg-context-result-for context 'error)
1659 ;             (error "Verify failed: %S"
1660 ;                    (epg-context-result-for context 'error)))
1661           (epg-read-output context))
1662       (epg-delete-output-file context)
1663       (if (and input-file
1664                (file-exists-p input-file))
1665           (delete-file input-file))
1666       (epg-reset context))))
1667
1668 ;;;###autoload
1669 (defun epg-start-sign (context plain &optional mode)
1670   "Initiate a sign operation on PLAIN.
1671 PLAIN is a data object.
1672
1673 If optional 3rd argument MODE is t or 'detached, it makes a detached signature.
1674 If it is nil or 'normal, it makes a normal signature.
1675 Otherwise, it makes a clear text signature.
1676
1677 If you use this function, you will need to wait for the completion of
1678 `epg-gpg-program' by using `epg-wait-for-completion' and call
1679 `epg-reset' to clear a temporaly output file.
1680 If you are unsure, use synchronous version of this function
1681 `epg-sign-file' or `epg-sign-string' instead."
1682   (epg-context-set-operation context 'sign)
1683   (epg-context-set-result context nil)
1684   (epg--start context
1685              (append (list (if (memq mode '(t detached))
1686                                "--detach-sign"
1687                              (if (memq mode '(nil normal))
1688                                  "--sign"
1689                                "--clearsign")))
1690                      (apply #'nconc
1691                             (mapcar
1692                              (lambda (signer)
1693                                (list "-u"
1694                                      (epg-sub-key-id
1695                                       (car (epg-key-sub-key-list signer)))))
1696                              (epg-context-signers context)))
1697                      (if (epg-data-file plain)
1698                          (list (epg-data-file plain)))))
1699   ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
1700   (unless (eq (epg-context-protocol context) 'CMS)
1701     (epg-wait-for-status context '("BEGIN_SIGNING")))
1702   (when (epg-data-string plain)
1703     (if (eq (process-status (epg-context-process context)) 'run)
1704         (process-send-string (epg-context-process context)
1705                              (epg-data-string plain)))
1706     (if (eq (process-status (epg-context-process context)) 'run)
1707         (process-send-eof (epg-context-process context)))))
1708
1709 ;;;###autoload
1710 (defun epg-sign-file (context plain signature &optional mode)
1711   "Sign a file PLAIN and store the result to a file SIGNATURE.
1712 If SIGNATURE is nil, it returns the result as a string.
1713 If optional 3rd argument MODE is t or 'detached, it makes a detached signature.
1714 If it is nil or 'normal, it makes a normal signature.
1715 Otherwise, it makes a clear text signature."
1716   (unwind-protect
1717       (progn
1718         (if signature
1719             (epg-context-set-output-file context signature)
1720           (epg-context-set-output-file context
1721                                        (epg--make-temp-file "epg-output")))
1722         (epg-start-sign context (epg-make-data-from-file plain) mode)
1723         (epg-wait-for-completion context)
1724         (unless (epg-context-result-for context 'sign)
1725           (if (epg-context-result-for context 'error)
1726               (error "Sign failed: %S"
1727                      (epg-context-result-for context 'error))
1728             (error "Sign failed")))
1729         (unless signature
1730           (epg-read-output context)))
1731     (unless signature
1732       (epg-delete-output-file context))
1733     (epg-reset context)))
1734
1735 ;;;###autoload
1736 (defun epg-sign-string (context plain &optional mode)
1737   "Sign a string PLAIN and return the output as string.
1738 If optional 3rd argument MODE is t or 'detached, it makes a detached signature.
1739 If it is nil or 'normal, it makes a normal signature.
1740 Otherwise, it makes a clear text signature."
1741   (unwind-protect
1742       (progn
1743         (epg-context-set-output-file context
1744                                      (epg--make-temp-file "epg-output"))
1745         (epg-start-sign context (epg-make-data-from-string plain) mode)
1746         (epg-wait-for-completion context)
1747         (unless (epg-context-result-for context 'sign)
1748           (if (epg-context-result-for context 'error)
1749               (error "Sign failed: %S"
1750                      (epg-context-result-for context 'error))
1751             (error "Sign failed")))
1752         (epg-read-output context))
1753     (epg-delete-output-file context)
1754     (epg-reset context)))
1755
1756 ;;;###autoload
1757 (defun epg-start-encrypt (context plain recipients
1758                                   &optional sign always-trust)
1759   "Initiate an encrypt operation on PLAIN.
1760 PLAIN is a data object.
1761 If RECIPIENTS is nil, it performs symmetric encryption.
1762
1763 If you use this function, you will need to wait for the completion of
1764 `epg-gpg-program' by using `epg-wait-for-completion' and call
1765 `epg-reset' to clear a temporaly output file.
1766 If you are unsure, use synchronous version of this function
1767 `epg-encrypt-file' or `epg-encrypt-string' instead."
1768   (epg-context-set-operation context 'encrypt)
1769   (epg-context-set-result context nil)
1770   (epg--start context
1771              (append (if always-trust '("--always-trust"))
1772                      (if recipients '("--encrypt") '("--symmetric"))
1773                      (if sign
1774                          (cons "--sign"
1775                                (apply #'nconc
1776                                       (mapcar (lambda (signer)
1777                                                 (list "-u" signer))
1778                                               (epg-context-signers context)))))
1779                      (apply #'nconc
1780                             (mapcar
1781                              (lambda (recipient)
1782                                (list "-r"
1783                                      (epg-sub-key-id
1784                                       (car (epg-key-sub-key-list recipient)))))
1785                              recipients))
1786                      (if (epg-data-file plain)
1787                          (list (epg-data-file plain)))))
1788   ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
1789   (unless (eq (epg-context-protocol context) 'CMS)
1790     (if sign
1791         (epg-wait-for-status context '("BEGIN_SIGNING"))
1792       (epg-wait-for-status context '("BEGIN_ENCRYPTION"))))
1793   (when (epg-data-string plain)
1794     (if (eq (process-status (epg-context-process context)) 'run)
1795         (process-send-string (epg-context-process context)
1796                              (epg-data-string plain)))
1797     (if (eq (process-status (epg-context-process context)) 'run)
1798         (process-send-eof (epg-context-process context)))))
1799
1800 ;;;###autoload
1801 (defun epg-encrypt-file (context plain recipients
1802                                  cipher &optional sign always-trust)
1803   "Encrypt a file PLAIN and store the result to a file CIPHER.
1804 If CIPHER is nil, it returns the result as a string.
1805 If RECIPIENTS is nil, it performs symmetric encryption."
1806   (unwind-protect
1807       (progn
1808         (if cipher
1809             (epg-context-set-output-file context cipher)
1810           (epg-context-set-output-file context
1811                                        (epg--make-temp-file "epg-output")))
1812         (epg-start-encrypt context (epg-make-data-from-file plain)
1813                            recipients sign always-trust)
1814         (epg-wait-for-completion context)
1815         (if (and sign
1816                  (not (epg-context-result-for context 'sign)))
1817             (if (epg-context-result-for context 'error)
1818                 (error "Sign failed: %S"
1819                        (epg-context-result-for context 'error))
1820                 (error "Sign failed")))
1821         (if (epg-context-result-for context 'error)
1822             (error "Encrypt failed: %S"
1823                    (epg-context-result-for context 'error)))
1824         (unless cipher
1825           (epg-read-output context)))
1826     (unless cipher
1827       (epg-delete-output-file context))
1828     (epg-reset context)))
1829
1830 ;;;###autoload
1831 (defun epg-encrypt-string (context plain recipients
1832                                    &optional sign always-trust)
1833   "Encrypt a string PLAIN.
1834 If RECIPIENTS is nil, it performs symmetric encryption."
1835   (unwind-protect
1836       (progn
1837         (epg-context-set-output-file context
1838                                      (epg--make-temp-file "epg-output"))
1839         (epg-start-encrypt context (epg-make-data-from-string plain)
1840                            recipients sign always-trust)
1841         (epg-wait-for-completion context)
1842         (if (and sign
1843                  (not (epg-context-result-for context 'sign)))
1844             (if (epg-context-result-for context 'error)
1845                 (error "Sign failed: %S"
1846                        (epg-context-result-for context 'error))
1847               (error "Sign failed")))
1848         (if (epg-context-result-for context 'error)
1849             (error "Encrypt failed: %S"
1850                    (epg-context-result-for context 'error)))
1851         (epg-read-output context))
1852     (epg-delete-output-file context)
1853     (epg-reset context)))
1854
1855 ;;;###autoload
1856 (defun epg-start-export-keys (context keys)
1857   "Initiate an export keys operation.
1858
1859 If you use this function, you will need to wait for the completion of
1860 `epg-gpg-program' by using `epg-wait-for-completion' and call
1861 `epg-reset' to clear a temporaly output file.
1862 If you are unsure, use synchronous version of this function
1863 `epg-export-keys-to-file' or `epg-export-keys-to-string' instead."
1864   (epg-context-set-operation context 'export-keys)
1865   (epg-context-set-result context nil)
1866   (epg--start context (cons "--export"
1867                            (mapcar
1868                             (lambda (key)
1869                               (epg-sub-key-id
1870                                (car (epg-key-sub-key-list key))))
1871                             keys))))
1872
1873 ;;;###autoload
1874 (defun epg-export-keys-to-file (context keys file)
1875   "Extract public KEYS."
1876   (unwind-protect
1877       (progn
1878         (if keys
1879             (epg-context-set-output-file context file)
1880           (epg-context-set-output-file context
1881                                        (epg--make-temp-file "epg-output")))
1882         (epg-start-export-keys context keys)
1883         (epg-wait-for-completion context)
1884         (if (epg-context-result-for context 'error)
1885             (error "Export keys failed: %S"
1886                    (epg-context-result-for context 'error)))
1887         (unless file
1888           (epg-read-output context)))
1889     (unless file
1890       (epg-delete-output-file context))
1891     (epg-reset context)))
1892
1893 ;;;###autoload
1894 (defun epg-export-keys-to-string (context keys)
1895   "Extract public KEYS and return them as a string."
1896   (epg-export-keys-to-file context keys nil))
1897
1898 ;;;###autoload
1899 (defun epg-start-import-keys (context keys)
1900   "Initiate an import keys operation.
1901 KEYS is a data object.
1902
1903 If you use this function, you will need to wait for the completion of
1904 `epg-gpg-program' by using `epg-wait-for-completion' and call
1905 `epg-reset' to clear a temporaly output file.
1906 If you are unsure, use synchronous version of this function
1907 `epg-import-keys-from-file' or `epg-import-keys-from-string' instead."
1908   (epg-context-set-operation context 'import-keys)
1909   (epg-context-set-result context nil)
1910   (epg--start context (if (epg-data-file keys)
1911                           (list "--import" (epg-data-file keys))
1912                         (list "--import")))
1913   (when (epg-data-string keys)
1914     (if (eq (process-status (epg-context-process context)) 'run)
1915         (process-send-string (epg-context-process context)
1916                              (epg-data-string keys)))
1917     (if (eq (process-status (epg-context-process context)) 'run)
1918         (process-send-eof (epg-context-process context)))))
1919
1920 (defun epg--import-keys-1 (context keys)
1921   (unwind-protect
1922       (progn
1923         (epg-start-import-keys context keys)
1924         (epg-wait-for-completion context)
1925         (if (epg-context-result-for context 'error)
1926             (error "Import keys failed: %S"
1927                    (epg-context-result-for context 'error))))
1928     (epg-reset context)))
1929
1930 ;;;###autoload
1931 (defun epg-import-keys-from-file (context keys)
1932   "Add keys from a file KEYS."
1933   (epg--import-keys-1 context (epg-make-data-from-file keys)))
1934
1935 ;;;###autoload
1936 (defun epg-import-keys-from-string (context keys)
1937   "Add keys from a string KEYS."
1938   (epg--import-keys-1 context (epg-make-data-from-string keys)))
1939
1940 ;;;###autoload
1941 (defun epg-start-receive-keys (context key-id-list)
1942   "Initiate a receive key operation.
1943 KEY-ID-LIST is a list of key IDs.
1944
1945 If you use this function, you will need to wait for the completion of
1946 `epg-gpg-program' by using `epg-wait-for-completion' and call
1947 `epg-reset' to clear a temporaly output file.
1948 If you are unsure, use synchronous version of this function
1949 `epg-generate-key-from-file' or `epg-generate-key-from-string' instead."
1950   (epg-context-set-operation context 'receive-keys)
1951   (epg-context-set-result context nil)
1952   (epg--start context (cons "--recv-keys" key-id-list)))
1953
1954 ;;;###autoload
1955 (defun epg-receive-keys (context keys)
1956   "Add keys from server.
1957 KEYS is a list of key IDs"
1958   (unwind-protect
1959       (progn
1960         (epg-start-receive-keys context keys)
1961         (epg-wait-for-completion context)
1962         (if (epg-context-result-for context 'error)
1963             (error "Receive keys failed: %S"
1964                    (epg-context-result-for context 'error))))
1965     (epg-reset context)))
1966
1967 ;;;###autoload
1968 (defalias 'epg-import-keys-from-server 'epg-receive-keys)
1969
1970 ;;;###autoload
1971 (defun epg-start-delete-keys (context keys &optional allow-secret)
1972   "Initiate an delete keys operation.
1973
1974 If you use this function, you will need to wait for the completion of
1975 `epg-gpg-program' by using `epg-wait-for-completion' and call
1976 `epg-reset' to clear a temporaly output file.
1977 If you are unsure, use synchronous version of this function
1978 `epg-delete-keys' instead."
1979   (epg-context-set-operation context 'delete-keys)
1980   (epg-context-set-result context nil)
1981   (epg--start context (cons (if allow-secret
1982                                "--delete-secret-key"
1983                              "--delete-key")
1984                            (mapcar
1985                             (lambda (key)
1986                               (epg-sub-key-id
1987                                (car (epg-key-sub-key-list key))))
1988                             keys))))
1989
1990 ;;;###autoload
1991 (defun epg-delete-keys (context keys &optional allow-secret)
1992   "Delete KEYS from the key ring."
1993   (unwind-protect
1994       (progn
1995         (epg-start-delete-keys context keys allow-secret)
1996         (epg-wait-for-completion context)
1997         (if (epg-context-result-for context 'error)
1998             (error "Delete keys failed: %S"
1999                    (epg-context-result-for context 'error))))
2000     (epg-reset context)))
2001
2002 ;;;###autoload
2003 (defun epg-start-sign-keys (context keys &optional local)
2004   "Initiate an sign keys operation.
2005
2006 If you use this function, you will need to wait for the completion of
2007 `epg-gpg-program' by using `epg-wait-for-completion' and call
2008 `epg-reset' to clear a temporaly output file.
2009 If you are unsure, use synchronous version of this function
2010 `epg-sign-keys' instead."
2011   (epg-context-set-operation context 'sign-keys)
2012   (epg-context-set-result context nil)
2013   (epg--start context (cons (if local
2014                                "--lsign-key"
2015                              "--sign-key")
2016                            (mapcar
2017                             (lambda (key)
2018                               (epg-sub-key-id
2019                                (car (epg-key-sub-key-list key))))
2020                             keys))))
2021
2022 ;;;###autoload
2023 (defun epg-sign-keys (context keys &optional local)
2024   "Sign KEYS from the key ring."
2025   (unwind-protect
2026       (progn
2027         (epg-start-sign-keys context keys local)
2028         (epg-wait-for-completion context)
2029         (if (epg-context-result-for context 'error)
2030             (error "Sign keys failed: %S"
2031                    (epg-context-result-for context 'error))))
2032     (epg-reset context)))
2033
2034 ;;;###autoload
2035 (defun epg-start-generate-key (context parameters)
2036   "Initiate a key generation.
2037 PARAMETERS specifies parameters for the key.
2038
2039 If you use this function, you will need to wait for the completion of
2040 `epg-gpg-program' by using `epg-wait-for-completion' and call
2041 `epg-reset' to clear a temporaly output file.
2042 If you are unsure, use synchronous version of this function
2043 `epg-generate-key-from-file' or `epg-generate-key-from-string' instead."
2044   (epg-context-set-operation context 'generate-key)
2045   (epg-context-set-result context nil)
2046   (if (epg-data-file parameters)
2047       (epg--start context (list "--batch" "--genkey"
2048                                (epg-data-file parameters)))
2049     (epg--start context '("--batch" "--genkey"))
2050     (if (eq (process-status (epg-context-process context)) 'run)
2051         (process-send-string (epg-context-process context)
2052                              (epg-data-string parameters)))
2053     (if (eq (process-status (epg-context-process context)) 'run)
2054         (process-send-eof (epg-context-process context)))))
2055
2056 ;;;###autoload
2057 (defun epg-generate-key-from-file (context parameters)
2058   "Generate a new key pair.
2059 PARAMETERS is a file which tells how to create the key."
2060   (unwind-protect
2061       (progn
2062         (epg-start-generate-key context (epg-make-data-from-file parameters))
2063         (epg-wait-for-completion context)
2064         (if (epg-context-result-for context 'error)
2065             (error "Generate key failed: %S"
2066                    (epg-context-result-for context 'error))))
2067     (epg-reset context)))
2068
2069 ;;;###autoload
2070 (defun epg-generate-key-from-string (context parameters)
2071   "Generate a new key pair.
2072 PARAMETERS is a string which tells how to create the key."
2073   (unwind-protect
2074       (progn
2075         (epg-start-generate-key context (epg-make-data-from-string parameters))
2076         (epg-wait-for-completion context)
2077         (if (epg-context-result-for context 'error)
2078             (error "Generate key failed: %S"
2079                    (epg-context-result-for context 'error))))
2080     (epg-reset context)))
2081
2082 (defun epg--decode-hexstring (string)
2083   (let ((index 0))
2084     (while (eq index (string-match "[0-9A-Fa-f][0-9A-Fa-f]" string index))
2085       (setq string (replace-match "\\x\\&" t nil string)
2086             index (+ index 4)))
2087     (car (read-from-string (concat "\"" string "\"")))))
2088
2089 (defun epg--decode-quotedstring (string)
2090   (let ((index 0))
2091     (while (string-match "\\\\\\(\\([,=+<>#;\\\"]\\)\\|\
2092 \\([0-9A-Fa-f][0-9A-Fa-f]\\)\\|\\(.\\)\\)"
2093                          string index)
2094       (if (match-beginning 2)
2095           (setq string (replace-match "\\2" t nil string)
2096                 index (1+ index))
2097         (if (match-beginning 3)
2098             (setq string (replace-match "\\x\\3" t nil string)
2099                   index (+ index 4))
2100           (setq string (replace-match "\\\\\\\\\\4" t nil string)
2101                 index (+ index 3)))))
2102     (car (read-from-string (concat "\"" string "\"")))))
2103
2104 (defun epg-dn-from-string (string)
2105   "Parse STRING as LADPv3 Distinguished Names (RFC2253).
2106 The return value is an alist mapping from types to values."
2107   (let ((index 0)
2108         (length (length string))
2109         alist type value group)
2110     (while (< index length)
2111       (if (eq index (string-match "[ \t\n\r]*" string index))
2112           (setq index (match-end 0)))
2113       (if (eq index (string-match
2114                      "\\([0-9]+\\(\\.[0-9]+\\)*\\)\[ \t\n\r]*=[ \t\n\r]*"
2115                      string index))
2116           (setq type (match-string 1 string)
2117                 index (match-end 0))
2118         (if (eq index (string-match "\\([0-9A-Za-z]+\\)[ \t\n\r]*=[ \t\n\r]*"
2119                                     string index))
2120             (setq type (match-string 1 string)
2121                   index (match-end 0))))
2122       (unless type
2123         (error "Invalid type"))
2124       (if (eq index (string-match
2125                      "\\([^,=+<>#;\\\"]\\|\\\\.\\)+"
2126                      string index))
2127           (setq index (match-end 0)
2128                 value (epg--decode-quotedstring (match-string 0 string)))
2129         (if (eq index (string-match "#\\([0-9A-Fa-f]+\\)" string index))
2130             (setq index (match-end 0)
2131                   value (epg--decode-hexstring (match-string 1 string)))
2132           (if (eq index (string-match "\"\\([^\\\"]\\|\\\\.\\)*\""
2133                                       string index))
2134               (setq index (match-end 0)
2135                     value (epg--decode-quotedstring
2136                            (match-string 0 string))))))
2137       (if group
2138           (if (stringp (car (car alist)))
2139               (setcar alist (list (cons type value) (car alist)))
2140             (setcar alist (cons (cons type value) (car alist))))
2141         (if (consp (car (car alist)))
2142             (setcar alist (nreverse (car alist))))
2143         (setq alist (cons (cons type value) alist)
2144               type nil
2145               value nil))
2146       (if (eq index (string-match "[ \t\n\r]*\\([,;+]\\)" string index))
2147           (setq index (match-end 0)
2148                 group (eq (aref string (match-beginning 1)) ?+))))
2149     (nreverse alist)))
2150
2151 (defun epg-decode-dn (alist)
2152   "Convert ALIST returned by `epg-dn-from-string' to a human readable form.
2153 Type names are resolved using `epg-dn-type-alist'."
2154   (mapconcat
2155    (lambda (rdn)
2156      (if (stringp (car rdn))
2157          (let ((entry (assoc (car rdn) epg-dn-type-alist)))
2158            (if entry
2159                (format "%s=%s" (cdr entry) (cdr rdn))
2160              (format "%s=%s" (car rdn) (cdr rdn))))
2161        (concat "(" (epg-decode-dn rdn) ")")))
2162    alist
2163    ", "))
2164
2165 (provide 'epg)
2166
2167 ;;; epg.el ends here