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

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