From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 22 May 2000 19:16:47 +0000 (+0000)
Subject: Add code to detect when the connection has been dropped.  This test is
X-Git-Tag: 20090517-FFI~3742
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=2ab5a5fbccd339a73ca0591f7c94dca06f305d65;p=mit-scheme.git

Add code to detect when the connection has been dropped.  This test is
performed by GUARANTEE-IMAP-CONNECTION-OPEN, and thus will be done at
the beginning of every IMAIL operation.  The code will transparently
close the connection and reopen it.  If a problem occurs during the
processing of the operation, an error will be signalled, as one would
expect.
---

diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index 9be79fd49..8cbe613c0 100644
--- a/v7/src/imail/imail-imap.scm
+++ b/v7/src/imail/imail-imap.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-imap.scm,v 1.70 2000/05/22 15:08:12 cph Exp $
+;;; $Id: imail-imap.scm,v 1.71 2000/05/22 19:16:47 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -285,7 +285,7 @@
 (define memoized-imap-connections '())
 
 (define (guarantee-imap-connection-open connection)
-  (if (imap-connection-port connection)
+  (if (test-imap-connection-open connection)
       #f
       (let ((url (imap-connection-url connection)))
 	(let ((port
@@ -317,6 +317,36 @@
 		  (error "Unable to log in:" response)))))
 	#t)))
 
+(define (test-imap-connection-open connection)
+  (let ((port (imap-connection-port connection)))
+    (and port
+	 (let* ((process
+		 (lambda ()
+		   (process-responses connection #f
+				      (dequeue-imap-responses connection))))
+		(lose
+		 (lambda ()
+		   (process)
+		   (close-imap-connection connection)
+		   #f)))
+	   (let loop ()
+	     (cond ((not (char-ready? port))
+		    (process)
+		    #t)
+		   ((eof-object? (peek-char port))
+		    (lose))
+		   (else
+		    (let ((response
+			   (ignore-errors
+			    (lambda ()
+			      (imap:read-server-response port)))))
+		      (if (or (condition? response)
+			      (begin
+				(enqueue-imap-response connection response)
+				(imap:response:bye? response)))
+			  (lose)
+			  (loop))))))))))
+
 (define (close-imap-connection connection)
   (let ((port
 	 (without-interrupts