* gnus.texi: Enclose the iflatex section with iftex.

[gnus] / contrib / gpg.el

diff --git a/contrib/gpg.el b/contrib/gpg.el
index 8f55f32..277abc3 100644 (file)
--- a/contrib/gpg.el
+++ b/contrib/gpg.el
@@ -7,7 +7,7 @@
 ;; Keywords: crypto
 ;; Created: 2000-04-15
 
 ;; Keywords: crypto
 ;; Created: 2000-04-15
 

-;; $Id: gpg.el,v 1.1 2000/11/04 12:22:17 zsh Exp $
+;; $Id: gpg.el,v 1.19 2003/05/01 16:03:41 larsi Exp $

 
 ;; This file is NOT (yet?) part of GNU Emacs.
 
 
 ;; This file is NOT (yet?) part of GNU Emacs.
 


@@ -41,8 +41,8 @@
 ;; * Customization for all flavors of PGP is possible.
 ;; * The main operations (verify, decrypt, sign, encrypt, sign &
 ;;   encrypt) are implemented.
 ;; * Customization for all flavors of PGP is possible.
 ;; * The main operations (verify, decrypt, sign, encrypt, sign &
 ;;   encrypt) are implemented.

-;; * Gero Treuner's gpg-2comp script is supported, and data which is is
-;;   compatible with PGP 2.6.3 is generated.
+;; * Optionally, Gero Treuner's gpg-2comp script is supported, 
+;;   to generate data which is compatible with PGP 2.6.3.

 
 ;; Customizing external programs 
 ;; =============================
 
 ;; Customizing external programs 
 ;; =============================


