(shr-tag-li): Get <li> indentation right.

[gnus] / lisp / pgg.el

diff --git a/lisp/pgg.el b/lisp/pgg.el
index 468fbc6..f64c408 100644 (file)
--- a/lisp/pgg.el
+++ b/lisp/pgg.el
@@ -1,7 +1,7 @@
 ;;; pgg.el --- glue for the various PGP implementations.
 
 ;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
 ;;; pgg.el --- glue for the various PGP implementations.
 
 ;; Copyright (C) 1999, 2000, 2002, 2003, 2004,

-;;   2005, 2006 Free Software Foundation, Inc.
+;;   2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.

 
 ;; Author: Daiki Ueno <ueno@unixuser.org>
 ;; Symmetric encryption added by: Sascha Wilde <wilde@sha-bang.de>
 
 ;; Author: Daiki Ueno <ueno@unixuser.org>
 ;; Symmetric encryption added by: Sascha Wilde <wilde@sha-bang.de>


@@ -10,10 +10,10 @@
 
 ;; This file is part of GNU Emacs.
 
 
 ;; This file is part of GNU Emacs.
 

-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify

 ;; it under the terms of the GNU General Public License as published by
 ;; it under the terms of the GNU General Public License as published by

-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.

 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of


@@ -21,25 +21,105 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License

-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

 
 ;;; Commentary:
 
 
 ;;; Commentary:
 

