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