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