@@ -106,11 +106,16 @@
 ;; function (bound to `C-h l' by default).
 
 \f
 ;; function (bound to `C-h l' by default).
 
 \f

-;;;; Code:
+;;; Code:

 
 (require 'timer)
 
 (require 'timer)

-(eval-when-compile 
-  (require 'cl))
+(eval-when-compile (require 'cl))
+
+(eval-and-compile 
+  (defalias 'gpg-point-at-eol
+    (if (fboundp 'point-at-eol)
+       'point-at-eol
+      'line-end-position)))

 
 ;;;; Customization:
 
 
 ;;;; Customization:
 


@@ -138,12 +143,19 @@
 
 ;;; Customization: Widgets:
 
 
 ;;; Customization: Widgets:
 

-(define-widget 'gpg-command-alist 'alist
-  "An association list for GnuPG command names."
-  :key-type '(symbol :tag   "Abbreviation")
-  :value-type '(string :tag "Program name")
-  :convert-widget 'widget-alist-convert-widget
-  :tag "Alist")
+(if (get 'alist 'widget-type)
+    (define-widget 'gpg-command-alist 'alist
+      "An association list for GnuPG command names."
+      :key-type '(symbol :tag   "Abbreviation")
+      :value-type '(string :tag "Program name")
+      :convert-widget 'widget-alist-convert-widget
+      :tag "Alist")
+    (define-widget 'gpg-command-alist 'repeat
+      "An association list for GnuPG command names."
+      :args '((cons :format "%v"
+                   (symbol :tag   "Abbreviation")
+                   (string :tag "Program name")))
+      :tag "Alist"))

 
 (define-widget 'gpg-command-program 'choice
   "Widget for entering the name of a program (mostly the GnuPG binary)."
 
 (define-widget 'gpg-command-program 'choice
   "Widget for entering the name of a program (mostly the GnuPG binary)."


@@ -215,16 +227,22 @@ If you are running Emacs 20, this directory must have mode 0700."
 
 (defcustom gpg-command-default-alist 
   '((gpg . "gpg")
 
 (defcustom gpg-command-default-alist 
   '((gpg . "gpg")

-    (gpg-2comp . "gpg-2comp"))
+    (gpg-2comp . "gpg"))

   "Default paths for some GnuPG-related programs.
 Modify this variable if you have to change the paths to the
   "Default paths for some GnuPG-related programs.
 Modify this variable if you have to change the paths to the

-executables required by the GnuPG interface.  You can enter \"gpg\"
-for `gpg-2comp' if you don't have this script, but you'll lose PGP
-2.6.x compatibility."
+executables required by the GnuPG interface.  You can enter \"gpg-2comp\"
+for `gpg-2comp' if you have obtained this script, in order to gain
+PGP 2.6.x compatibility."

   :tag "GnuPG programs"
   :type 'gpg-command-alist
   :group 'gpg-options)
 
   :tag "GnuPG programs"
   :type 'gpg-command-alist
   :group 'gpg-options)
 

+(defcustom gpg-command-all-arglist
+  nil
+  "List of arguments to add to all GPG commands."
+  :tag "All command args"
+  :group 'gpg-options)
+

 (defcustom gpg-command-flag-textmode "--textmode"
   "The flag to indicate canonical text mode to GnuPG."
   :tag "Text mode flag"
 (defcustom gpg-command-flag-textmode "--textmode"
   "The flag to indicate canonical text mode to GnuPG."
   :tag "Text mode flag"


@@ -284,7 +302,7 @@ indicate that it should read the passphrase from standard input."
 ;;; Customization: Variables: GnuPG Commands:
 
 (defcustom gpg-command-verify
 ;;; Customization: Variables: GnuPG Commands:
 
 (defcustom gpg-command-verify

-  '(gpg . ("--batch" "--verbose" "--verify" signature-file message-file))
+  '(gpg . ("--status-fd" "1" "--batch" "--verbose" "--verify" signature-file message-file))

   "Command to verify a detached signature.
 The invoked program has to read the signed message and the signature
 from the given files.  It should write human-readable information to
   "Command to verify a detached signature.
 The invoked program has to read the signed message and the signature
 from the given files.  It should write human-readable information to


@@ -305,7 +323,7 @@ charsets or line endings; the input data shall be treated as binary."
   :group 'gpg-commands)
 
 (defcustom gpg-command-verify-cleartext
   :group 'gpg-commands)
 
 (defcustom gpg-command-verify-cleartext

-  '(gpg . ("--batch" "--verbose" "--verify" message-file))
+  '(gpg . ("--status-fd" "1" "--batch" "--verbose" "--verify" message-file))

   "Command to verify a message.
 The invoked program has to read the signed message from the given
 file.  It should write human-readable information to standard output
   "Command to verify a message.
 The invoked program has to read the signed message from the given
 file.  It should write human-readable information to standard output


@@ -324,7 +342,7 @@ endings; the input data shall be treated as binary."
   :group 'gpg-commands)
 
 (defcustom gpg-command-decrypt
   :group 'gpg-commands)
 
 (defcustom gpg-command-decrypt

-  '(gpg . ("--decrypt" "--batch" "--passphrase-fd=0"))
+  '(gpg . ("--status-fd" "2" "--decrypt" "--batch" "--passphrase-fd=0"))

   "Command to decrypt a message.
 The invoked program has to read the passphrase from standard
 input, followed by the encrypted message.  It writes the decrypted
   "Command to decrypt a message.
 The invoked program has to read the passphrase from standard
 input, followed by the encrypted message.  It writes the decrypted


@@ -346,7 +364,7 @@ standard error."
   '(gpg-2comp . ("--batch" "--passphrase-fd=0" "--output=-"
                 armor textmode  "--clearsign"
                 sign-with-key))
   '(gpg-2comp . ("--batch" "--passphrase-fd=0" "--output=-"
                 armor textmode  "--clearsign"
                 sign-with-key))

-  "Command to create a create a \"clearsign\" text file.  
+  "Command to create a \"clearsign\" text file.  

 The invoked program has to read the passphrase from standard input,
 followed by the message to sign.  It should write the ASCII-amored
 signed text message to standard output, and diagnostic messages to
 The invoked program has to read the passphrase from standard input,
 followed by the message to sign.  It should write the ASCII-amored
 signed text message to standard output, and diagnostic messages to


@@ -359,7 +377,7 @@ standard error."
   '(gpg-2comp . ("--batch" "--passphrase-fd=0" "--output=-"
                 armor textmode "--detach-sign" 
                 sign-with-key))
   '(gpg-2comp . ("--batch" "--passphrase-fd=0" "--output=-"
                 armor textmode "--detach-sign" 
                 sign-with-key))

-  "Command to create a create a detached signature. 
+  "Command to create a detached signature. 

 The invoked program has to read the passphrase from standard input,
 followed by the message to sign.  It should write the ASCII-amored
 detached signature to standard output, and diagnostic messages to
 The invoked program has to read the passphrase from standard input,
 followed by the message to sign.  It should write the ASCII-amored
 detached signature to standard output, and diagnostic messages to


@@ -531,7 +549,7 @@ it are replaced by SUBSTITUTIONS.
 SUBSTITIONS is a list of (SYMBOL . SEXP) pairs, where SEXP is either a
 string (which is inserted literally), a list of strings (which are
 inserted as well), or nil, which means to insert nothing."
 SUBSTITIONS is a list of (SYMBOL . SEXP) pairs, where SEXP is either a
 string (which is inserted literally), a list of strings (which are
 inserted as well), or nil, which means to insert nothing."

-  (let (arglist)
+  (let ((arglist (copy-sequence gpg-command-all-arglist)))

     (while template
       (let* ((templ (pop template))
             (repl (assoc templ substitutions))
     (while template
       (let* ((templ (pop template))
             (repl (assoc templ substitutions))


@@ -596,20 +614,24 @@ adjust according to `gpg-command-passphrase-env'."
         (when gpg-command-passphrase-env
           ;; This will clear the variable if it wasn't set before.
           (setenv (car gpg-command-passphrase-env) ,env-value))))))
         (when gpg-command-passphrase-env
           ;; This will clear the variable if it wasn't set before.
           (setenv (car gpg-command-passphrase-env) ,env-value))))))

+(put 'gpg-with-passphrase-env 'lisp-indent-function 0)
+(put 'gpg-with-passphrase-env 'edebug-form-spec '(body))

 
 ;;; Temporary files:
 
 (defun gpg-make-temp-file ()
   "Create a temporary file in a safe way"
 
 ;;; Temporary files:
 
 (defun gpg-make-temp-file ()
   "Create a temporary file in a safe way"

-  (let ((name (concat gpg-temp-directory "/gnupg")))
+  (let ((name  ;; User may use "~/"
+        (expand-file-name "gnupg" gpg-temp-directory)))

     (if (fboundp 'make-temp-file)
        ;; If we've got make-temp-file, we are on the save side.
        (make-temp-file name)
       ;; make-temp-name doesn't create the file, and an ordinary
       ;; write-file operation is prone to nasty symlink attacks if the
       ;; temporary file resides in a world-writable directory.
     (if (fboundp 'make-temp-file)
        ;; If we've got make-temp-file, we are on the save side.
        (make-temp-file name)
       ;; make-temp-name doesn't create the file, and an ordinary
       ;; write-file operation is prone to nasty symlink attacks if the
       ;; temporary file resides in a world-writable directory.

-      (unless (eq (file-modes gpg-temp-directory) 448) ; mode 0700
-       (error "Directory for temporary files must have mode 0700."))
+      (unless (or (memq system-type '(windows-nt cygwin32 win32 w32 mswindows))
+                 (eq (file-modes gpg-temp-directory) 448)) ; mode 0700
+       (error "Directory for temporary files (%s) must have mode 0700" gpg-temp-directory))

       (setq name (make-temp-name name))
       (let ((mode (default-file-modes)))
        (unwind-protect
       (setq name (make-temp-name name))
       (let ((mode (default-file-modes)))
        (unwind-protect


@@ -649,6 +671,8 @@ arguments."
            (gpg-with-temp-files-create ,count)
            ,@body)
        (gpg-with-temp-files-delete))))
            (gpg-with-temp-files-create ,count)
            ,@body)
        (gpg-with-temp-files-delete))))

+(put 'gpg-with-temp-files 'lisp-indent-function 1)
+(put 'gpg-with-temp-files 'edebug-form-spec '(body))

 
 ;;;  Making subprocesses:
 
 
 ;;;  Making subprocesses:
 


@@ -703,7 +727,7 @@ to this file."
                 (apply 'call-process-region (point-min) (point-max) cpr-args)
                 ;; Wipe out passphrase.
                 (goto-char (point-min))
                 (apply 'call-process-region (point-min) (point-max) cpr-args)
                 ;; Wipe out passphrase.
                 (goto-char (point-min))

-                (translate-region (point) (line-end-position)
+                (translate-region (point) (gpg-point-at-eol)

                                   (make-string 256 ? )))
             (if (listp stdin)
                 (with-current-buffer (car stdin)
                                   (make-string 256 ? )))
             (if (listp stdin)
                 (with-current-buffer (car stdin)


@@ -739,7 +763,7 @@ Never set this variable directly, use `gpg-show-result' instead.")
       (save-window-excursion
        (display-buffer (current-buffer))
        (unless (y-or-n-p "Continue? ")
       (save-window-excursion
        (display-buffer (current-buffer))
        (unless (y-or-n-p "Continue? ")

-         (error "GnuPG operation aborted."))))))
+         (error "GnuPG operation aborted"))))))

 
 (defmacro gpg-show-result (always-show &rest body)
   "Show GnuPG result to user for confirmation.
 
 (defmacro gpg-show-result (always-show &rest body)
   "Show GnuPG result to user for confirmation.


@@ -751,6 +775,8 @@ evaluates BODY, like `progn'.  If BODY evaluates to `nil' (or
      (unwind-protect
         (gpg-show-result-buffer ,always-show (progn ,@body))
        (kill-buffer gpg-result-buffer))))
      (unwind-protect
         (gpg-show-result-buffer ,always-show (progn ,@body))
        (kill-buffer gpg-result-buffer))))

+(put 'gpg-show-result 'lisp-indent-function 1)
+(put 'gpg-show-result 'edebug-form-spec '(body))

 
 ;;; Passphrase handling:
 
 
 ;;; Passphrase handling:
 


@@ -774,22 +800,28 @@ evaluates BODY, like `progn'.  If BODY evaluates to `nil' (or
 (defun gpg-passphrase-forget ()
   "Forget stored passphrase."
   (interactive)
 (defun gpg-passphrase-forget ()
   "Forget stored passphrase."
   (interactive)

-  (cancel-timer gpg-passphrase-timer)
-  (gpg-passphrase-clear-string gpg-passphrase)
-  (setq gpg-passphrase nil))
+  (when gpg-passphrase
+    (cancel-timer gpg-passphrase-timer)
+    (setq gpg-passphrase-timer nil)
+    (gpg-passphrase-clear-string gpg-passphrase)
+    (setq gpg-passphrase nil)))

 
 (defun gpg-passphrase-store (passphrase)
   "Store PASSPHRASE in cache.
 Updates the timeout for clearing the cache to `gpg-passphrase-timeout'."
   (unless (equal gpg-passphrase-timeout 0)
 
 (defun gpg-passphrase-store (passphrase)
   "Store PASSPHRASE in cache.
 Updates the timeout for clearing the cache to `gpg-passphrase-timeout'."
   (unless (equal gpg-passphrase-timeout 0)

+    (if (null gpg-passphrase-timer)
+       (setq gpg-passphrase-timer (timer-create)))

     (timer-set-time gpg-passphrase-timer 
                    (timer-relative-time (current-time) 
                                         gpg-passphrase-timeout))
     (timer-set-function gpg-passphrase-timer 'gpg-passphrase-forget)
     (timer-set-time gpg-passphrase-timer 
                    (timer-relative-time (current-time) 
                                         gpg-passphrase-timeout))
     (timer-set-function gpg-passphrase-timer 'gpg-passphrase-forget)

-    (timer-activate gpg-passphrase-timer)
+    (unless (and (fboundp 'itimer-live-p)
+                (itimer-live-p gpg-passphrase-timer))
+      (timer-activate gpg-passphrase-timer))

     (setq gpg-passphrase passphrase))
   passphrase)
     (setq gpg-passphrase passphrase))
   passphrase)

-  
+

 (defun gpg-passphrase-read ()
   "Read a passphrase and remember it for some time."
   (interactive)
 (defun gpg-passphrase-read ()
   "Read a passphrase and remember it for some time."
   (interactive)


@@ -1079,12 +1111,7 @@ documentation for details)."
 
 (defun gpg-key-lessp (a b)
   "Returns t if primary user ID of A is less than B."
 
 (defun gpg-key-lessp (a b)
   "Returns t if primary user ID of A is less than B."

-  (let ((res (compare-strings (gpg-key-primary-user-id a) 0 nil
-                             (gpg-key-primary-user-id b) 0 nil
-                             t)))
-    (if (eq res t)
-       nil
-      (< res 0))))
+  (string-lessp (gpg-key-primary-user-id a) (gpg-key-primary-user-id b) ))

 
 ;;; Accessing the key database:
 
 
 ;;; Accessing the key database:
 


@@ -1109,7 +1136,7 @@ documentation for details)."
 
 (defun gpg-key-list-keys-parse-line ()
   "Parse the line in the current buffer and return a vector of fields."
 
 (defun gpg-key-list-keys-parse-line ()
   "Parse the line in the current buffer and return a vector of fields."

-  (let* ((eol (line-end-position))
+  (let* ((eol (gpg-point-at-eol))

         (v (if (eolp)
                nil
              (vector
         (v (if (eolp)
                nil
              (vector


@@ -1152,6 +1179,14 @@ documentation for details)."
     (?u . trust-ultimate))
   "Alist mapping GnuPG trust value short forms to long symbols.")
 
     (?u . trust-ultimate))
   "Alist mapping GnuPG trust value short forms to long symbols.")
 

+(defconst gpg-unabbrev-trust-alist
+  '(("TRUST_UNDEFINED" . trust-undefined)
+    ("TRUST_NEVER"     . trust-none)
+    ("TRUST_MARGINAL"  . trust-marginal)
+    ("TRUST_FULLY"     . trust-full)
+    ("TRUST_ULTIMATE"  . trust-ultimate))
+  "Alist mapping capitalized GnuPG trust values to long symbols.")
+

 (defmacro gpg-key-list-keys-in-buffer-store ()
   '(when primary-user-id
      (sort user-id 'string-lessp)
 (defmacro gpg-key-list-keys-in-buffer-store ()
   '(when primary-user-id
      (sort user-id 'string-lessp)