Add code to detect when the connection has been dropped. This test is
authorChris Hanson <org/chris-hanson/cph>
Mon, 22 May 2000 19:16:47 +0000 (19:16 +0000)
committerChris Hanson <org/chris-hanson/cph>
Mon, 22 May 2000 19:16:47 +0000 (19:16 +0000)
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.

v7/src/imail/imail-imap.scm

index 9be79fd4963dded2416ad5b65622f605fb5d0319..8cbe613c04e0866835ce46f6ea36a770a2211885 100644 (file)
@@ -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
 ;;;
 (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
                  (error "Unable to log in:" response)))))
        #t)))
 \f
+(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