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