git.chise.org Git - elisp/gnus.git-/blob - lisp/gpg.el

   1 ;;; gpg.el --- Interface to GNU Privacy Guard
   2
   3 ;; Copyright (C) 2000 RUS-CERT, University Of Stuttgart
   4
   5 ;; Author: Florian Weimer <Florian.Weimer@RUS.Uni-Stuttgart.DE>
   6 ;; Maintainer: Florian Weimer <Florian.Weimer@RUS.Uni-Stuttgart.DE>
   7 ;; Keywords: crypto
   8 ;; Created: 2000-04-15
   9
  10 ;; This file is NOT (yet?) part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA
  30 ;; ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA
  31 ;;
  32 ;; This code is not well-tested.  BE CAREFUL!
  33 ;;
  34 ;; ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA
  35 ;; ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA
  36
  37 ;; Implemented features which can be tested:
  38 ;;
  39 ;; * Customization for all flavors of PGP is possible.
  40 ;; * The main operations (verify, decrypt, sign, encrypt, sign &
  41 ;;   encrypt) are implemented.
  42 ;; * Gero Treuner's gpg-2comp script is supported, and data which is is
  43 ;;   compatible with PGP 2.6.3 is generated.
  44
  45 ;; Customizing external programs
  46 ;; =============================
  47
  48 ;; The customization are very similar to those of others programs,
  49 ;; only the C-ish "%" constructs have been replaced by more Lisp-like
  50 ;; syntax.
  51 ;;
  52 ;; First, you have to adjust the default executable paths
  53 ;; (`gpg-command-default-alist', customization group `gpg-options',
  54 ;; "Controlling GnuPG invocation.").  After that, you should
  55 ;; change the configuration options which control how specific
  56 ;; command line flags are built (`gpg-command-flag-sign-with-key',
  57 ;; (`gpg-command-flag-recipient').  The elements of these lists are
  58 ;; concatenated without spaces, and a new argument is only started
  59 ;; where indicated.  The `gpg-command-flag-recipient' list is special:
  60 ;; it consists of two parts, the first one remains at the beginning
  61 ;; of the argument, the second one is repeated for each recipient.
  62 ;; Finally, `gpg-command-passphrase-env' has to be changed if there's
  63 ;; no command line flag to force the external program to read the data
  64 ;; from standard input before the message.
  65 ;;
  66 ;; In customization group `gpg-commands', "Controlling GnuPG
  67 ;; invocation.", you have to supply the actual syntax for external
  68 ;; program calls.  Each variable consists of a pair of a program
  69 ;; specification (if a Lisp symbol is given here, it is translated
  70 ;; via `gpg-command-default-alist') and a list of program arguments
  71 ;; with placeholders.  Please read the documentation of each variable
  72 ;; before making your adjustments and try to match the given
  73 ;; requirements as closely as possible!
  74 ;;
  75 ;; The `gpg-commands-key' group, "GnuPG Key Management Commands.",
  76 ;; specifies key management commands.  The syntax of these variables
  77 ;; is like those in the `gpg-commands' group.  Note that the output
  78 ;; format of some of these external programs has to match very close
  79 ;; that of GnuPG.  Additional tools (Thomas Roessler's "pgpring.c")
  80 ;; are available if your favorite implementation of OpenPGP cannot
  81 ;; output the this format.
  82
  83 ;; Security considerations
  84 ;; =======================
  85
  86 ;; On a typical multiuser UNIX system, the memory image of the
  87 ;; Emacs process is not locked, therefore it can be swapped to disk
  88 ;; at any time.  As a result, the passphrase might show up in the
  89 ;; swap space (even if you don't use the passphrase cache, i.e. if
  90 ;; `gpg-passphrase-timeout' is 0).  If someone is able to run `gdb' or
  91 ;; another debugger on your Emacs process, he might be able to recover
  92 ;; the passphrase as well.  Unfortunately, nothing can be done in
  93 ;; order to prevent this at the moment.
  94 ;;
  95 ;; BE CAREFUL: If you use the passphrase cache feature, the passphrase
  96 ;; is stored in the variable `gpg-passphrase' -- and it is NOT
  97 ;; encrypted in any way.  (This is a conceptual problem because the
  98 ;; nature of the passphrase cache requires that Emacs is able to
  99 ;; decrypt automatically, so only a very weak protection could be
 100 ;; applied anyway.)
 101 ;;
 102 ;; In addition, if you use an unpatched Emacs 20 (and earlier
 103 ;; versions), passwords show up in the output of the `view-lossage'
 104 ;; function (bound to `C-h l' by default).
 105
 106 \f
 107 ;;;; Code:
 108
 109 (require 'timer)
 110 (eval-when-compile
 111   (require 'cl))
 112
 113 ;;;; Customization:
 114
 115 ;;; Customization: Groups:
 116
 117 (defgroup gpg nil
 118   "GNU Privacy Guard interface."
 119   :tag "GnuPG"
 120   :group 'processes)
 121
 122 (defgroup gpg-options nil
 123   "Controlling GnuPG invocation."
 124   :tag "GnuPG Options"
 125   :group 'gpg)
 126
 127 (defgroup gpg-commands nil
 128   "Primary GnuPG Operations."
 129   :tag "GnuPG Commands"
 130   :group 'gpg)
 131
 132 (defgroup gpg-commands-key nil
 133   "Commands for GnuPG key management."
 134   :tag "GnuPG Key Commands"
 135   :group 'gpg-commands)
 136
 137 ;;; Customization: Widgets:
 138
 139 (define-widget 'gpg-command-alist 'alist
 140   "An association list for GnuPG command names."
 141   :key-type '(symbol :tag   "Abbreviation")
 142   :value-type '(string :tag "Program name")
 143   :convert-widget 'widget-alist-convert-widget
 144   :tag "Alist")
 145
 146 (define-widget 'gpg-command-program 'choice
 147   "Widget for entering the name of a program (mostly the GnuPG binary)."
 148   :tag "Program"
 149   :args '((const :tag "Default GnuPG program."
 150                  :value gpg)
 151           (const :tag "GnuPG compatibility wrapper."
 152                  :value gpg-2comp)
 153           (const :tag "Disabled"
 154                  :value nil)
 155           (string :tag "Custom program" :format "%v")))
 156
 157 (define-widget 'gpg-command-sign-options 'cons
 158   "Widget for entering signing options."
 159   :args '(gpg-command-program
 160           (repeat
 161            :tag "Arguments"
 162            (choice
 163             :format "%[Type%] %v"
 164             (const :tag "Insert armor option here if necessary."
 165                    :value armor)
 166             (const :tag "Insert text mode option here if necessary."
 167                    :value textmode)
 168             (const :tag "Insert the sign with key option here if necessary."
 169                    :value sign-with-key)
 170             (string :format "%v")))))
 171
 172 (define-widget 'gpg-command-key-options 'cons
 173   "Widget for entering key command options."
 174   :args '(gpg-command-program
 175           (repeat
 176            :tag "Arguments"
 177            (choice
 178             :format "%[Type%] %v"
 179             (const :tag "Insert key ID here."
 180                    :value key-id)
 181             (string :format "%v")))))
 182
 183 ;;; Customization: Variables:
 184
 185 ;;; Customization: Variables: Paths and Flags:
 186
 187 (defcustom gpg-passphrase-timeout
 188   0
 189   "Timeout (in seconds) for the passphrase cache.
 190 The passphrase cache is cleared after is hasn't been used for this
 191 many seconds.  The values 0 means that the passphrase is not cached at
 192 all."
 193   :tag "Passphrase Timeout"
 194   :type 'number
 195   :group 'gpg-options)
 196
 197 (defcustom gpg-default-key-id
 198   nil
 199   "Default key/user ID used for signatures."
 200   :tag "Default Key ID"
 201   :type '(choice
 202           (const :tag "Use GnuPG default." :value nil)
 203           (string))
 204   :group 'gpg-options)
 205
 206 (defcustom gpg-temp-directory
 207   (expand-file-name "~/tmp")
 208   "Directory for temporary files.
 209 If you are running Emacs 20, this directory must have mode 0700."
 210   :tag "Temp directory"
 211   :type 'string
 212   :group 'gpg-options)
 213
 214 (defcustom gpg-command-default-alist
 215   '((gpg . "gpg")
 216     (gpg-2comp . "gpg-2comp"))
 217   "Default paths for some GnuPG-related programs.
 218 Modify this variable if you have to change the paths to the
 219 executables required by the GnuPG interface.  You can enter \"gpg\"
 220 for `gpg-2comp' if you don't have this script, but you'll lose PGP
 221 2.6.x compatibility."
 222   :tag "GnuPG programs"
 223   :type 'gpg-command-alist
 224   :group 'gpg-options)
 225
 226 (defcustom gpg-command-flag-textmode "--textmode"
 227   "The flag to indicate canonical text mode to GnuPG."
 228   :tag "Text mode flag"
 229   :type 'string
 230   :group 'gpg-options)
 231
 232 (defcustom gpg-command-flag-armor "--armor"
 233   "The flag to request ASCII-armoring output from GnuPG."
 234   :tag "Armor flag"
 235   :type 'string
 236   :group 'gpg-options)
 237
 238 (defcustom gpg-command-flag-sign-with-key '("--local-user=" sign-with-key)
 239   "String to include to specify the signing key ID.
 240 The elements are concatenated (without spaces) to form a command line
 241 option."
 242   :tag "Sign with key flag"
 243   :type '(repeat :tag "Argument parts"
 244           (choice :format "%[Type%] %v"
 245            (const :tag "Start next argument." :value next-argument)
 246            (const :tag "Insert signing key ID here." :value sign-with-key)
 247            (string)))
 248   :group 'gpg-options)
 249
 250 (defcustom gpg-command-flag-recipient
 251   '(nil . ("-r" next-argument recipient next-argument))
 252   "Format of a recipient specification.
 253 The elements are concatenated (without spaces) to form a command line
 254 option.  The second part is repeated for each recipient."
 255   :tag "Recipients Flag"
 256   :type '(cons
 257           (repeat :tag "Common prefix"
 258            (choice :format "%[Type%] %v"
 259             (const :tag "Start next argument." :value next-argument)
 260             (string)))
 261           (repeat :tag "For each recipient"
 262            (choice :format "%[Type%] %v"
 263             (const :tag "Start next argument." :value next-argument)
 264             (const :tag "Insert recipient key ID here." :value recipient)
 265             (string))))
 266   :group 'gpg-options)
 267
 268 (defcustom gpg-command-passphrase-env
 269   nil
 270   "Environment variable to set when a passphrase is required, or nil.
 271 If an operation is invoked which requires a passphrase, this
 272 environment variable is set before calling the external program to
 273 indicate that it should read the passphrase from standard input."
 274   :tag "Passphrase environment"
 275   :type '(choice
 276           (const :tag "Disabled" :value nil)
 277           (cons
 278            (string :tag "Variable")
 279            (string :tag "Value")))
 280   :group 'gpg-options)
 281
 282 ;;; Customization: Variables: GnuPG Commands:
 283
 284 (defcustom gpg-command-verify
 285   '(gpg . ("--batch" "--verbose" "--verify" signature-file message-file))
 286   "Command to verify a detached signature.
 287 The invoked program has to read the signed message and the signature
 288 from the given files.  It should write human-readable information to
 289 standard output and/or standard error.  The program shall not convert
 290 charsets or line endings; the input data shall be treated as binary."
 291   :tag "Verify Command"
 292   :type '(cons
 293           gpg-command-program
 294           (repeat
 295            :tag "Arguments"
 296            (choice
 297             :format "%[Type%] %v"
 298             (const :tag "Insert name of file containing the message here."
 299                    :value message-file)
 300             (const :tag "Insert name of file containing the signature here."
 301                    :value signature-file)
 302             (string :format "%v"))))
 303   :group 'gpg-commands)
 304
 305 (defcustom gpg-command-decrypt
 306   '(gpg . ("--decrypt" "--batch" "--passphrase-fd=0"))
 307   "Command to decrypt a message.
 308 The invoked program has to read the passphrase from standard
 309 input, followed by the encrypted message.  It writes the decrypted
 310 message to standard output, and human-readable diagnostic messages to
 311 standard error."
 312   :tag "Decrypt Command"
 313   :type '(cons
 314           gpg-command-program
 315           (repeat
 316            :tag "Arguments"
 317            (choice
 318             :format "%[Type%] %v"
 319             (const :tag "Insert name of file containing the message here."
 320                    :value message-file)
 321             (string :format "%v"))))
 322   :group 'gpg-commands)
 323
 324 (defcustom gpg-command-sign-cleartext
 325   '(gpg-2comp . ("--batch" "--passphrase-fd=0" "--output=-"
 326                  armor textmode  "--clearsign"
 327                  sign-with-key))
 328   "Command to create a create a \"clearsign\" text file.
 329 The invoked program has to read the passphrase from standard input,
 330 followed by the message to sign.  It should write the ASCII-amored
 331 signed text message to standard output, and diagnostic messages to
 332 standard error."
 333   :tag "Clearsign Command"
 334   :type 'gpg-command-sign-options
 335   :group 'gpg-commands)
 336
 337 (defcustom gpg-command-sign-detached
 338   '(gpg-2comp . ("--batch" "--passphrase-fd=0" "--output=-"
 339                  armor textmode "--detach-sign"
 340                  sign-with-key))
 341   "Command to create a create a detached signature.
 342 The invoked program has to read the passphrase from standard input,
 343 followed by the message to sign.  It should write the ASCII-amored
 344 detached signature to standard output, and diagnostic messages to
 345 standard error.  The program shall not convert charsets or line
 346 endings; the input data shall be treated as binary."
 347   :tag "Sign Detached Command"
 348   :type 'gpg-command-sign-options
 349   :group 'gpg-commands)
 350
 351 (defcustom gpg-command-sign-encrypt
 352   '(gpg-2comp . ("--batch" "--passphrase-fd=0" "--output=-"
 353                  armor textmode  "--always-trust" sign-with-key recipients
 354                   "--sign" "--encrypt" plaintext-file))
 355   "Command to sign and encrypt a file.
 356 The invoked program has to read the passphrase from standard input,
 357 followed by the message to sign and encrypt if there is no
 358 `plaintext-file' placeholder.  It should write the ASCII-amored
 359 encrypted message to standard output, and diagnostic messages to
 360 standard error."
 361   :tag "Sign And Encrypt Command"
 362   :type '(cons
 363           gpg-command-program
 364           (repeat
 365            :tag "Arguments"
 366            (choice
 367             :format "%[Type%] %v"
 368             (const :tag "Insert the `sign with key' option here if necessary."
 369                    :value sign-with-key)
 370             (const :tag "Insert list of recipients here."
 371                    :value recipients)
 372             (const :tag "Insert here name of file with plaintext."
 373                    :value plaintext-file)
 374             (string :format "%v"))))
 375   :group 'gpg-commands)
 376
 377 (defcustom gpg-command-encrypt
 378   '(gpg-2comp . ("--batch" "--output=-" armor textmode "--always-trust"
 379                  "--encrypt" recipients plaintext-file))
 380   "Command to encrypt a file.
 381 The invoked program has to read the message to encrypt from standard
 382 input or from the plaintext file (if the `plaintext-file' placeholder
 383 is present).  It should write the ASCII-amored encrypted message to
 384 standard output, and diagnostic messages to standard error."
 385   :type '(cons
 386           gpg-command-program
 387           (repeat
 388            :tag "Arguments"
 389            (choice
 390             :format "%[Type%] %v"
 391             (const :tag "Insert list of recipients here."
 392                    :value recipients)
 393             (const :tag "Insert here name of file with plaintext."
 394                    :value plaintext-file)
 395             (string :format "%v"))))
 396   :group 'gpg-commands)
 397
 398 ;;; Customization: Variables: Key Management Commands:
 399
 400 (defcustom gpg-command-key-import
 401   '(gpg . ("--import" "--verbose" message-file))
 402   "Command to import a public key from a file."
 403   :tag "Import Command"
 404   :type '(cons
 405           gpg-command-program
 406           (repeat
 407            :tag "Arguments"
 408            (choice
 409             :format "%[Type%] %v"
 410             (const :tag "Insert name of file containing the key here."
 411                    :value message-file)
 412             (string :format "%v"))))
 413   :group 'gpg-commands-key)
 414
 415 (defcustom gpg-command-key-export
 416   '(gpg . ("--no-verbose" "--armor" "--export" key-id))
 417   "Command to export a public key from the key ring.
 418 The key should be written to standard output using ASCII armor."
 419   :tag "Export Command"
 420   :type 'gpg-command-key-options
 421   :group 'gpg-commands-key)
 422
 423 (defcustom gpg-command-key-verify
 424   '(gpg . ("--no-verbose" "--batch" "--fingerprint" "--check-sigs" key-id))
 425   "Command to verify a public key."
 426   :tag "Verification Command"
 427   :type 'gpg-command-key-options
 428   :group 'gpg-commands-key)
 429
 430 (defcustom gpg-command-key-public-ring
 431   '(gpg . ("--no-verbose" "--batch" "--with-colons" "--list-keys" key-id))
 432   "Command to list the contents of the public key ring."
 433   :tag "List Public Key Ring Command"
 434   :type 'gpg-command-key-options
 435   :group 'gpg-commands-key)
 436
 437 (defcustom gpg-command-key-secret-ring
 438   '(gpg . ("--no-verbose" "--batch" "--with-colons"
 439            "--list-secret-keys" key-id))
 440   "Command to list the contents of the secret key ring."
 441   :tag "List Secret Key Ring Command"
 442   :type 'gpg-command-key-options
 443   :group 'gpg-commands-key)
 444
 445 (defcustom gpg-command-key-retrieve
 446   '(gpg . ("--batch" "--recv-keys" key-id))
 447   "Command to retrieve public keys."
 448   :tag "Retrieve Keys Command"
 449   :type 'gpg-command-key-options
 450   :group 'gpg-commands-key)
 451
 452 \f
 453 ;;;; Helper functions for GnuPG invocation:
 454
 455 ;;; Build the GnuPG command line:
 456
 457 (defun gpg-build-argument (template substitutions &optional pass-start)
 458   "Build command line argument(s) by substituting placeholders.
 459 TEMPLATE is a list of strings and symbols.  The placeholder symbols in
 460 it are replaced by SUBSTITUTIONS, the elements between
 461 `next-argument' symbols are concatenated without spaces and are
 462 returned in a list.
 463
 464 SUBSTITIONS is a list of (SYMBOL . SEXP) pairs, where SEXP is either
 465 a string (which is inserted literally), a list of strings (which are
 466 inserted as well), or nil, which means to insert nothing.
 467
 468 If PASS-START is t, `next-argument' is also inserted into the result,
 469 and symbols without a proper substitution are retained in the output,
 470 otherwise, an untranslated symbol results in an error.
 471
 472 This function does not handle empty arguments reliably."
 473   (let ((current-arg "")
 474         (arglist nil))
 475     (while template
 476       (let* ((templ (pop template))
 477              (repl (assoc templ substitutions))
 478              (new (if repl (cdr repl) templ)))
 479         (cond
 480          ((eq templ 'next-argument)
 481           ;; If the current argument is not empty, start a new one.
 482           (unless (equal current-arg "")
 483             (setq arglist (nconc arglist
 484                                  (if pass-start
 485                                      (list current-arg 'next-argument)
 486                                    (list current-arg))))
 487             (setq current-arg "")))
 488          ((null new) nil)               ; Drop it.
 489          ((and (not (stringp templ)) (null repl))
 490           ;; Retain an untranslated symbol in the output if
 491           ;; `pass-start' is true.
 492           (unless pass-start
 493             (error "No replacement for `%s'" templ))
 494           (setq arglist (nconc arglist (list current-arg templ)))
 495           (setq current-arg ""))
 496          (t
 497           (unless (listp new)
 498             (setq new (list new)))
 499           (setq current-arg (concat current-arg
 500                                     (apply 'concat new)))))))
 501     (unless (equal current-arg "")
 502       (setq arglist (nconc arglist (list current-arg))))
 503     arglist))
 504
 505 (defun gpg-build-arg-list (template substitutions)
 506   "Build command line by substituting placeholders.
 507 TEMPLATE is a list of strings and symbols.  The placeholder symbols in
 508 it are replaced by SUBSTITUTIONS.
 509
 510 SUBSTITIONS is a list of (SYMBOL . SEXP) pairs, where SEXP is either a
 511 string (which is inserted literally), a list of strings (which are
 512 inserted as well), or nil, which means to insert nothing."
 513   (let (arglist)
 514     (while template
 515       (let* ((templ (pop template))
 516              (repl (assoc templ substitutions))
 517              (new (if repl (cdr repl) templ)))
 518         (cond
 519          ((and (symbolp templ) (null repl))
 520           (error "No replacement for `%s'" templ))
 521          ((null new) nil)               ; Drop it.
 522          (t
 523           (unless (listp new)
 524             (setq new (list new)))
 525           (setq arglist (nconc arglist new))))))
 526     arglist))
 527
 528 (defun gpg-build-flag-recipients-one (recipient)
 529   "Build argument for one RECIPIENT."
 530   (gpg-build-argument (cdr gpg-command-flag-recipient)
 531                       `((recipient . ,recipient)) t))
 532
 533 (defun gpg-build-flag-recipients (recipients)
 534   "Build list of RECIPIENTS using `gpg-command-flag-recipient'."
 535   (gpg-build-argument
 536    (apply 'append (car gpg-command-flag-recipient)
 537                   (mapcar 'gpg-build-flag-recipients-one
 538                           recipients))
 539    nil))
 540
 541 (defun gpg-read-recipients ()
 542   "Query the user for several recipients."
 543   (let ((go t)
 544         recipients r)
 545     (while go
 546       (setq r (read-string "Enter recipient ID [RET when no more]: "))
 547       (if (equal r "")
 548           (setq go nil)
 549         (setq recipients (nconc recipients (list r)))))
 550     recipients))
 551
 552 (defun gpg-build-flag-sign-with-key (key)
 553   "Build sign with key flag using `gpg-command-flag-sign-with-key'."
 554   (let ((k (if key key
 555              (if gpg-default-key-id gpg-default-key-id
 556                nil))))
 557     (if k
 558         (gpg-build-argument gpg-command-flag-sign-with-key
 559                             (list (cons 'sign-with-key k)))
 560       nil)))
 561
 562 (defmacro gpg-with-passphrase-env (&rest body)
 563   "Adjust the process environment and evaluate BODY.
 564 During the evaluation of the body forms, the process environment is
 565 adjust according to `gpg-command-passphrase-env'."
 566   (let ((env-value (make-symbol "env-value")))
 567     `(let ((,env-value))
 568        (unwind-protect
 569            (progn
 570              (when gpg-command-passphrase-env
 571                (setq ,env-value (getenv (car gpg-command-passphrase-env)))
 572                (setenv (car gpg-command-passphrase-env)
 573                        (cdr gpg-command-passphrase-env)))
 574              ,@body)
 575          (when gpg-command-passphrase-env
 576            ;; This will clear the variable if it wasn't set before.
 577            (setenv (car gpg-command-passphrase-env) ,env-value))))))
 578
 579 ;;; Temporary files:
 580
 581 (defun gpg-make-temp-file ()
 582   "Create a temporary file in a safe way"
 583   (let ((name (concat gpg-temp-directory "/gnupg")))
 584     (if (fboundp 'make-temp-file)
 585         ;; If we've got make-temp-file, we are on the save side.
 586         (make-temp-file name)
 587       ;; make-temp-name doesn't create the file, and an ordinary
 588       ;; write-file operation is prone to nasty symlink attacks if the
 589       ;; temporary file resides in a world-writable directory.
 590       (unless (eq (file-modes gpg-temp-directory) 448) ; mode 0700
 591         (error "Directory for temporary files must have mode 0700."))
 592       (setq name (make-temp-name name))
 593       (let ((mode (default-file-modes)))
 594         (unwind-protect
 595             (progn
 596               (set-default-file-modes 384) ; mode 0600
 597               (with-temp-file name))
 598           (set-default-file-modes mode)))
 599       name)))
 600
 601 (defvar gpg-temp-files nil
 602   "List of temporary files used by the GnuPG interface.
 603 Do not set this variable.  Call `gpg-with-temp-files' if you need
 604 temporary files.")
 605
 606 (defun gpg-with-temp-files-create (count)
 607   "Do not call this function.  Used internally by `gpg-with-temp-files'."
 608   (while (> count 0)
 609     (setq gpg-temp-files (cons (gpg-make-temp-file) gpg-temp-files))
 610     (setq count (1- count))))
 611
 612 (defun gpg-with-temp-files-delete ()
 613   "Do not call this function.  Used internally by `gpg-with-temp-files'."
 614   (while gpg-temp-files
 615     (let ((file (pop gpg-temp-files)))
 616       (condition-case nil
 617           (delete-file file)
 618         (error nil)))))
 619
 620 (defmacro gpg-with-temp-files (count &rest body)
 621   "Create COUNT temporary files, USE them, and delete them.
 622 The function USE is called with the names of all temporary files as
 623 arguments."
 624   `(let ((gpg-temp-files))
 625       (unwind-protect
 626           (progn
 627             ;; Create the temporary files.
 628             (gpg-with-temp-files-create ,count)
 629             ,@body)
 630         (gpg-with-temp-files-delete))))
 631
 632 ;;;  Making subprocesses:
 633
 634 (defun gpg-exec-path (option)
 635   "Return the program name for OPTION.
 636 OPTION is of the form (PROGRAM . ARGLIST).  This functions returns
 637 PROGRAM, but takes default values into account."
 638   (let* ((prg (car option))
 639          (path (assq prg gpg-command-default-alist)))
 640     (cond
 641      (path (if (null (cdr path))
 642                (error "Command `%s' is not available" prg)
 643              (cdr path)))
 644      ((null prg) (error "Command is disabled"))
 645      (t prg))))
 646
 647 (defun gpg-call-process (cmd args stdin stdout stderr &optional passphrase)
 648   "Invoke external program CMD with ARGS on buffer STDIN.
 649 Standard output is insert before point in STDOUT, standard error in
 650 STDERR.  If PASSPHRASE is given, send it before STDIN.  PASSPHRASE
 651 should not end with a line feed (\"\\n\").
 652
 653 If `stdin-file' is present in ARGS, it is replaced by the name of a
 654 temporary file.  Before invoking CMD, the contents of STDIN is written
 655 to this file."
 656   (gpg-with-temp-files 2
 657    (let* ((coding-system-for-read 'no-conversion)
 658           (coding-system-for-write 'no-conversion)
 659           (have-stdin-file (memq 'stdin-file args))
 660           (stdin-file (nth 0 gpg-temp-files))
 661           (stderr-file (nth 1 gpg-temp-files))
 662           (cpr-args `(,cmd
 663                       nil               ; don't delete
 664                       (,stdout ,stderr-file)
 665                       nil               ; don't display
 666                       ;; Replace `stdin-file'.
 667                       ,@(gpg-build-arg-list
 668                           args (list (cons 'stdin-file stdin-file)))))
 669           res)
 670      (when have-stdin-file
 671        (with-temp-file stdin-file
 672          (buffer-disable-undo)
 673          (insert-buffer-substring stdin)))
 674      (setq res
 675            (if passphrase
 676                (with-temp-buffer
 677                  (buffer-disable-undo)
 678                  (insert passphrase "\n")
 679                  (unless have-stdin-file
 680                    (apply 'insert-buffer-substring
 681                           (if (listp stdin) stdin (list stdin))))
 682                  (apply 'call-process-region (point-min) (point-max) cpr-args)
 683                  ;; Wipe out passphrase.
 684                  (goto-char (point-min))
 685                  (translate-region (point) (line-end-position)
 686                                    (make-string 256 ? )))
 687              (if (listp stdin)
 688                  (with-current-buffer (car stdin)
 689                    (apply 'call-process-region
 690                           (cadr stdin)
 691                           (if have-stdin-file (cadr stdin) (caddr stdin))
 692                           cpr-args))
 693                (with-current-buffer stdin
 694                  (apply 'call-process-region
 695                         (point-min)
 696                         (if have-stdin-file (point-min) (point-max))
 697                         cpr-args)))))
 698      (with-current-buffer stderr
 699        (insert-file-contents-literally stderr-file))
 700      (if (or (stringp res) (> res 0))
 701          ;; Signal or abnormal exit.
 702          (with-current-buffer stderr
 703            (goto-char (point-max))
 704            (insert (format "\nCommand exit status: %s\n" res))
 705            nil)
 706        t))))
 707
 708 (defvar gpg-result-buffer nil
 709   "The result of a GnuPG operation is stored in this buffer.
 710 Never set this variable directly, use `gpg-show-result' instead.")
 711
 712 (defun gpg-show-result-buffer (always-show result)
 713   "Called by `gpg-show-results' to actually show the buffer."
 714   (with-current-buffer gpg-result-buffer
 715     ;; Only proceed if the buffer is non-empty.
 716     (when (and (/= (point-min) (point-max))
 717                (or always-show (not result)))
 718       (save-window-excursion
 719         (display-buffer (current-buffer))
 720         (unless (y-or-n-p "Continue? ")
 721           (error "GnuPG operation aborted."))))))
 722
 723 (defmacro gpg-show-result (always-show &rest body)
 724   "Show GnuPG result to user for confirmation.
 725 This macro binds `gpg-result-buffer' to a temporary buffer and
 726 evaluates BODY, like `progn'.  If BODY evaluates to `nil' (or
 727 `always-show' is not nil), the user is asked for confirmation."
 728   `(let ((gpg-result-buffer (get-buffer-create
 729                          (generate-new-buffer-name "*GnuPG Output*"))))
 730      (unwind-protect
 731          (gpg-show-result-buffer ,always-show (progn ,@body))
 732        (kill-buffer gpg-result-buffer))))
 733
 734 ;;; Passphrase handling:
 735
 736 (defvar gpg-passphrase-timer
 737   (timer-create)
 738   "This timer will clear the passphrase cache periodically.")
 739
 740 (defvar gpg-passphrase
 741   nil
 742   "The (unencrypted) passphrase cache.")
 743
 744 (defun gpg-passphrase-clear-string (str)
 745   "Erases STR by overwriting all characters."
 746   (let ((pos 0)
 747         (len (length str)))
 748     (while (< pos len)
 749       (aset str pos ? )
 750       (incf pos))))
 751
 752 ;;;###autoload
 753 (defun gpg-passphrase-forget ()
 754   "Forget stored passphrase."
 755   (interactive)
 756   (cancel-timer gpg-passphrase-timer)
 757   (gpg-passphrase-clear-string gpg-passphrase)
 758   (setq gpg-passphrase nil))
 759
 760 (defun gpg-passphrase-store (passphrase)
 761   "Store PASSPHRASE in cache.
 762 Updates the timeout for clearing the cache to `gpg-passphrase-timeout'."
 763   (unless (equal gpg-passphrase-timeout 0)
 764     (timer-set-time gpg-passphrase-timer
 765                     (timer-relative-time (current-time)
 766                                          gpg-passphrase-timeout))
 767     (timer-set-function gpg-passphrase-timer 'gpg-passphrase-forget)
 768     (timer-activate gpg-passphrase-timer)
 769     (setq gpg-passphrase passphrase))
 770   passphrase)
 771
 772 (defun gpg-passphrase-read ()
 773   "Read a passphrase and remember it for some time."
 774   (interactive)
 775   (if gpg-passphrase
 776       ;; This reinitializes the timer.
 777       (gpg-passphrase-store gpg-passphrase)
 778     (let ((pp (read-passwd "Enter passphrase: ")))
 779       (gpg-passphrase-store pp))))
 780
 781 \f
 782 ;;;; Main operations:
 783
 784 ;;;###autoload
 785 (defun gpg-verify (message signature result)
 786   "Verify buffer MESSAGE against detached SIGNATURE buffer.
 787 Returns t if everything worked out well, nil otherwise.  Consult
 788 buffer RESULT for details."
 789   (interactive "bBuffer containing message: \nbBuffer containing signature: \nbBuffor for result: ")
 790   (gpg-with-temp-files 2
 791     (let* ((sig-file    (nth 0 gpg-temp-files))
 792            (msg-file    (nth 1 gpg-temp-files))
 793            (cmd (gpg-exec-path gpg-command-verify))
 794            (args (gpg-build-arg-list (cdr gpg-command-verify)
 795                                      `((signature-file . ,sig-file)
 796                                        (message-file . ,msg-file))))
 797            res)
 798       (with-temp-file sig-file
 799         (buffer-disable-undo)
 800         (apply 'insert-buffer-substring (if (listp signature)
 801                                             signature
 802                                           (list signature))))
 803       (with-temp-file msg-file
 804         (buffer-disable-undo)
 805         (apply 'insert-buffer-substring (if (listp message)
 806                                             message
 807                                           (list message))))
 808       (setq res (apply 'call-process-region
 809                        (point-min) (point-min) ; no data
 810                        cmd
 811                        nil              ; don't delete
 812                        result
 813                        nil              ; don't display
 814                        args))
 815       (if (or (stringp res) (> res 0))
 816           ;; Signal or abnormal exit.
 817           (with-current-buffer result
 818             (insert (format "\nCommand exit status: %s\n" res))
 819             nil)
 820         t))))
 821
 822 ;;;###autoload
 823 (defun gpg-decrypt (ciphertext plaintext result &optional passphrase)
 824   "Decrypt buffer CIPHERTEXT to buffer PLAINTEXT.
 825 Returns t if everything worked out well, nil otherwise.  Consult
 826 buffer RESULT for details.  Reads a missing PASSPHRASE using
 827 `gpg-passphrase-read'."
 828   (interactive "bBuffer containing ciphertext: \nbBuffer for plaintext: \nbBuffor for decryption status: ")
 829   (gpg-call-process (gpg-exec-path gpg-command-decrypt)
 830                     (gpg-build-arg-list (cdr gpg-command-decrypt) nil)
 831                     ciphertext plaintext result
 832                     (if passphrase passphrase (gpg-passphrase-read)))
 833   (when passphrase
 834     (gpg-passphrase-clear-string passphrase)))
 835
 836 ;;;###autoload
 837 (defun gpg-sign-cleartext
 838   (plaintext signed-text result &optional passphrase sign-with-key)
 839   "Sign buffer PLAINTEXT, and store PLAINTEXT with signature in
 840 SIGNED-TEXT.
 841 Reads a missing PASSPHRASE using `gpg-passphrase-read'.  Uses key ID
 842 SIGN-WITH-KEY if given, otherwise the default key ID.  Returns t if
 843 everything worked out well, nil otherwise.  Consult buffer RESULT for
 844 details.
 845
 846 NOTE: Use of this function is deprecated."
 847   (interactive "bBuffer containing plaintext: \nbBuffer for text with signature: \nbBuffer for status information: ")
 848   (let ((subst (list (cons 'sign-with-key
 849                            (gpg-build-flag-sign-with-key sign-with-key))
 850                      (cons 'armor gpg-command-flag-armor)
 851                      (cons 'textmode gpg-command-flag-textmode))))
 852     (gpg-call-process (gpg-exec-path gpg-command-sign-cleartext)
 853                       (gpg-build-arg-list (cdr gpg-command-sign-cleartext)
 854                                           subst)
 855                       plaintext signed-text result
 856                       (if passphrase passphrase (gpg-passphrase-read))))
 857   (when passphrase
 858     (gpg-passphrase-clear-string passphrase)))
 859
 860 ;;;###autoload
 861 (defun gpg-sign-detached
 862   (plaintext signature result &optional passphrase sign-with-key
 863    armor textmode)
 864   "Sign buffer PLAINTEXT, and store SIGNATURE in that buffer.
 865 Reads a missing PASSPHRASE using `gpg-passphrase-read'.  Uses key ID
 866 SIGN-WITH-KEY if given, otherwise the default key ID.  Returns t if
 867 everything worked out well, nil otherwise.  Consult buffer RESULT for
 868 details.  ARMOR the result and activate canonical TEXTMODE if
 869 requested."
 870   (interactive "bBuffer containing plaintext: \nbBuffer for text with signature: \nbBuffer for status information: ")
 871   (let ((subst (list (cons 'sign-with-key
 872                            (gpg-build-flag-sign-with-key sign-with-key))
 873                      (cons 'armor (if armor gpg-command-flag-armor))
 874                      (cons 'textmode (if armor gpg-command-flag-textmode)))))
 875     (gpg-call-process (gpg-exec-path gpg-command-sign-detached)
 876                       (gpg-build-arg-list (cdr gpg-command-sign-detached)
 877                                           subst)
 878                       plaintext signature result
 879                       (if passphrase passphrase (gpg-passphrase-read))))
 880   (when passphrase
 881     (gpg-passphrase-clear-string passphrase)))
 882
 883
 884 ;;;###autoload
 885 (defun gpg-sign-encrypt
 886   (plaintext ciphertext result recipients &optional passphrase sign-with-key
 887    armor textmode)
 888   "Sign buffer PLAINTEXT, and store SIGNATURE in that buffer.
 889 RECIPIENTS is a list of key IDs used for encryption.  This function
 890 reads a missing PASSPHRASE using `gpg-passphrase-read', and uses key
 891 ID SIGN-WITH-KEY for the signature if given, otherwise the default key
 892 ID.  Returns t if everything worked out well, nil otherwise.  Consult
 893 buffer RESULT for details.  ARMOR the result and activate canonical
 894 TEXTMODE if requested."
 895   (interactive (list
 896                 (read-buffer "Buffer containing plaintext: " nil t)
 897                 (read-buffer "Buffer for ciphertext: " nil t)
 898                 (read-buffer "Buffer for status informationt: " nil t)
 899                 (gpg-read-recipients)))
 900     (let ((subst `((sign-with-key . ,(gpg-build-flag-sign-with-key
 901                                       sign-with-key))
 902                    (plaintext-file . stdin-file)
 903                    (recipients . ,(gpg-build-flag-recipients recipients))
 904                    (armor ,(if armor gpg-command-flag-armor))
 905                    (textmode ,(if armor gpg-command-flag-textmode)))))
 906       (gpg-call-process (gpg-exec-path gpg-command-sign-encrypt)
 907                         (gpg-build-arg-list (cdr gpg-command-sign-encrypt)
 908                                             subst)
 909                         plaintext ciphertext result
 910                         (if passphrase passphrase (gpg-passphrase-read))))
 911   (when passphrase
 912     (gpg-passphrase-clear-string passphrase)))
 913
 914
 915 ;;;###autoload
 916 (defun gpg-encrypt
 917   (plaintext ciphertext result recipients &optional passphrase armor textmode)
 918   "Encrypt buffer PLAINTEXT, and store CIPHERTEXT in that buffer.
 919 RECIPIENTS is a list of key IDs used for encryption.  Returns t if
 920 everything worked out well, nil otherwise.  Consult buffer RESULT for
 921 details.  ARMOR the result and activate canonical
 922 TEXTMODE if requested."
 923   (interactive (list
 924                 (read-buffer "Buffer containing plaintext: " nil t)
 925                 (read-buffer "Buffer for ciphertext: " nil t)
 926                 (read-buffer "Buffer for status informationt: " nil t)
 927                 (gpg-read-recipients)))
 928   (let ((subst `((plaintext-file . stdin-file)
 929                  (recipients . ,(gpg-build-flag-recipients recipients))
 930                  (armor ,(if armor gpg-command-flag-armor))
 931                  (textmode ,(if armor gpg-command-flag-textmode)))))
 932     (gpg-call-process (gpg-exec-path gpg-command-encrypt)
 933                       (gpg-build-arg-list (cdr gpg-command-encrypt) subst)
 934                       plaintext ciphertext result nil))
 935   (when passphrase
 936     (gpg-passphrase-clear-string passphrase)))
 937
 938 \f
 939 ;;;; Key management
 940
 941 ;;; ADT: OpenPGP Key
 942
 943 (defun gpg-key-make (user-id key-id unique-id length algorithm
 944                      creation-date expire-date validity trust)
 945   "Create a new key object (for internal use only)."
 946   (vector
 947         ;;  0   1      2         3      4
 948         user-id key-id unique-id length algorithm
 949         ;; 5          6           7        8
 950         creation-date expire-date validity trust))
 951
 952
 953 (defun gpg-key-p (key)
 954   "Return t if KEY is a key specification."
 955   (and (arrayp key) (equal (length key) 9) key))
 956
 957 (defmacro gpg-key-primary-user-id (key)
 958   "The primary user ID for KEY (human-readable).
 959 DO NOT USE this ID for selecting recipients.  It is probably not
 960 unique."
 961   (list 'car (list 'aref key 0)))
 962
 963 (defmacro gpg-key-user-ids (key)
 964   "A list of additional user IDs for KEY (human-readable).
 965 DO NOT USE these IDs for selecting recipients.  They are probably not
 966 unique."
 967   (list 'cdr (list 'aref key 0)))
 968
 969 (defmacro gpg-key-id (key)
 970   "The key ID of KEY.
 971 DO NOT USE this ID for selecting recipients.  It is not guaranteed to
 972 be unique."
 973   (list 'aref key 1))
 974
 975 (defun gpg-short-key-id (key)
 976   "The short key ID of KEY."
 977   (let* ((id (gpg-key-id key))
 978          (len (length id)))
 979     (if (> len 8)
 980         (substring id (- len 8))
 981       id)))
 982
 983 (defmacro gpg-key-unique-id (key)
 984   "A non-standard ID of KEY which is only valid locally.
 985 This ID can be used to specify recipients in a safe manner.  Note,
 986 even this ID might not be unique unless GnuPG is used."
 987   (list 'aref key 2))
 988
 989 (defmacro gpg-key-unique-id-list (key-list)
 990   "Like `gpg-key-unique-id', but operate on a list."
 991   `(mapcar (lambda (key) (gpg-key-unique-id key))
 992            ,key-list))
 993
 994 (defmacro gpg-key-length (key)
 995   "Returns the key length."
 996   (list 'aref key 3))
 997
 998 (defmacro gpg-key-algorithm (key)
 999   "The encryption algorithm used by KEY.
1000 One of the symbols `rsa', `rsa-encrypt', `rsa-sign', `elgamal',
1001 `elgamal-encrypt', `dsa'."
1002   (list 'aref key 4))
1003
1004 (defmacro gpg-key-creation-date (key)
1005   "A string with the creation date of KEY in ISO format."
1006   (list 'aref key 5))
1007
1008 (defmacro gpg-key-expire-date (key)
1009   "A string with the expiration date of KEY in ISO format."
1010   (list 'aref key 6))
1011
1012 (defmacro gpg-key-validity (key)
1013   "The calculated validity of KEY.
1014 One of the symbols `not-known', `disabled', `revoked', `expired',
1015 `undefined', `trust-none', `trust-marginal', `trust-full',
1016 `trust-ultimate' (see the GnuPG documentation for details)."
1017  (list 'aref key 7))
1018
1019 (defmacro gpg-key-trust (key)
1020   "The assigned trust for KEY.
1021 One of the symbols `not-known', `undefined', `trust-none',
1022 `trust-marginal', `trust-full' (see the GnuPG
1023 documentation for details)."
1024   (list 'aref key 8))
1025
1026 (defun gpg-key-lessp (a b)
1027   "Returns t if primary user ID of A is less than B."
1028   (let ((res (compare-strings (gpg-key-primary-user-id a) 0 nil
1029                               (gpg-key-primary-user-id b) 0 nil
1030                               t)))
1031     (if (eq res t)
1032         nil
1033       (< res 0))))
1034
1035 ;;; Accessing the key database:
1036
1037 ;; Internal functions:
1038
1039 (defmacro gpg-key-list-keys-skip-field ()
1040   '(search-forward ":" eol 'move))
1041
1042 (defmacro gpg-key-list-keys-get-field ()
1043   '(buffer-substring (point) (if (gpg-key-list-keys-skip-field)
1044                                  (1- (point))
1045                                eol)))
1046 (defmacro gpg-key-list-keys-string-field ()
1047   '(gpg-key-list-keys-get-field))
1048
1049 (defmacro gpg-key-list-keys-read-field ()
1050   (let ((field (make-symbol "field")))
1051     `(let ((,field (gpg-key-list-keys-get-field)))
1052        (if (equal (length ,field) 0)
1053            nil
1054          (read ,field)))))
1055
1056 (defun gpg-key-list-keys-parse-line ()
1057   "Parse the line in the current buffer and return a vector of fields."
1058   (let* ((eol (line-end-position))
1059          (v (if (eolp)
1060                 nil
1061               (vector
1062                (gpg-key-list-keys-read-field) ; type
1063                (gpg-key-list-keys-get-field) ; trust
1064                (gpg-key-list-keys-read-field) ; key length
1065                (gpg-key-list-keys-read-field) ; algorithm
1066                (gpg-key-list-keys-get-field) ; key ID
1067                (gpg-key-list-keys-get-field) ; creation data
1068                (gpg-key-list-keys-get-field) ; expire
1069                (gpg-key-list-keys-get-field) ; unique (local) ID
1070                (gpg-key-list-keys-get-field) ; ownertrust
1071                (gpg-key-list-keys-string-field) ; user ID
1072                ))))
1073     (if (eolp)
1074         (when v
1075           (forward-char 1))
1076       (error "Too many fields in GnuPG key database"))
1077     v))
1078
1079 (defconst gpg-pubkey-algo-alist
1080   '((1 . rsa)
1081     (2 . rsa-encrypt-only)
1082     (3 . rsa-sign-only)
1083     (16 . elgamal-encrypt-only)
1084     (17 . dsa)
1085     (20 . elgamal))
1086   "Alist mapping OpenPGP public key algorithm numbers to symbols.")
1087
1088 (defconst gpg-trust-alist
1089   '((?- . not-known)
1090     (?o . not-known)
1091     (?d . disabled)
1092     (?r . revoked)
1093     (?e . expired)
1094     (?q . trust-undefined)
1095     (?n . trust-none)
1096     (?m . trust-marginal)
1097     (?f . trust-full)
1098     (?u . trust-ultimate))
1099   "Alist mapping GnuPG trust value short forms to long symbols.")
1100
1101 (defmacro gpg-key-list-keys-in-buffer-store ()
1102   '(when primary-user-id
1103      (sort user-id 'string-lessp)
1104      (push (gpg-key-make (cons primary-user-id  user-id)
1105                          key-id unique-id key-length
1106                          algorithm creation-date
1107                          expire-date validity trust)
1108            key-list)))
1109
1110 (defun gpg-key-list-keys-in-buffer (&optional buffer)
1111   "Return a list of keys for BUFFER.
1112 If BUFFER is omitted, use current buffer."
1113   (with-current-buffer (if buffer buffer (current-buffer))
1114     (goto-char (point-min))
1115     ;; Skip key ring filename written by GnuPG.
1116     (search-forward "\n---------------------------\n" nil t)
1117     ;; Loop over all lines in buffer and analyze them.
1118     (let (primary-user-id user-id key-id unique-id ; current key components
1119           key-length algorithm creation-date expire-date validity trust
1120           line                          ; fields in current line
1121           key-list)                     ; keys gather so far
1122
1123       (while (setq line (gpg-key-list-keys-parse-line))
1124         (cond
1125          ;; Public or secret key.
1126          ((memq (aref line 0) '(pub sec))
1127           ;; Store previous key, if any.
1128           (gpg-key-list-keys-in-buffer-store)
1129           ;; Record field values.
1130           (setq primary-user-id (aref line 9))
1131           (setq user-id nil)
1132           (setq key-id (aref line 4))
1133           ;; We use the key ID if no unique ID is available.
1134           (setq unique-id (if (> (length (aref line 7)) 0)
1135                               (concat "#" (aref line 7))
1136                             (concat "0x" key-id)))
1137           (setq key-length (aref line 2))
1138           (setq algorithm (assq (aref line 3) gpg-pubkey-algo-alist))
1139           (if algorithm
1140               (setq algorithm (cdr algorithm))
1141             (error "Unknown algorithm %s" (aref line 3)))
1142           (setq creation-date (if (> (length (aref line 5)) 0)
1143                                   (aref line 5)))
1144           (setq expire-date (if (> (length (aref line 6)) 0)
1145                                 (aref line 6)))
1146           (setq validity (assq (aref (aref line 1) 0) gpg-trust-alist))
1147           (if validity
1148               (setq validity (cdr validity))
1149             (error "Unknown validity specification %S" (aref line 1)))
1150           (setq trust (assq (aref (aref line 8) 0) gpg-trust-alist))
1151           (if trust
1152               (setq trust (cdr trust))
1153             (error "Unknown trust specification %S" (aref line 8))))
1154
1155          ;; Additional user ID
1156          ((eq 'uid (aref line 0))
1157           (setq user-id (cons (aref line 9) user-id)))
1158
1159          ;; Subkeys are ignored for now.
1160          ((memq (aref line 0) '(sub ssb))
1161           t)
1162          (t (error "Unknown record type %S" (aref line 0)))))
1163
1164       ;; Store the key retrieved last.
1165       (gpg-key-list-keys-in-buffer-store)
1166       ;; Sort the keys according to the primary user ID.
1167       (sort key-list 'gpg-key-lessp))))
1168
1169 (defun gpg-key-list-keyspec (command &optional keyspec stderr ignore-error)
1170   "Insert the output of COMMAND before point in current buffer."
1171   (let* ((cmd (gpg-exec-path command))
1172          (key (if (equal keyspec "") nil keyspec))
1173          (args (gpg-build-arg-list (cdr command) `((key-id . ,key))))
1174          exit-status)
1175     (setq exit-status
1176           (apply 'call-process-region
1177                  (point-min) (point-min) ; no data
1178                  cmd
1179                  nil                    ; don't delete
1180                  (if stderr t '(t nil))
1181                  nil                    ; don't display
1182                  args))
1183     (unless (or ignore-error (equal exit-status 0))
1184       (error "GnuPG command exited unsuccessfully"))))
1185
1186
1187 (defun gpg-key-list-keyspec-parse (command &optional keyspec)
1188   "Return a list of keys matching KEYSPEC.
1189 COMMAND is used to obtain the key list.  The usual substring search
1190 for keys is performed."
1191   (with-temp-buffer
1192     (buffer-disable-undo)
1193     (gpg-key-list-keyspec command keyspec)
1194     (gpg-key-list-keys-in-buffer)))
1195
1196 ;;;###autoload
1197 (defun gpg-key-list-keys (&optional keyspec)
1198   "A list of public keys matching KEYSPEC.
1199 The usual substring search for keys is performed."
1200   (gpg-key-list-keyspec-parse gpg-command-key-public-ring keyspec))
1201
1202 ;;;###autoload
1203 (defun gpg-key-list-secret-keys (&optional keyspec)
1204   "A list of secret keys matching KEYSPEC.
1205 The usual substring search for keys is performed."
1206   (gpg-key-list-keyspec-parse gpg-command-key-secret-ring keyspec))
1207
1208 ;;;###autoload
1209 (defun gpg-key-insert-public-key (key)
1210   "Inserts the public key(s) matching KEYSPEC.
1211 The ASCII-armored key is inserted before point into current buffer."
1212   (gpg-key-list-keyspec gpg-command-key-export key))
1213
1214 ;;;###autoload
1215 (defun gpg-key-insert-information (key)
1216   "Insert human-readable information (including fingerprint) on KEY.
1217 Insertion takes place in current buffer before point."
1218   (gpg-key-list-keyspec gpg-command-key-verify key))
1219
1220 ;;;###autoload
1221 (defun gpg-key-retrieve (key)
1222   "Fetch KEY from default key server.
1223 KEY is a key ID or a list of key IDs.  Status information about this
1224 operation is inserted into the current buffer before point."
1225   (gpg-key-list-keyspec gpg-command-key-retrieve key t t))
1226
1227 ;;;###autoload
1228 (defun gpg-key-add-to-ring (key result)
1229   "Adds key in buffer KEY to the GnuPG key ring.
1230 Human-readable information on the RESULT is stored in buffer RESULT
1231 before point.")
1232
1233 (provide 'gpg)
1234
1235 ;;; gpg.el ends here