+;; This file is on its way to obsolescence, waiting for allout.el to
+;; switch to EPG.
+

 ;;; Code:
 
 (require 'pgg-def)
 (require 'pgg-parse)
 ;;; Code:
 
 (require 'pgg-def)
 (require 'pgg-parse)

-(require 'password)
+(autoload 'run-at-time "timer")

 
 ;; Don't merge these two `eval-when-compile's.
 (eval-when-compile
 
 ;; Don't merge these two `eval-when-compile's.
 (eval-when-compile

+  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))

   (require 'cl))
 
 ;;; @ utility functions
 ;;;
 
   (require 'cl))
 
 ;;; @ utility functions
 ;;;
 

+(eval-when-compile
+  (when (featurep 'xemacs)
+    (defmacro pgg-run-at-time-1 (time repeat function args)
+      (if (condition-case nil
+             (let ((delete-itimer 'delete-itimer)
+                   (itimer-driver-start 'itimer-driver-start)
+                   (itimer-value 'itimer-value)
+                   (start-itimer 'start-itimer))
+               (unless (or (symbol-value 'itimer-process)
+                           (symbol-value 'itimer-timer))
+                 (funcall itimer-driver-start))
+               ;; Check whether there is a bug to which the difference of
+               ;; the present time and the time when the itimer driver was
+               ;; woken up is subtracted from the initial itimer value.
+               (let* ((inhibit-quit t)
+                      (ctime (current-time))
+                      (itimer-timer-last-wakeup
+                       (prog1
+                           ctime
+                         (setcar ctime (1- (car ctime)))))
+                      (itimer-list nil)
+                      (itimer (funcall start-itimer "pgg-run-at-time"
+                                       'ignore 5)))
+                 (sleep-for 0.1) ;; Accept the timeout interrupt.
+                 (prog1
+                     (> (funcall itimer-value itimer) 0)
+                   (funcall delete-itimer itimer))))
+           (error nil))
+         `(let ((time ,time))
+            (apply #'start-itimer "pgg-run-at-time"
+                   ,function (if time (max time 1e-9) 1e-9)
+                   ,repeat nil t ,args))
+       `(let ((time ,time)
+              (itimers (list nil)))
+          (setcar
+           itimers
+           (apply #'start-itimer "pgg-run-at-time"
+                  (lambda (itimers repeat function &rest args)
+                    (let ((itimer (car itimers)))
+                      (if repeat
+                          (progn
+                            (set-itimer-function
+                             itimer
+                             (lambda (itimer repeat function &rest args)
+                               (set-itimer-restart itimer repeat)
+                               (set-itimer-function itimer function)
+                               (set-itimer-function-arguments itimer args)
+                               (apply function args)))
+                            (set-itimer-function-arguments
+                             itimer
+                             (append (list itimer repeat function) args)))
+                        (set-itimer-function
+                         itimer
+                         (lambda (itimer function &rest args)
+                           (delete-itimer itimer)
+                           (apply function args)))
+                        (set-itimer-function-arguments
+                         itimer
+                         (append (list itimer function) args)))))
+                  1e-9 (if time (max time 1e-9) 1e-9)
+                  nil t itimers ,repeat ,function ,args)))))))
+
+(eval-and-compile
+  (if (featurep 'xemacs)
+      (progn
+       (defun pgg-run-at-time (time repeat function &rest args)
+         "Emulating function run as `run-at-time'.
+TIME should be nil meaning now, or a number of seconds from now.
+Return an itimer object which can be used in either `delete-itimer'
+or `cancel-timer'."
+         (pgg-run-at-time-1 time repeat function args))
+       (defun pgg-cancel-timer (timer)
+         "Emulate cancel-timer for xemacs."
+         (let ((delete-itimer 'delete-itimer))
+           (funcall delete-itimer timer))))
+    (defalias 'pgg-run-at-time 'run-at-time)
+    (defalias 'pgg-cancel-timer 'cancel-timer)))
+

 (defun pgg-invoke (func scheme &rest args)
   (progn
     (require (intern (format "pgg-%s" scheme)))
 (defun pgg-invoke (func scheme &rest args)
   (progn
     (require (intern (format "pgg-%s" scheme)))


@@ -88,11 +168,19 @@ is true, or else the output buffer is displayed."
 (defun pgg-display-error-buffer ()
   "Pop up an error buffer indicating the reason for an en/decryption failure."
   (let ((temp-buffer-show-function
 (defun pgg-display-error-buffer ()
   "Pop up an error buffer indicating the reason for an en/decryption failure."
   (let ((temp-buffer-show-function

-        (function pgg-temp-buffer-show-function)))
+         (function pgg-temp-buffer-show-function)))

     (with-output-to-temp-buffer pgg-echo-buffer
       (set-buffer standard-output)
       (insert-buffer-substring pgg-errors-buffer))))
 
     (with-output-to-temp-buffer pgg-echo-buffer
       (set-buffer standard-output)
       (insert-buffer-substring pgg-errors-buffer))))
 

+(defvar pgg-passphrase-cache (make-vector 7 0))
+
+(defvar pgg-pending-timers (make-vector 7 0)
+  "Hash table for managing scheduled pgg cache management timers.
+
+We associate key and timer, so the timer can be cancelled if a new
+timeout for the key is set while an old one is still pending.")
+

 (defun pgg-read-passphrase (prompt &optional key notruncate)
   "Using PROMPT, obtain passphrase for KEY from cache or user.
 
 (defun pgg-read-passphrase (prompt &optional key notruncate)
   "Using PROMPT, obtain passphrase for KEY from cache or user.
 


@@ -101,9 +189,21 @@ Truncate the key to 8 trailing characters unless NOTRUNCATE is true
 
 Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry'
 regulate cache behavior."
 
 Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry'
 regulate cache behavior."

-  (password-read prompt (if notruncate
-                           key
-                         (pgg-truncate-key-identifier key))))
+  (or (pgg-read-passphrase-from-cache key notruncate)
+      (read-passwd prompt)))
+
+(defun pgg-read-passphrase-from-cache (key &optional notruncate)
+  "Obtain passphrase for KEY from time-limited passphrase cache.
+
+Truncate the key to 8 trailing characters unless NOTRUNCATE is true
+\(default false).
+
+Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry'
+regulate cache behavior."
+  (and pgg-cache-passphrase
+       key (or notruncate
+                (setq key (pgg-truncate-key-identifier key)))
+       (symbol-value (intern-soft key pgg-passphrase-cache))))

 
 (defun pgg-add-passphrase-to-cache (key passphrase &optional notruncate)
   "Associate KEY with PASSPHRASE in time-limited passphrase cache.
 
 (defun pgg-add-passphrase-to-cache (key passphrase &optional notruncate)
   "Associate KEY with PASSPHRASE in time-limited passphrase cache.


@@ -113,11 +213,27 @@ Truncate the key to 8 trailing characters unless NOTRUNCATE is true
 
 Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry'
 regulate cache behavior."
 
 Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry'
 regulate cache behavior."

-  (let ((password-cache-expiry pgg-passphrase-cache-expiry))
-    (password-cache-add (if notruncate
-                           key
-                         (pgg-truncate-key-identifier key))
-                       passphrase)))
+
+  (let* ((key (if notruncate key (pgg-truncate-key-identifier key)))
+         (interned-timer-key (intern-soft key pgg-pending-timers))
+         (old-timer (symbol-value interned-timer-key))
+         new-timer)
+    (when old-timer
+        (cancel-timer old-timer)
+        (unintern interned-timer-key pgg-pending-timers))
+    (set (intern key pgg-passphrase-cache)
+         passphrase)
+    (set (intern key pgg-pending-timers)
+         (pgg-run-at-time pgg-passphrase-cache-expiry nil
+                           #'pgg-remove-passphrase-from-cache
+                           key notruncate))))
+
+(if (fboundp 'clear-string)
+    (defalias 'pgg-clear-string 'clear-string)
+  (defun pgg-clear-string (string)
+    (fillarray string ?_)))
+
+(declare-function pgg-clear-string "pgg" (string))

 
 (defun pgg-remove-passphrase-from-cache (key &optional notruncate)
   "Omit passphrase associated with KEY in time-limited passphrase cache.
 
 (defun pgg-remove-passphrase-from-cache (key &optional notruncate)
   "Omit passphrase associated with KEY in time-limited passphrase cache.


@@ -132,9 +248,16 @@ references to it.
 
 Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry'
 regulate cache behavior."
 
 Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry'
 regulate cache behavior."

-  (password-cache-remove (if notruncate
-                            key
-                          (pgg-truncate-key-identifier key))))
+  (let* ((passphrase (pgg-read-passphrase-from-cache key notruncate))
+         (key (if notruncate key (pgg-truncate-key-identifier key)))
+         (interned-timer-key (intern-soft key pgg-pending-timers))
+         (old-timer (symbol-value interned-timer-key)))
+    (when passphrase
+      (pgg-clear-string passphrase)
+      (unintern key pgg-passphrase-cache))
+    (when old-timer
+      (pgg-cancel-timer old-timer)
+      (unintern interned-timer-key pgg-pending-timers))))

 
 (defmacro pgg-convert-lbt-region (start end lbt)
   `(let ((pgg-conversion-end (set-marker (make-marker) ,end)))
 
 (defmacro pgg-convert-lbt-region (start end lbt)
   `(let ((pgg-conversion-end (set-marker (make-marker) ,end)))


@@ -296,7 +419,7 @@ If the optional 3rd argument CLEARTEXT is non-nil, it does not create
 a detached signature.
 
 If this function is called interactively, CLEARTEXT is enabled
 a detached signature.
 
 If this function is called interactively, CLEARTEXT is enabled

-and the the output is displayed.
+and the output is displayed.

 
 If optional PASSPHRASE is not specified, it will be obtained from the
 passphrase cache or user."
 
 If optional PASSPHRASE is not specified, it will be obtained from the
 passphrase cache or user."


@@ -305,7 +428,7 @@ passphrase cache or user."
                  (pgg-invoke "sign-region" (or pgg-scheme pgg-default-scheme)
                              (point-min) (point-max)
                              (or (interactive-p) cleartext)
                  (pgg-invoke "sign-region" (or pgg-scheme pgg-default-scheme)
                              (point-min) (point-max)
                              (or (interactive-p) cleartext)

-                             passphrase))))
+                              passphrase))))

     (when (interactive-p)
       (pgg-display-output-buffer start end status))
     status))
     (when (interactive-p)
       (pgg-display-output-buffer start end status))
     status))


@@ -321,7 +444,7 @@ If optional arguments START and END are specified, only sign data
 within the region.
 
 If this function is called interactively, CLEARTEXT is enabled
 within the region.
 
 If this function is called interactively, CLEARTEXT is enabled

-and the the output is displayed.
+and the output is displayed.

 
 If optional PASSPHRASE is not specified, it will be obtained from the
 passphrase cache or user."
 
 If optional PASSPHRASE is not specified, it will be obtained from the
 passphrase cache or user."


@@ -329,8 +452,8 @@ passphrase cache or user."
   (let* ((start (or start (point-min)))
         (end (or end (point-max)))
         (status (pgg-sign-region start end
   (let* ((start (or start (point-min)))
         (end (or end (point-max)))
         (status (pgg-sign-region start end

-                                 (or (interactive-p) cleartext)
-                                 passphrase)))
+                                  (or (interactive-p) cleartext)
+                                  passphrase)))

     (when (interactive-p)
       (pgg-display-output-buffer start end status))
     status))
     (when (interactive-p)
       (pgg-display-output-buffer start end status))
     status))


@@ -348,8 +471,8 @@ signer's public key from `pgg-default-keyserver-address'."
          (if (null signature) nil
            (with-temp-buffer
              (buffer-disable-undo)
          (if (null signature) nil
            (with-temp-buffer
              (buffer-disable-undo)

-             (if (fboundp 'set-buffer-multibyte)
-                 (set-buffer-multibyte nil))
+             (unless (featurep 'xemacs)
+               (set-buffer-multibyte nil))

              (insert-file-contents signature)
              (cdr (assq 2 (pgg-decode-armor-region
                            (point-min)(point-max)))))))
              (insert-file-contents signature)
              (cdr (assq 2 (pgg-decode-armor-region
                            (point-min)(point-max)))))))


@@ -475,5 +598,4 @@ within the region."
 
 (provide 'pgg)
 
 
 (provide 'pgg)
 

-;;; arch-tag: 9cc705dd-1e6a-4c90-8dce-c3561f9a2cf4

 ;;; pgg.el ends here
 ;;; pgg.el ends here