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