epg.el

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