From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 21 Jun 1998 09:05:17 +0000 (+0000)
Subject: If NNTP server closes connection, attempt to notice this and recover
X-Git-Tag: 20090517-FFI~4781
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=952b5f31a3ead16c0e75954e8acf60d67bc2e5cd;p=mit-scheme.git

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 b5054eb3b..e5746e1e5 100644
--- 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)))))
+
+;;;; 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)))))
 
 ;;;; 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)