Re: closing all inactive server connections

[Simon Josefsson <simon@josefsson.org>]

Katsumi Yamaoka <yamaoka@jpl.org> writes:

>>>>>> Simon Josefsson wrote:
>> Katsumi Yamaoka <yamaoka@jpl.org> writes:
>
>>> (while (and (memq (process-status PROCESS) '(open run))
>>>             (wait-for-a-string-that-the-PROCESS-returns))
>>>   (accept-process-output PROCESS 1)
>>>   (sit-for 1))
>>>
>>> This can be an infinite loop if the process-status keeps `open'
>>> or `run' even though the connection has actually died.
>
>> Can that happen?  Wouldn't that be an emacs bug?  Shouldn't
>> process-status return exit or closed if a connect/process has gone away?
>
> I meant that the /connection/ is the one between the frontend of
> Ted Zlatanov's local network (i.e., VPN) and the IMAP server (see
> http://article.gmane.org/gmane.emacs.gnus.general/64906).  In his
> case, the connection between Emacs and the frontend seems to be
> alive even after the connection between the frontend and the IMAP
> server dies.  So, ideally, what needs to be fixed should be
> the VPN program, not be Emacs or Gnus, I think, 

I agree.  The VPN should close the internal connection if the external
one is closed.

> and the plan I proposed was no more than a workaround.

Right.

> --- 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:
>  

This looks fine to me, although I haven't tested it.

/Simon