Re: closing all inactive server connections

[Katsumi Yamaoka <yamaoka@jpl.org>]

[-- Attachment #1: Type: text/plain, Size: 124 bytes --]

>>>>> Katsumi Yamaoka wrote:

> So, I wish Simon and Ted to take on this.

Sorry, I forgot to attach a patch.  Here it is:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Patch for imap.el --]
[-- Type: text/x-patch, Size: 2212 bytes --]

--- imap.el~	2007-01-24 07:15:37 +0000
+++ imap.el	2007-08-16 07:10:13 +0000
@@ -273,6 +273,14 @@
   :group 'imap
   :type 'boolean)
 
+(defcustom imap-logout-timeout nil
+  "Close server immediately if it can't logout in this number of seconds.
+If it is nil, never close server until logout completes."
+  :version "23.0" ;; No Gnus.
+  :group 'imap
+  :type '(choice (const :tag "No timeout" nil)
+		 (number :value 1.0)))
+
 ;; Various variables.
 
 (defvar imap-fetch-data-hook nil
@@ -554,7 +562,7 @@
 				(not (string-match "failed" response))))
 		(setq done process)
 	      (if (memq (process-status process) '(open run))
-		  (imap-send-command "LOGOUT"))
+		  (imap-logout))
 	      (delete-process process)
 	      nil)))))
     done))
@@ -629,7 +637,7 @@
 				(not (string-match "failed" response))))
 		(setq done process)
 	      (if (memq (process-status process) '(open run))
-		  (imap-send-command "LOGOUT"))
+		  (imap-logout))
 	      (delete-process process)
 	      nil)))))
     done))
@@ -1188,7 +1196,7 @@
   (with-current-buffer (or buffer (current-buffer))
     (when (imap-opened)
       (condition-case nil
-	  (imap-send-command-wait "LOGOUT")
+	  (imap-logout-wait)
 	(quit nil)))
     (when (and imap-process
 	       (memq (process-status imap-process) '(open run)))
@@ -1243,6 +1251,28 @@
 (defun imap-send-command-wait (command &optional buffer)
   (imap-wait-for-tag (imap-send-command command buffer) buffer))
 
+(defun imap-logout (&optional buffer)
+  (if imap-logout-timeout
+      (eval `(with-timeout (imap-logout-timeout
+			    (condition-case nil
+				(with-current-buffer ,(or buffer
+							  (current-buffer))
+				  (delete-process imap-process))
+			      (error)))
+	       (imap-send-command "LOGOUT" buffer)))
+    (imap-send-command "LOGOUT" buffer)))
+
+(defun imap-logout-wait (&optional buffer)
+  (if imap-logout-timeout
+      (eval `(with-timeout (imap-logout-timeout
+			    (condition-case nil
+				(with-current-buffer ,(or buffer
+							  (current-buffer))
+				  (delete-process imap-process))
+			      (error)))
+	       (imap-send-command-wait "LOGOUT" buffer)))
+    (imap-send-command-wait "LOGOUT" buffer)))
+
 \f
 ;; Mailbox functions: