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