epg.el

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