2000-12-15 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
[gnus] / contrib / gpg.el
index c7b5763..b967628 100644 (file)
@@ -7,7 +7,7 @@
 ;; Keywords: crypto
 ;; Created: 2000-04-15
 
-;; $Id: gpg.el,v 6.2 2000/10/31 22:16:42 zsh Exp $
+;; $Id: gpg.el,v 1.7 2000/12/15 04:50:15 zsh Exp $
 
 ;; This file is NOT (yet?) part of GNU Emacs.
 
 (eval-when-compile 
   (require 'cl))
 
+(defalias 'gpg-point-at-eol
+  (if (fboundp 'point-at-eol)
+      'point-at-eol
+    'line-end-position))
+
 ;;;; Customization:
 
 ;;; Customization: Groups:
 
 ;;; 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)."
@@ -304,6 +316,25 @@ charsets or line endings; the input data shall be treated as binary."
            (string :format "%v"))))
   :group 'gpg-commands)
 
+(defcustom gpg-command-verify-cleartext
+  '(gpg . ("--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
+and/or standard error.  The program shall not convert charsets or line
+endings; the input data shall be treated as binary."
+  :tag "Cleartext Verify Command"
+  :type '(cons 
+         gpg-command-program
+         (repeat 
+          :tag "Arguments"
+          (choice 
+           :format "%[Type%] %v"
+           (const :tag "Insert name of file containing the message here." 
+                  :value message-file)
+           (string :format "%v"))))
+  :group 'gpg-commands)
+
 (defcustom gpg-command-decrypt
   '(gpg . ("--decrypt" "--batch" "--passphrase-fd=0"))
   "Command to decrypt a message.
@@ -577,19 +608,23 @@ 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))))))
+(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"
-  (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.
-      (unless (eq (file-modes gpg-temp-directory) 448) ; 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 must have mode 0700."))
       (setq name (make-temp-name name))
       (let ((mode (default-file-modes)))
@@ -630,6 +665,8 @@ arguments."
            (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:
 
@@ -684,7 +721,7 @@ to this file."
                 (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)
@@ -732,6 +769,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))))
+(put 'gpg-show-result 'lisp-indent-function 1)
+(put 'gpg-show-result 'edebug-form-spec '(body))
 
 ;;; Passphrase handling:
 
@@ -767,10 +806,12 @@ Updates the timeout for clearing the cache to `gpg-passphrase-timeout'."
                    (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)
-  
+
 (defun gpg-passphrase-read ()
   "Read a passphrase and remember it for some time."
   (interactive)
@@ -821,6 +862,39 @@ buffer RESULT for details."
            nil)
        t))))
 
+;;;###autoload
+(defun gpg-verify-cleartext (message result)
+  "Verify message in buffer MESSAGE.
+Returns t if everything worked out well, nil otherwise.  Consult
+buffer RESULT for details.
+
+NOTE: Use of this function is deprecated."
+  (interactive "bBuffer containing message: \nbBuffor for result: ")
+  (gpg-with-temp-files 1
+    (let* ((msg-file    (nth 0 gpg-temp-files))
+          (cmd (gpg-exec-path gpg-command-verify-cleartext))
+          (args (gpg-build-arg-list (cdr gpg-command-verify-cleartext)
+                                    `((message-file . ,msg-file))))
+          res)
+      (with-temp-file msg-file 
+       (buffer-disable-undo)
+       (apply 'insert-buffer-substring (if (listp message)
+                                           message
+                                         (list message))))
+      (setq res (apply 'call-process-region
+                      (point-min) (point-min) ; no data
+                      cmd
+                      nil              ; don't delete
+                      result
+                      nil              ; don't display
+                      args))
+      (if (or (stringp res) (> res 0))
+         ;; Signal or abnormal exit.
+         (with-current-buffer result
+           (insert (format "\nCommand exit status: %s\n" res))
+           nil)
+       t))))
+
 ;;;###autoload
 (defun gpg-decrypt (ciphertext plaintext result &optional passphrase)
   "Decrypt buffer CIPHERTEXT to buffer PLAINTEXT.
@@ -1027,12 +1101,7 @@ documentation for details)."
 
 (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:
 
@@ -1057,7 +1126,7 @@ documentation for details)."
 
 (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