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