epg.el

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