cgit.sxemacs.org Git - gnus/blob - contrib/gpg.el

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