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