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 (defconst epg-version-number "0.0.0")
  37
  38 (defvar epg-user-id nil
  39   "GnuPG ID of your default identity.")
  40
  41 (defvar epg-user-id-alist nil
  42   "An alist mapping from key ID to user ID.")
  43
  44 (defvar epg-read-point nil)
  45 (defvar epg-pending-status-list nil)
  46 (defvar epg-key-id nil)
  47 (defvar epg-context nil)
  48 (defvar epg-debug nil)
  49 (defvar epg-debug-buffer nil)
  50
  51 ;; from gnupg/include/cipher.h
  52 (defconst epg-cipher-algorithm-alist
  53   '((0 . "NONE")
  54     (1 . "IDEA")
  55     (2 . "3DES")
  56     (3 . "CAST5")
  57     (4 . "BLOWFISH")
  58     (7 . "AES")
  59     (8 . "AES192")
  60     (9 . "AES256")
  61     (10 . "TWOFISH")
  62     (110 . "DUMMY")))
  63
  64 ;; from gnupg/include/cipher.h
  65 (defconst epg-pubkey-algorithm-alist
  66   '((1 . "RSA")
  67     (2 . "RSA_E")
  68     (3 . "RSA_S")
  69     (16 . "ELGAMAL_E")
  70     (17 . "DSA")
  71     (20 . "ELGAMAL")))
  72
  73 ;; from gnupg/include/cipher.h
  74 (defconst epg-digest-algorithm-alist
  75   '((1 . "MD5")
  76     (2 . "SHA1")
  77     (3 . "RMD160")
  78     (8 . "SHA256")
  79     (9 . "SHA384")
  80     (10 . "SHA512")))
  81
  82 ;; from gnupg/include/cipher.h
  83 (defconst epg-compress-algorithm-alist
  84   '((0 . "NONE")
  85     (1 . "ZIP")
  86     (2 . "ZLIB")
  87     (3 . "BZIP2")))
  88
  89 (defconst epg-invalid-recipients-alist
  90   '((0 . "No specific reason given")
  91     (1 . "Not Found")
  92     (2 . "Ambigious specification")
  93     (3 . "Wrong key usage")
  94     (4 . "Key revoked")
  95     (5 . "Key expired")
  96     (6 . "No CRL known")
  97     (7 . "CRL too old")
  98     (8 . "Policy mismatch")
  99     (9 . "Not a secret key")
 100     (10 . "Key not trusted")))
 101
 102 (defconst epg-delete-problem-alist
 103   '((1 . "No such key")
 104     (2 . "Must delete secret key first")
 105     (3 . "Ambigious specification")))
 106
 107 (defvar epg-key-validity-alist
 108   '((?o . unknown)
 109     (?i . invalid)
 110     (?d . disabled)
 111     (?r . revoked)
 112     (?e . expired)
 113     (?- . none)
 114     (?q . undefined)
 115     (?n . never)
 116     (?m . marginal)
 117     (?f . full)
 118     (?u . ultimate)))
 119
 120 (defvar epg-key-capablity-alist
 121   '((?e . encrypt)
 122     (?s . sign)
 123     (?c . certify)
 124     (?a . authentication)))
 125
 126 (defvar epg-prompt-alist nil)
 127
 128 (defun epg-make-data-from-file (file)
 129   "Make a data object from FILE."
 130   (vector file nil))
 131
 132 (defun epg-make-data-from-string (string)
 133   "Make a data object from STRING."
 134   (vector nil string))
 135
 136 (defun epg-data-file (data)
 137   "Return the file of DATA."
 138   (aref data 0))
 139
 140 (defun epg-data-string (data)
 141   "Return the string of DATA."
 142   (aref data 1))
 143
 144 (defun epg-make-context (&optional protocol armor textmode include-certs
 145                                    cipher-algorithm digest-algorithm
 146                                    compress-algorithm)
 147   "Return a context object."
 148   (vector protocol armor textmode include-certs
 149           cipher-algorithm digest-algorithm compress-algorithm
 150           #'epg-passphrase-callback-function
 151           #'epg-progress-callback-function
 152           nil nil nil nil))
 153
 154 (defun epg-context-protocol (context)
 155   "Return the protocol used within CONTEXT."
 156   (aref context 0))
 157
 158 (defun epg-context-armor (context)
 159   "Return t if the output shouled be ASCII armored in CONTEXT."
 160   (aref context 1))
 161
 162 (defun epg-context-textmode (context)
 163   "Return t if canonical text mode should be used in CONTEXT."
 164   (aref context 2))
 165
 166 (defun epg-context-include-certs (context)
 167   "Return how many certificates should be included in an S/MIME signed
 168 message."
 169   (aref context 3))
 170
 171 (defun epg-context-cipher-algorithm (context)
 172   "Return the cipher algorithm in CONTEXT."
 173   (aref context 4))
 174
 175 (defun epg-context-digest-algorithm (context)
 176   "Return the digest algorithm in CONTEXT."
 177   (aref context 5))
 178
 179 (defun epg-context-compress-algorithm (context)
 180   "Return the compress algorithm in CONTEXT."
 181   (aref context 6))
 182
 183 (defun epg-context-passphrase-callback (context)
 184   "Return the function used to query passphrase."
 185   (aref context 7))
 186
 187 (defun epg-context-progress-callback (context)
 188   "Return the function which handles progress update."
 189   (aref context 8))
 190
 191 (defun epg-context-signers (context)
 192   "Return the list of key-id for singning."
 193   (aref context 9))
 194
 195 (defun epg-context-process (context)
 196   "Return the process object of `epg-gpg-program'.
 197 This function is for internal use only."
 198   (aref context 10))
 199
 200 (defun epg-context-output-file (context)
 201   "Return the output file of `epg-gpg-program'.
 202 This function is for internal use only."
 203   (aref context 11))
 204
 205 (defun epg-context-result (context)
 206   "Return the result of the previous cryptographic operation."
 207   (aref context 12))
 208
 209 (defun epg-context-set-protocol (context protocol)
 210   "Set the protocol used within CONTEXT."
 211   (aset context 0 protocol))
 212
 213 (defun epg-context-set-armor (context armor)
 214   "Specify if the output shouled be ASCII armored in CONTEXT."
 215   (aset context 1 armor))
 216
 217 (defun epg-context-set-textmode (context textmode)
 218   "Specify if canonical text mode should be used in CONTEXT."
 219   (aset context 2 textmode))
 220
 221 (defun epg-context-set-include-certs (context include-certs)
 222  "Set how many certificates should be included in an S/MIME signed message."
 223   (aset context 3 include-certs))
 224
 225 (defun epg-context-set-cipher-algorithm (context cipher-algorithm)
 226  "Set the cipher algorithm in CONTEXT."
 227   (aset context 4 cipher-algorithm))
 228
 229 (defun epg-context-set-digest-algorithm (context digest-algorithm)
 230  "Set the digest algorithm in CONTEXT."
 231   (aset context 5 digest-algorithm))
 232
 233 (defun epg-context-set-compress-algorithm (context compress-algorithm)
 234  "Set the compress algorithm in CONTEXT."
 235   (aset context 6 compress-algorithm))
 236
 237 (defun epg-context-set-passphrase-callback (context
 238                                                  passphrase-callback)
 239   "Set the function used to query passphrase."
 240   (aset context 7 passphrase-callback))
 241
 242 (defun epg-context-set-progress-callback (context progress-callback)
 243   "Set the function which handles progress update."
 244   (aset context 8 progress-callback))
 245
 246 (defun epg-context-set-signers (context signers)
 247  "Set the list of key-id for singning."
 248   (aset context 9 signers))
 249
 250 (defun epg-context-set-process (context process)
 251   "Set the process object of `epg-gpg-program'.
 252 This function is for internal use only."
 253   (aset context 10 process))
 254
 255 (defun epg-context-set-output-file (context output-file)
 256   "Set the output file of `epg-gpg-program'.
 257 This function is for internal use only."
 258   (aset context 11 output-file))
 259
 260 (defun epg-context-set-result (context result)
 261   "Set the result of the previous cryptographic operation."
 262   (aset context 12 result))
 263
 264 (defun epg-make-signature (status key-id user-id)
 265   "Return a signature object."
 266   (vector status key-id user-id nil nil))
 267
 268 (defun epg-signature-status (signature)
 269   "Return the status code of SIGNATURE."
 270   (aref signature 0))
 271
 272 (defun epg-signature-key-id (signature)
 273   "Return the key-id of SIGNATURE."
 274   (aref signature 1))
 275
 276 (defun epg-signature-user-id (signature)
 277   "Return the user-id of SIGNATURE."
 278   (aref signature 2))
 279
 280 (defun epg-signature-validity (signature)
 281   "Return the validity of SIGNATURE."
 282   (aref signature 3))
 283
 284 (defun epg-signature-fingerprint (signature)
 285   "Return the fingerprint of SIGNATURE."
 286   (aref signature 4))
 287
 288 (defun epg-signature-set-status (signature status)
 289  "Set the status code of SIGNATURE."
 290   (aset signature 0 status))
 291
 292 (defun epg-signature-set-key-id (signature key-id)
 293  "Set the key-id of SIGNATURE."
 294   (aset signature 1 key-id))
 295
 296 (defun epg-signature-set-user-id (signature user-id)
 297  "Set the user-id of SIGNATURE."
 298   (aset signature 2 user-id))
 299
 300 (defun epg-signature-set-validity (signature validity)
 301  "Set the validity of SIGNATURE."
 302   (aset signature 3 validity))
 303
 304 (defun epg-signature-set-fingerprint (signature fingerprint)
 305  "Set the fingerprint of SIGNATURE."
 306   (aset signature 4 fingerprint))
 307
 308 (defun epg-make-key (owner-trust)
 309   "Return a key object."
 310   (vector owner-trust nil nil))
 311
 312 (defun epg-key-owner-trust (key)
 313   "Return the owner trust of KEY."
 314   (aref key 0))
 315
 316 (defun epg-key-sub-key-list (key)
 317   "Return the sub key list of KEY."
 318   (aref key 1))
 319
 320 (defun epg-key-user-id-list (key)
 321   "Return the user ID list of KEY."
 322   (aref key 2))
 323
 324 (defun epg-key-set-sub-key-list (key sub-key-list)
 325   "Set the sub key list of KEY."
 326   (aset key 1 sub-key-list))
 327
 328 (defun epg-key-set-user-id-list (key user-id-list)
 329   "Set the user ID list of KEY."
 330   (aset key 2 user-id-list))
 331
 332 (defun epg-make-sub-key (validity capability secret algorithm length id
 333                                   creation-time expiration-time)
 334   "Return a sub key object."
 335   (vector validity capability secret algorithm length id creation-time
 336           expiration-time nil))
 337
 338 (defun epg-sub-key-validity (sub-key)
 339   "Return the validity of SUB-KEY."
 340   (aref sub-key 0))
 341
 342 (defun epg-sub-key-capability (sub-key)
 343   "Return the capability of SUB-KEY."
 344   (aref sub-key 1))
 345
 346 (defun epg-sub-key-secret (sub-key)
 347   "Return non-nil if SUB-KEY is a secret key."
 348   (aref sub-key 2))
 349
 350 (defun epg-sub-key-algorithm (sub-key)
 351   "Return the algorithm of SUB-KEY."
 352   (aref sub-key 3))
 353
 354 (defun epg-sub-key-length (sub-key)
 355   "Return the length of SUB-KEY."
 356   (aref sub-key 4))
 357
 358 (defun epg-sub-key-id (sub-key)
 359   "Return the ID of SUB-KEY."
 360   (aref sub-key 5))
 361
 362 (defun epg-sub-key-creation-time (sub-key)
 363   "Return the creation time of SUB-KEY."
 364   (aref sub-key 6))
 365
 366 (defun epg-sub-key-expiration-time (sub-key)
 367   "Return the expiration time of SUB-KEY."
 368   (aref sub-key 7))
 369
 370 (defun epg-sub-key-fingerprint (sub-key)
 371   "Return the fingerprint of SUB-KEY."
 372   (aref sub-key 8))
 373
 374 (defun epg-sub-key-set-fingerprint (sub-key fingerprint)
 375   "Set the fingerprint of SUB-KEY.
 376 This function is for internal use only."
 377   (aset sub-key 8 fingerprint))
 378
 379 (defun epg-make-user-id (validity name)
 380   "Return a user ID object."
 381   (vector validity name nil))
 382
 383 (defun epg-user-id-validity (user-id)
 384   "Return the validity of USER-ID."
 385   (aref user-id 0))
 386
 387 (defun epg-user-id-name (user-id)
 388   "Return the name of USER-ID."
 389   (aref user-id 1))
 390
 391 (defun epg-user-id-signature-list (user-id)
 392   "Return the signature list of USER-ID."
 393   (aref user-id 2))
 394
 395 (defun epg-user-id-set-signature-list (user-id signature-list)
 396   "Set the signature list of USER-ID."
 397   (aset user-id 2 signature-list))
 398
 399 (defun epg-context-result-for (context name)
 400   (cdr (assq name (epg-context-result context))))
 401
 402 (defun epg-context-set-result-for (context name value)
 403   (let* ((result (epg-context-result context))
 404          (entry (assq name result)))
 405     (if entry
 406         (setcdr entry value)
 407       (epg-context-set-result context (cons (cons name value) result)))))
 408
 409 (defun epg-signature-to-string (signature)
 410   (format "%s signature from %s %s%s"
 411           (capitalize (symbol-name (epg-signature-status signature)))
 412           (epg-signature-key-id signature)
 413           (epg-signature-user-id signature)
 414           (if (epg-signature-validity signature)
 415               (format " (trust %s)"
 416                       (epg-signature-validity signature))
 417             "")))
 418
 419 (defun epg-verify-result-to-string (verify-result)
 420   (mapconcat #'epg-signature-to-string (reverse verify-result) "\n"))
 421
 422 (defun epg-start (context args)
 423   "Start `epg-gpg-program' in a subprocess with given ARGS."
 424   (let* ((args (append (list "--no-tty"
 425                              "--status-fd" "1"
 426                              "--command-fd" "0"
 427                              "--yes")
 428                        (if (epg-context-armor context) '("--armor"))
 429                        (if (epg-context-textmode context) '("--textmode"))
 430                        (if (epg-context-output-file context)
 431                            (list "--output" (epg-context-output-file context)))
 432                        args))
 433          (coding-system-for-write 'binary)
 434          process-connection-type
 435          (orig-mode (default-file-modes))
 436          (buffer (generate-new-buffer " *epg*"))
 437          process)
 438     (if epg-debug
 439         (save-excursion
 440           (unless epg-debug-buffer
 441             (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
 442           (set-buffer epg-debug-buffer)
 443           (goto-char (point-max))
 444           (insert (format "%s %s\n" epg-gpg-program
 445                           (mapconcat #'identity args " ")))))
 446     (with-current-buffer buffer
 447       (make-local-variable 'epg-read-point)
 448       (setq epg-read-point (point-min))
 449       (make-local-variable 'epg-pending-status-list)
 450       (setq epg-pending-status-list nil)
 451       (make-local-variable 'epg-key-id)
 452       (setq epg-key-id nil)
 453       (make-local-variable 'epg-context)
 454       (setq epg-context context))
 455     (unwind-protect
 456         (progn
 457           (set-default-file-modes 448)
 458           (setq process
 459                 (apply #'start-process "epg" buffer epg-gpg-program args)))
 460       (set-default-file-modes orig-mode))
 461     (set-process-filter process #'epg-process-filter)
 462     (epg-context-set-process context process)))
 463
 464 (defun epg-process-filter (process input)
 465   (if epg-debug
 466       (save-excursion
 467         (unless epg-debug-buffer
 468           (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
 469         (set-buffer epg-debug-buffer)
 470         (goto-char (point-max))
 471         (insert input)))
 472   (if (buffer-live-p (process-buffer process))
 473       (save-excursion
 474         (set-buffer (process-buffer process))
 475         (goto-char (point-max))
 476         (insert input)
 477         (goto-char epg-read-point)
 478         (beginning-of-line)
 479         (while (looking-at ".*\n")      ;the input line finished
 480           (save-excursion
 481             (if (looking-at "\\[GNUPG:] \\([A-Z_]+\\) ?\\(.*\\)")
 482                 (let* ((status (match-string 1))
 483                        (string (match-string 2))
 484                        (symbol (intern-soft (concat "epg-status-" status))))
 485                   (if (member status epg-pending-status-list)
 486                       (setq epg-pending-status-list nil))
 487                   (if (and symbol
 488                            (fboundp symbol))
 489                       (funcall symbol process string)))))
 490           (forward-line))
 491         (setq epg-read-point (point)))))
 492
 493 (defun epg-read-output (context)
 494   (with-temp-buffer
 495     (if (fboundp 'set-buffer-multibyte)
 496         (set-buffer-multibyte nil))
 497     (if (file-exists-p (epg-context-output-file context))
 498         (let ((coding-system-for-read (if (epg-context-textmode context)
 499                                           'raw-text
 500                                         'binary)))
 501           (insert-file-contents (epg-context-output-file context))
 502           (buffer-string)))))
 503
 504 (defun epg-wait-for-status (context status-list)
 505   (with-current-buffer (process-buffer (epg-context-process context))
 506     (setq epg-pending-status-list status-list)
 507     (while (and (eq (process-status (epg-context-process context)) 'run)
 508                 epg-pending-status-list)
 509       (accept-process-output (epg-context-process context) 1))))
 510
 511 (defun epg-wait-for-completion (context)
 512   (while (eq (process-status (epg-context-process context)) 'run)
 513     ;; We can't use accept-process-output instead of sit-for here
 514     ;; because it may cause an interrupt during the sentinel execution.
 515     (sit-for 0.1)))
 516
 517 (defun epg-flush (context)
 518   (if (eq (process-status (epg-context-process context)) 'run)
 519       (process-send-eof (epg-context-process context))))
 520
 521 (defun epg-reset (context)
 522   (if (and (epg-context-process context)
 523            (buffer-live-p (process-buffer (epg-context-process context))))
 524       (kill-buffer (process-buffer (epg-context-process context))))
 525   (epg-context-set-process context nil))
 526
 527 (defun epg-delete-output-file (context)
 528   (if (and (epg-context-output-file context)
 529            (file-exists-p (epg-context-output-file context)))
 530       (delete-file (epg-context-output-file context))))
 531
 532 (defun epg-status-USERID_HINT (process string)
 533   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
 534       (let* ((key-id (match-string 1 string))
 535              (user-id (match-string 2 string))
 536              (entry (assoc key-id epg-user-id-alist)))
 537         (if entry
 538             (setcdr entry user-id)
 539           (setq epg-user-id-alist (cons (cons key-id user-id)
 540                                         epg-user-id-alist))))))
 541
 542 (defun epg-status-NEED_PASSPHRASE (process string)
 543   (if (string-match "\\`\\([^ ]+\\)" string)
 544       (setq epg-key-id (match-string 1 string))))
 545
 546 (defun epg-status-NEED_PASSPHRASE_SYM (process string)
 547   (setq epg-key-id 'SYM))
 548
 549 (defun epg-status-NEED_PASSPHRASE_PIN (process string)
 550   (setq epg-key-id 'PIN))
 551
 552 (defun epg-status-GET_HIDDEN (process string)
 553   (if (and epg-key-id
 554            (string-match "\\`passphrase\\." string))
 555     (let ((passphrase
 556            (funcall
 557             (if (consp (epg-context-passphrase-callback epg-context))
 558                 (car (epg-context-passphrase-callback epg-context))
 559               (epg-context-passphrase-callback epg-context))
 560             epg-key-id
 561             (if (consp (epg-context-passphrase-callback epg-context))
 562                 (cdr (epg-context-passphrase-callback epg-context)))))
 563           string)
 564       (if passphrase
 565           (unwind-protect
 566               (progn
 567                 (setq string (concat passphrase "\n"))
 568                 (fillarray passphrase 0)
 569                 (setq passphrase nil)
 570                 (process-send-string process string))
 571             (if string
 572                 (fillarray string 0)))))))
 573
 574 (defun epg-status-GET_BOOL (process string)
 575   (let ((entry (assoc string epg-prompt-alist)))
 576     (if (y-or-n-p (if entry (cdr entry) (concat string "? ")))
 577         (process-send-string process "y\n")
 578       (process-send-string process "n\n"))))
 579
 580 (defun epg-status-GET_LINE (process string)
 581   (let* ((entry (assoc string epg-prompt-alist))
 582          (string (read-string (if entry (cdr entry) (concat string ": ")))))
 583     (process-send-string process (concat string "\n"))))
 584
 585 (defun epg-status-GOODSIG (process string)
 586   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
 587       (epg-context-set-result-for
 588        epg-context
 589        'verify
 590        (cons (epg-make-signature 'good
 591                                  (match-string 1 string)
 592                                  (match-string 2 string))
 593              (epg-context-result-for epg-context 'verify)))))
 594
 595 (defun epg-status-EXPSIG (process string)
 596   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
 597       (epg-context-set-result-for
 598        epg-context
 599        'verify
 600        (cons (epg-make-signature 'expired
 601                                  (match-string 1 string)
 602                                  (match-string 2 string))
 603              (epg-context-result-for epg-context 'verify)))))
 604
 605 (defun epg-status-EXPKEYSIG (process string)
 606   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
 607       (epg-context-set-result-for
 608        epg-context
 609        'verify
 610        (cons (epg-make-signature 'expired-key
 611                                  (match-string 1 string)
 612                                  (match-string 2 string))
 613              (epg-context-result-for epg-context 'verify)))))
 614
 615 (defun epg-status-REVKEYSIG (process string)
 616   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
 617       (epg-context-set-result-for
 618        epg-context
 619        'verify
 620        (cons (epg-make-signature 'revoked-key
 621                                  (match-string 1 string)
 622                                  (match-string 2 string))
 623              (epg-context-result-for epg-context 'verify)))))
 624
 625 (defun epg-status-BADSIG (process string)
 626   (if (string-match "\\`\\([^ ]+\\) \\(.*\\)" string)
 627       (epg-context-set-result-for
 628        epg-context
 629        'verify
 630        (cons (epg-make-signature 'bad
 631                                  (match-string 1 string)
 632                                  (match-string 2 string))
 633              (epg-context-result-for epg-context 'verify)))))
 634
 635 (defun epg-status-VALIDSIG (process string)
 636   (let ((signature (car (epg-context-result-for epg-context 'verify))))
 637     (if (and signature
 638              (eq (epg-signature-status signature) 'good)
 639              (string-match "\\`\\([^ ]+\\) " string))
 640         (epg-signature-set-fingerprint signature (match-string 1 string)))))
 641
 642 (defun epg-status-TRUST_UNDEFINED (process string)
 643   (let ((signature (car (epg-context-result-for epg-context 'verify))))
 644     (if (and signature
 645              (eq (epg-signature-status signature) 'good))
 646         (epg-signature-set-validity signature 'undefined))))
 647
 648 (defun epg-status-TRUST_NEVER (process string)
 649   (let ((signature (car (epg-context-result-for epg-context 'verify))))
 650     (if (and signature
 651              (eq (epg-signature-status signature) 'good))
 652         (epg-signature-set-validity signature 'never))))
 653
 654 (defun epg-status-TRUST_MARGINAL (process string)
 655   (let ((signature (car (epg-context-result-for epg-context 'verify))))
 656     (if (and signature
 657              (eq (epg-signature-status signature) 'marginal))
 658         (epg-signature-set-validity signature 'marginal))))
 659
 660 (defun epg-status-TRUST_FULLY (process string)
 661   (let ((signature (car (epg-context-result-for epg-context 'verify))))
 662     (if (and signature
 663              (eq (epg-signature-status signature) 'good))
 664         (epg-signature-set-validity signature 'full))))
 665
 666 (defun epg-status-TRUST_ULTIMATE (process string)
 667   (let ((signature (car (epg-context-result-for epg-context 'verify))))
 668     (if (and signature
 669              (eq (epg-signature-status signature) 'good))
 670         (epg-signature-set-validity signature 'ultimate))))
 671
 672 (defun epg-status-PROGRESS (process string)
 673   (if (string-match "\\`\\([^ ]+\\) \\([^ ]\\) \\([0-9]+\\) \\([0-9]+\\)"
 674                     string)
 675       (funcall (if (consp (epg-context-progress-callback epg-context))
 676                    (car (epg-context-progress-callback epg-context))
 677                  (epg-context-progress-callback epg-context))
 678                (match-string 1 string)
 679                (match-string 2 string)
 680                (string-to-number (match-string 3 string))
 681                (string-to-number (match-string 4 string))
 682                (if (consp (epg-context-progress-callback epg-context))
 683                    (cdr (epg-context-progress-callback epg-context))))))
 684
 685 (defun epg-status-DECRYPTION_FAILED (process string)
 686   (epg-context-set-result-for
 687    epg-context 'error
 688    (cons 'decryption-failed
 689          (epg-context-result-for epg-context 'error))))
 690
 691 (defun epg-status-NODATA (process string)
 692   (epg-context-set-result-for
 693    epg-context 'error
 694    (cons (cons 'no-data (string-to-number string))
 695          (epg-context-result-for epg-context 'error))))
 696
 697 (defun epg-status-UNEXPECTED (process string)
 698   (epg-context-set-result-for
 699    epg-context 'error
 700    (cons (cons 'unexpected (string-to-number string))
 701          (epg-context-result-for epg-context 'error))))
 702
 703 (defun epg-status-KEYEXPIRED (process string)
 704   (epg-context-set-result-for
 705    epg-context 'error
 706    (cons (cons 'key-expired string)
 707          (epg-context-result-for epg-context 'error))))
 708
 709 (defun epg-status-KEYREVOKED (process string)
 710   (epg-context-set-result-for
 711    epg-context 'error
 712    (cons 'key-revoked
 713          (epg-context-result-for epg-context 'error))))
 714
 715 (defun epg-status-BADARMOR (process string)
 716   (epg-context-set-result-for
 717    epg-context 'error
 718    (cons 'bad-armor
 719          (epg-context-result-for epg-context 'error))))
 720
 721 (defun epg-status-INV_RECP (process string)
 722   (if (string-match "\\`\\([0-9]+\\) \\(.*\\)" string)
 723       (epg-context-set-result-for
 724        epg-context 'error
 725        (cons (list 'invalid-recipient
 726                    (string-to-number (match-string 1 string))
 727                    (match-string 2 string))
 728              (epg-context-result-for epg-context 'error)))))
 729
 730 (defun epg-status-NO_RECP (process string)
 731   (epg-context-set-result-for
 732    epg-context 'error
 733    (cons 'no-recipients
 734          (epg-context-result-for epg-context 'error))))
 735
 736 (defun epg-status-DELETE_PROBLEM (process string)
 737   (if (string-match "\\`\\([0-9]+\\)" string)
 738       (epg-context-set-result-for
 739        epg-context 'error
 740        (cons (cons 'delete-problem (string-to-number (match-string 1 string)))
 741              (epg-context-result-for epg-context 'error)))))
 742
 743 (defun epg-status-SIG_CREATED (process string)
 744   (if (string-match "\\`\\([DCS]\\) \\([0-9]+\\) \\([0-9]+\\) \
 745 \\([0-9A-Fa-F][0-9A-Fa-F]\\) \\(.*\\) " string)
 746       (epg-context-set-result-for
 747        epg-context 'sign
 748        (cons (list (cons 'type (string-to-char (match-string 1 string)))
 749                    (cons 'pubkey-algorithm
 750                          (string-to-number (match-string 2 string)))
 751                    (cons 'digest-algorithm
 752                          (string-to-number (match-string 3 string)))
 753                    (cons 'class (string-to-number (match-string 4 string) 16))
 754                    (cons 'creation-time (match-string 5 string))
 755                    (cons 'fingerprint (substring string (match-end 0))))
 756              (epg-context-result-for epg-context 'sign)))))
 757
 758 (defun epg-passphrase-callback-function (key-id handback)
 759   (read-passwd
 760    (if (eq key-id 'SYM)
 761        "Passphrase for symmetric encryption: "
 762      (if (eq key-id 'PIN)
 763          "Passphrase for PIN: "
 764        (let ((entry (assoc key-id epg-user-id-alist)))
 765          (if entry
 766              (format "Passphrase for %s %s: " key-id (cdr entry))
 767            (format "Passphrase for %s: " key-id)))))))
 768
 769 (defun epg-progress-callback-function (what char current total handback)
 770   (message "%s: %d%%/%d%%" what current total))
 771
 772 (defun epg-configuration ()
 773   "Return a list of internal configuration parameters of `epg-gpg-program'."
 774   (let (config type)
 775     (with-temp-buffer
 776       (apply #'call-process epg-gpg-program nil (list t nil) nil
 777              '("--with-colons" "--list-config"))
 778       (goto-char (point-min))
 779       (while (re-search-forward "^cfg:\\([^:]+\\):\\(.*\\)" nil t)
 780         (setq type (intern (match-string 1))
 781               config (cons (cons type
 782                                  (if (memq type
 783                                            '(pubkey cipher digest compress))
 784                                      (mapcar #'string-to-number
 785                                              (delete "" (split-string
 786                                                          (match-string 2)
 787                                                          ";")))
 788                                    (match-string 2)))
 789                            config))))
 790     config))
 791
 792 (defun epg-list-keys-1 (name mode)
 793   (let ((args (append (list "--with-colons" "--no-greeting" "--batch"
 794                             "--fixed-list-mode" "--with-fingerprint"
 795                             "--with-fingerprint"
 796                             (if mode "--list-secret-keys" "--list-keys"))
 797                       (if name (list name))))
 798         keys string field index)
 799     (with-temp-buffer
 800       (apply #'call-process epg-gpg-program nil (list t nil) nil args)
 801       (goto-char (point-min))
 802       (while (re-search-forward "^[a-z][a-z][a-z]:.*" nil t)
 803         (setq keys (cons (make-vector 15 nil) keys)
 804               string (match-string 0)
 805               index 0
 806               field 0)
 807         (while (eq index
 808                    (string-match "\\([^:]+\\)?:" string index))
 809           (setq index (match-end 0))
 810           (aset (car keys) field (match-string 1 string))
 811           (setq field (1+ field))))
 812       (nreverse keys))))
 813
 814 (defun epg-make-sub-key-1 (line)
 815   (epg-make-sub-key
 816    (if (aref line 1)
 817        (cdr (assq (string-to-char (aref line 1)) epg-key-validity-alist)))
 818    (delq nil
 819          (mapcar (lambda (char) (cdr (assq char epg-key-capablity-alist)))
 820                  (aref line 11)))
 821    (member (aref line 0) '("sec" "ssb"))
 822    (string-to-number (aref line 3))
 823    (string-to-number (aref line 2))
 824    (aref line 4)
 825    (aref line 5)
 826    (aref line 6)))
 827
 828 (defun epg-list-keys (&optional name mode)
 829   (let ((lines (epg-list-keys-1 name mode))
 830         keys)
 831     (while lines
 832       (cond
 833        ((member (aref (car lines) 0) '("pub" "sec"))
 834         (when (car keys)
 835           (epg-key-set-sub-key-list
 836            (car keys)
 837            (nreverse (epg-key-sub-key-list (car keys))))
 838           (epg-key-set-user-id-list
 839            (car keys)
 840            (nreverse (epg-key-user-id-list (car keys)))))
 841         (setq keys (cons (epg-make-key
 842                           (if (aref (car lines) 8)
 843                               (cdr (assq (string-to-char (aref (car lines) 8))
 844                                          epg-key-validity-alist))))
 845                          keys))
 846         (epg-key-set-sub-key-list
 847          (car keys)
 848          (cons (epg-make-sub-key-1 (car lines))
 849                (epg-key-sub-key-list (car keys)))))
 850        ((member (aref (car lines) 0) '("sub" "ssb"))
 851         (epg-key-set-sub-key-list
 852          (car keys)
 853          (cons (epg-make-sub-key-1 (car lines))
 854                (epg-key-sub-key-list (car keys)))))
 855        ((equal (aref (car lines) 0) "uid")
 856         (epg-key-set-user-id-list
 857          (car keys)
 858          (cons (epg-make-user-id
 859                 (if (aref (car lines) 1)
 860                     (cdr (assq (string-to-char (aref (car lines) 1))
 861                                epg-key-validity-alist)))
 862                 (aref (car lines) 9))
 863                (epg-key-user-id-list (car keys)))))
 864        ((equal (aref (car lines) 0) "fpr")
 865         (epg-sub-key-set-fingerprint (car (epg-key-sub-key-list (car keys)))
 866                                      (aref (car lines) 9))))
 867       (setq lines (cdr lines)))
 868     (nreverse keys)))
 869
 870 (if (fboundp 'make-temp-file)
 871     (defalias 'epg-make-temp-file 'make-temp-file)
 872   ;; stolen from poe.el.
 873   (defun epg-make-temp-file (prefix)
 874     "Create a temporary file.
 875 The returned file name (created by appending some random characters at the end
 876 of PREFIX, and expanding against `temporary-file-directory' if necessary),
 877 is guaranteed to point to a newly created empty file.
 878 You can then use `write-region' to write new data into the file."
 879     (let (tempdir tempfile)
 880       (unwind-protect
 881           (let (file)
 882             ;; First, create a temporary directory.
 883             (while (condition-case ()
 884                        (progn
 885                          (setq tempdir (make-temp-name
 886                                         (concat
 887                                          (file-name-directory prefix)
 888                                          "DIR")))
 889                          ;; return nil or signal an error.
 890                          (make-directory tempdir))
 891                      ;; let's try again.
 892                      (file-already-exists t)))
 893             (set-file-modes tempdir 448)
 894             ;; Second, create a temporary file in the tempdir.
 895             ;; There *is* a race condition between `make-temp-name'
 896             ;; and `write-region', but we don't care it since we are
 897             ;; in a private directory now.
 898             (setq tempfile (make-temp-name (concat tempdir "/EMU")))
 899             (write-region "" nil tempfile nil 'silent)
 900             (set-file-modes tempfile 384)
 901             ;; Finally, make a hard-link from the tempfile.
 902             (while (condition-case ()
 903                        (progn
 904                          (setq file (make-temp-name prefix))
 905                          ;; return nil or signal an error.
 906                          (add-name-to-file tempfile file))
 907                      ;; let's try again.
 908                      (file-already-exists t)))
 909             file)
 910         ;; Cleanup the tempfile.
 911         (and tempfile
 912              (file-exists-p tempfile)
 913              (delete-file tempfile))
 914         ;; Cleanup the tempdir.
 915         (and tempdir
 916              (file-directory-p tempdir)
 917              (delete-directory tempdir))))))
 918
 919 ;;;###autoload
 920 (defun epg-start-decrypt (context cipher)
 921   "Initiate a decrypt operation on CIPHER.
 922 CIPHER is a data object.
 923
 924 If you use this function, you will need to wait for the completion of
 925 `epg-gpg-program' by using `epg-wait-for-completion' and call
 926 `epg-reset' to clear a temporaly output file.
 927 If you are unsure, use synchronous version of this function
 928 `epg-decrypt-file' or `epg-decrypt-string' instead."
 929   (unless (epg-data-file cipher)
 930     (error "Not a file"))
 931   (epg-context-set-result context nil)
 932   (epg-start context (list "--decrypt" (epg-data-file cipher)))
 933   (epg-wait-for-status context '("BEGIN_DECRYPTION")))
 934
 935 ;;;###autoload
 936 (defun epg-decrypt-file (context cipher plain)
 937   "Decrypt a file CIPHER and store the result to a file PLAIN.
 938 If PLAIN is nil, it returns the result as a string."
 939   (unwind-protect
 940       (progn
 941         (if plain
 942             (epg-context-set-output-file context plain)
 943           (epg-context-set-output-file context
 944                                        (epg-make-temp-file "epg-output")))
 945         (epg-start-decrypt context (epg-make-data-from-file cipher))
 946         (epg-wait-for-completion context)
 947         (if (epg-context-result-for context 'error)
 948             (error "Decrypt failed: %S"
 949                    (epg-context-result-for context 'error)))
 950         (unless plain
 951           (epg-read-output context)))
 952     (unless plain
 953       (epg-delete-output-file context))
 954     (epg-reset context)))
 955
 956 ;;;###autoload
 957 (defun epg-decrypt-string (context cipher)
 958   "Decrypt a string CIPHER and return the plain text."
 959   (let ((input-file (epg-make-temp-file "epg-input"))
 960         (coding-system-for-write 'binary))
 961     (unwind-protect
 962         (progn
 963           (write-region cipher nil input-file)
 964           (epg-context-set-output-file context
 965                                        (epg-make-temp-file "epg-output"))
 966           (epg-start-decrypt context (epg-make-data-from-file input-file))
 967           (epg-flush context)
 968           (epg-wait-for-completion context)
 969           (if (epg-context-result-for context 'error)
 970               (error "Decrypt failed: %S"
 971                      (epg-context-result-for context 'error)))
 972           (epg-read-output context))
 973       (epg-delete-output-file context)
 974       (if (file-exists-p input-file)
 975           (delete-file input-file))
 976       (epg-reset context))))
 977
 978 ;;;###autoload
 979 (defun epg-start-verify (context signature &optional signed-text)
 980   "Initiate a verify operation on SIGNATURE.
 981 SIGNATURE and SIGNED-TEXT are a data object if they are specified.
 982
 983 For a detached signature, both SIGNATURE and SIGNED-TEXT should be set.
 984 For a normal or a clear text signature, SIGNED-TEXT should be nil.
 985
 986 If you use this function, you will need to wait for the completion of
 987 `epg-gpg-program' by using `epg-wait-for-completion' and call
 988 `epg-reset' to clear a temporaly output file.
 989 If you are unsure, use synchronous version of this function
 990 `epg-verify-file' or `epg-verify-string' instead."
 991   (epg-context-set-result context nil)
 992   (if signed-text
 993       ;; Detached signature.
 994       (if (epg-data-file signed-text)
 995           (epg-start context (list "--verify" (epg-data-file signature)
 996                                    (epg-data-file signed-text)))
 997         (epg-start context (list "--verify" (epg-data-file signature) "-"))
 998         (if (eq (process-status (epg-context-process context)) 'run)
 999             (process-send-string (epg-context-process context)
1000                                  (epg-data-string signed-text))))
1001     ;; Normal (or cleartext) signature.
1002     (if (epg-data-file signature)
1003         (epg-start context (list "--verify" (epg-data-file signature)))
1004       (epg-start context (list "--verify"))
1005       (if (eq (process-status (epg-context-process context)) 'run)
1006           (process-send-string (epg-context-process context)
1007                                (epg-data-string signature))))))
1008
1009 ;;;###autoload
1010 (defun epg-verify-file (context signature &optional signed-text plain)
1011   "Verify a file SIGNATURE.
1012 SIGNED-TEXT and PLAIN are also a file if they are specified.
1013
1014 For a detached signature, both SIGNATURE and SIGNED-TEXT should be string.
1015 For a normal or a clear text signature, SIGNED-TEXT should be nil."
1016   (unwind-protect
1017       (progn
1018         (if plain
1019             (epg-context-set-output-file context plain)
1020           (epg-context-set-output-file context
1021                                        (epg-make-temp-file "epg-output")))
1022         (if signed-text
1023             (epg-start-verify context
1024                               (epg-make-data-from-file signature)
1025                               (epg-make-data-from-file signed-text))
1026           (epg-start-verify context
1027                             (epg-make-data-from-file signature)))
1028         (epg-wait-for-completion context)
1029         (unless plain
1030           (epg-read-output context)))
1031     (unless plain
1032       (epg-delete-output-file context))
1033     (epg-reset context)))
1034
1035 ;;;###autoload
1036 (defun epg-verify-string (context signature &optional signed-text)
1037   "Verify a string SIGNATURE.
1038 SIGNED-TEXT is a string if it is specified.
1039
1040 For a detached signature, both SIGNATURE and SIGNED-TEXT should be string.
1041 For a normal or a clear text signature, SIGNED-TEXT should be nil."
1042   (let ((coding-system-for-write 'binary)
1043         input-file)
1044     (unwind-protect
1045         (progn
1046           (epg-context-set-output-file context
1047                                        (epg-make-temp-file "epg-output"))
1048           (if signed-text
1049               (progn
1050                 (setq input-file (epg-make-temp-file "epg-signature"))
1051                 (write-region signature nil input-file)
1052                 (epg-start-verify context
1053                                   (epg-make-data-from-file input-file)
1054                                   (epg-make-data-from-string signed-text)))
1055             (epg-start-verify context (epg-make-data-from-string signature)))
1056           (epg-flush context)
1057           (epg-wait-for-completion context)
1058           (epg-read-output context))
1059       (epg-delete-output-file context)
1060       (if (and input-file
1061                (file-exists-p input-file))
1062           (delete-file input-file))
1063       (epg-reset context))))
1064
1065 ;;;###autoload
1066 (defun epg-start-sign (context plain &optional mode)
1067   "Initiate a sign operation on PLAIN.
1068 PLAIN is a data object.
1069
1070 If optional 3rd argument MODE is 'clearsign, it makes a clear text signature.
1071 If MODE is t or 'detached, it makes a detached signature.
1072 Otherwise, it makes a normal signature.
1073
1074 If you use this function, you will need to wait for the completion of
1075 `epg-gpg-program' by using `epg-wait-for-completion' and call
1076 `epg-reset' to clear a temporaly output file.
1077 If you are unsure, use synchronous version of this function
1078 `epg-sign-file' or `epg-sign-string' instead."
1079   (epg-context-set-result context nil)
1080   (epg-start context
1081              (append (list (if (eq mode 'clearsign)
1082                                "--clearsign"
1083                              (if (or (eq mode t) (eq mode 'detached))
1084                                  "--detach-sign"
1085                                "--sign")))
1086                      (apply #'nconc
1087                             (mapcar
1088                              (lambda (signer)
1089                                (list "-u"
1090                                      (epg-sub-key-id
1091                                       (car (epg-key-sub-key-list signer)))))
1092                              (epg-context-signers context)))
1093                      (if (epg-data-file plain)
1094                          (list (epg-data-file plain)))))
1095   (epg-wait-for-status context '("BEGIN_SIGNING"))
1096   (if (and (epg-data-string plain)
1097            (eq (process-status (epg-context-process context)) 'run))
1098       (process-send-string (epg-context-process context)
1099                            (epg-data-string plain))))
1100
1101 ;;;###autoload
1102 (defun epg-sign-file (context plain signature &optional mode)
1103   "Sign a file PLAIN and store the result to a file SIGNATURE.
1104 If SIGNATURE is nil, it returns the result as a string.
1105 If optional 3rd argument MODE is 'clearsign, it makes a clear text signature.
1106 If MODE is t or 'detached, it makes a detached signature.
1107 Otherwise, it makes a normal signature."
1108   (unwind-protect
1109       (progn
1110         (if signature
1111             (epg-context-set-output-file context signature)
1112           (epg-context-set-output-file context
1113                                        (epg-make-temp-file "epg-output")))
1114         (epg-start-sign context (epg-make-data-from-file plain) mode)
1115         (epg-wait-for-completion context)
1116         (if (epg-context-result-for context 'error)
1117             (error "Sign failed: %S"
1118                    (epg-context-result-for context 'error)))
1119         (unless signature
1120           (epg-read-output context)))
1121     (unless signature
1122       (epg-delete-output-file context))
1123     (epg-reset context)))
1124
1125 ;;;###autoload
1126 (defun epg-sign-string (context plain &optional mode)
1127   "Sign a string PLAIN and return the output as string.
1128 If optional 3rd argument MODE is 'clearsign, it makes a clear text signature.
1129 If MODE is t or 'detached, it makes a detached signature.
1130 Otherwise, it makes a normal signature."
1131   (unwind-protect
1132       (progn
1133         (epg-context-set-output-file context
1134                                      (epg-make-temp-file "epg-output"))
1135         (epg-start-sign context (epg-make-data-from-string plain) mode)
1136         (epg-flush context)
1137         (epg-wait-for-completion context)
1138         (if (epg-context-result-for context 'error)
1139             (error "Sign failed: %S"
1140                    (epg-context-result-for context 'error)))
1141         (epg-read-output context))
1142     (epg-delete-output-file context)
1143     (epg-reset context)))
1144
1145 ;;;###autoload
1146 (defun epg-start-encrypt (context plain recipients
1147                                   &optional sign always-trust)
1148   "Initiate an encrypt operation on PLAIN.
1149 PLAIN is a data object.
1150 If RECIPIENTS is nil, it performs symmetric encryption.
1151
1152 If you use this function, you will need to wait for the completion of
1153 `epg-gpg-program' by using `epg-wait-for-completion' and call
1154 `epg-reset' to clear a temporaly output file.
1155 If you are unsure, use synchronous version of this function
1156 `epg-encrypt-file' or `epg-encrypt-string' instead."
1157   (epg-context-set-result context nil)
1158   (epg-start context
1159              (append (if always-trust '("--always-trust"))
1160                      (if recipients '("--encrypt") '("--symmetric"))
1161                      (if sign
1162                          (cons "--sign"
1163                                (apply #'nconc
1164                                       (mapcar (lambda (signer)
1165                                                 (list "-u" signer))
1166                                               (epg-context-signers context)))))
1167                      (apply #'nconc
1168                             (mapcar
1169                              (lambda (recipient)
1170                                (list "-r"
1171                                      (epg-sub-key-id
1172                                       (car (epg-key-sub-key-list recipient)))))
1173                              recipients))
1174                      (if (epg-data-file plain)
1175                          (list (epg-data-file plain)))))
1176   (if sign
1177       (epg-wait-for-status context '("BEGIN_SIGNING")))
1178   (epg-wait-for-status context '("BEGIN_ENCRYPTION"))
1179   (if (and (epg-data-string plain)
1180            (eq (process-status (epg-context-process context)) 'run))
1181       (process-send-string (epg-context-process context)
1182                            (epg-data-string plain))))
1183
1184 ;;;###autoload
1185 (defun epg-encrypt-file (context plain recipients
1186                                  cipher &optional sign always-trust)
1187   "Encrypt a file PLAIN and store the result to a file CIPHER.
1188 If CIPHER is nil, it returns the result as a string.
1189 If RECIPIENTS is nil, it performs symmetric encryption."
1190   (unwind-protect
1191       (progn
1192         (if cipher
1193             (epg-context-set-output-file context cipher)
1194           (epg-context-set-output-file context
1195                                        (epg-make-temp-file "epg-output")))
1196         (epg-start-encrypt context (epg-make-data-from-file plain)
1197                            recipients sign always-trust)
1198         (epg-wait-for-completion context)
1199         (if (epg-context-result-for context 'error)
1200             (error "Encrypt failed: %S"
1201                    (epg-context-result-for context 'error)))
1202         (unless cipher
1203           (epg-read-output context)))
1204     (unless cipher
1205       (epg-delete-output-file context))
1206     (epg-reset context)))
1207
1208 ;;;###autoload
1209 (defun epg-encrypt-string (context plain recipients
1210                                    &optional sign always-trust)
1211   "Encrypt a string PLAIN.
1212 If RECIPIENTS is nil, it performs symmetric encryption."
1213   (unwind-protect
1214       (progn
1215         (epg-context-set-output-file context
1216                                      (epg-make-temp-file "epg-output"))
1217         (epg-start-encrypt context (epg-make-data-from-string plain)
1218                            recipients sign always-trust)
1219         (epg-flush context)
1220         (epg-wait-for-completion context)
1221         (if (epg-context-result-for context 'error)
1222             (error "Encrypt failed: %S"
1223                    (epg-context-result-for context 'error)))
1224         (epg-read-output context))
1225     (epg-delete-output-file context)
1226     (epg-reset context)))
1227
1228 ;;;###autoload
1229 (defun epg-start-export-keys (context keys)
1230   "Initiate an export keys operation.
1231
1232 If you use this function, you will need to wait for the completion of
1233 `epg-gpg-program' by using `epg-wait-for-completion' and call
1234 `epg-reset' to clear a temporaly output file.
1235 If you are unsure, use synchronous version of this function
1236 `epg-export-keys-to-file' or `epg-export-keys-to-string' instead."
1237   (epg-context-set-result context nil)
1238   (epg-start context (cons "--export"
1239                            (mapcar
1240                             (lambda (key)
1241                               (epg-sub-key-id
1242                                (car (epg-key-sub-key-list key))))
1243                             keys))))
1244
1245 ;;;###autoload
1246 (defun epg-export-keys-to-file (context keys file)
1247   "Extract public KEYS."
1248   (unwind-protect
1249       (progn
1250         (if keys
1251             (epg-context-set-output-file context file)
1252           (epg-context-set-output-file context
1253                                        (epg-make-temp-file "epg-output")))
1254         (epg-start-export-keys context keys)
1255         (epg-wait-for-completion context)
1256         (if (epg-context-result-for context 'error)
1257             (error "Export keys failed"))
1258         (unless file
1259           (epg-read-output context)))
1260     (unless file
1261       (epg-delete-output-file context))
1262     (epg-reset context)))
1263
1264 ;;;###autoload
1265 (defun epg-export-keys-to-string (context keys)
1266   "Extract public KEYS and return them as a string."
1267   (epg-export-keys-to-file context keys nil))
1268
1269 ;;;###autoload
1270 (defun epg-start-import-keys (context keys)
1271   "Initiate an import keys operation.
1272 KEYS is a data object.
1273
1274 If you use this function, you will need to wait for the completion of
1275 `epg-gpg-program' by using `epg-wait-for-completion' and call
1276 `epg-reset' to clear a temporaly output file.
1277 If you are unsure, use synchronous version of this function
1278 `epg-import-keys-from-file' or `epg-import-keys-from-string' instead."
1279   (epg-context-set-result context nil)
1280   (epg-context-set-output-file context (epg-make-temp-file "epg-output"))
1281   (epg-start context (list "--import" (epg-data-file keys)))
1282   (if (and (epg-data-string keys)
1283            (eq (process-status (epg-context-process context)) 'run))
1284       (process-send-string (epg-context-process context)
1285                            (epg-data-string keys))))
1286
1287 (defun epg-import-keys-1 (context keys)
1288   (unwind-protect
1289       (progn
1290         (epg-start-import-keys context keys)
1291         (if (epg-data-file keys)
1292             (epg-flush context))
1293         (epg-wait-for-completion context)
1294         (if (epg-context-result-for context 'error)
1295             (error "Import keys failed"))
1296         (epg-read-output context))
1297     (epg-reset context)))
1298
1299 ;;;###autoload
1300 (defun epg-import-keys-from-file (context keys)
1301   "Add keys from a file KEYS."
1302   (epg-import-keys-1 context (epg-make-data-from-file keys)))
1303
1304 ;;;###autoload
1305 (defun epg-import-keys-from-string (context keys)
1306   "Add keys from a string KEYS."
1307   (epg-import-keys-1 context (epg-make-data-from-string keys)))
1308
1309 ;;;###autoload
1310 (defun epg-start-delete-keys (context keys &optional allow-secret)
1311   "Initiate an delete keys operation.
1312
1313 If you use this function, you will need to wait for the completion of
1314 `epg-gpg-program' by using `epg-wait-for-completion' and call
1315 `epg-reset' to clear a temporaly output file.
1316 If you are unsure, use synchronous version of this function
1317 `epg-delete-keys' instead."
1318   (epg-context-set-result context nil)
1319   (epg-start context (cons (if allow-secret
1320                                "--delete-secret-key"
1321                              "--delete-key")
1322                            (mapcar
1323                             (lambda (key)
1324                               (epg-sub-key-id
1325                                (car (epg-key-sub-key-list key))))
1326                             keys))))
1327
1328 ;;;###autoload
1329 (defun epg-delete-keys (context keys &optional allow-secret)
1330   "Delete KEYS from the key ring."
1331   (unwind-protect
1332       (progn
1333         (epg-start-delete-keys context keys)
1334         (epg-wait-for-completion context)
1335         (if (epg-context-result-for context 'error)
1336             (error "Delete key failed")))
1337     (epg-reset context)))
1338
1339 (provide 'epg)
1340
1341 ;;; epg.el ends here