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