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