If NNTP server closes connection, attempt to notice this and recover

by reopening the connection.  Previously, we just signalled an error
and the user had to manually reopen.  Problem: the specific error code
to be returned by the server in this situation is not specified in the
RFC, so we must determine the value empirically.

diff --git a/v7/src/edwin/nntp.scm b/v7/src/edwin/nntp.scm
index b5054eb3bf6b3e0091778056abaab9d07ecfbcde..e5746e1e56c0e725b7a49334df64ab40e1b2711f 100644 (file)
--- a/v7/src/edwin/nntp.scm
+++ b/v7/src/edwin/nntp.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: nntp.scm,v 1.18 1998/02/23 05:37:47 cph Exp $
+;;;    $Id: nntp.scm,v 1.19 1998/06/21 09:05:17 cph Exp $
 ;;;
 ;;;    Copyright (c) 1995-98 Massachusetts Institute of Technology
 ;;;
@@ -361,28 +361,55 @@
                      (nntp-write-line connection line)
                      (loop)))))
            response)))))
+\f
+;;;; NNTP Errors
+
+(define condition-type:nntp-error
+  (make-condition-type 'NNTP-ERROR condition-type:error
+      '(RESPONSE)
+    (lambda (condition port)
+      (write-string "NNTP error: " port)
+      (write-string (nntp-error/response condition) port))))
+
+(define nntp-error/response
+  (condition-accessor condition-type:nntp-error 'RESPONSE))
+
+(define nntp-error
+  (condition-signaller condition-type:nntp-error
+                      '(RESPONSE)
+                      standard-error-handler))
 
-(define (nntp-error response)
-  (error "NNTP error:" response))
+(define (nntp-protect connection thunk)
+  (let ((try
+        (lambda ()
+          (let ((abort? #t))
+            (dynamic-wind (lambda ()
+                            (set! abort? #t)
+                            unspecific)
+                          (lambda ()
+                            (if (nntp-connection:closed? connection)
+                                (nntp-connection:reopen connection))
+                            (let ((value (thunk)))
+                              (set! abort? #f)
+                              value))
+                          (lambda ()
+                            (if abort?
+                                (nntp-connection:close-1 connection))))))))
+    (call-with-current-continuation
+     (lambda (k)
+       (bind-condition-handler (list condition-type:nntp-error)
+          (lambda (condition)
+            ;; If the server closed the connection, try again.  This
+            ;; should automatically re-open the connection.
+            (case (nntp-response-number (nntp-error/response condition))
+              ((205 503)
+               (within-continuation k try))))
+        try)))))
 \f
 ;;;; NNTP I/O
 
 (define nntp-socket-buffer-size 4096)
 
-(define (nntp-protect connection thunk)
-  (let ((abort? #t))
-    (dynamic-wind (lambda ()
-                   (set! abort? #t)
-                   unspecific)
-                 (lambda ()
-                   (if (nntp-connection:closed? connection)
-                       (nntp-connection:reopen connection))
-                   (let ((value (thunk)))
-                     (set! abort? #f)
-                     value))
-                 (lambda ()
-                   (if abort? (nntp-connection:close-1 connection))))))
-
 (define (nntp-write-command connection string . strings)
   (let ((port (nntp-connection:port connection)))
     (output-port/write-string port string)