git.chise.org Git - elisp/gnus.git-/blob - contrib/gpg.el

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