epg.el

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