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