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