Fix bugs relating to handling of messages whose bodies have been
authorChris Hanson <org/chris-hanson/cph>
Thu, 13 Nov 1997 08:01:59 +0000 (08:01 +0000)
committerChris Hanson <org/chris-hanson/cph>
Thu, 13 Nov 1997 08:01:59 +0000 (08:01 +0000)
removed from the server.

v7/src/edwin/nntp.scm

index 0ad7ffbe5a00a8ffbc27d73812a43591886091dd..255f5d456bde268107748a67eb0b00162f32553f 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: nntp.scm,v 1.16 1997/11/04 11:02:07 cph Exp $
+;;;    $Id: nntp.scm,v 1.17 1997/11/13 08:01:59 cph Exp $
 ;;;
 ;;;    Copyright (c) 1995-97 Massachusetts Institute of Technology
 ;;;
     (if number
        (let ((gdbf (news-group:body-gdbf group #t)))
          (if gdbf
-             (write-string (or (gdbm-fetch gdbf number)
-                               (pre-read-body group number))
-                           port)
+             (let ((body
+                    (or (gdbm-fetch gdbf number)
+                        (pre-read-body group number))))
+               (and body
+                    (begin
+                      (write-string body port)
+                      #t)))
              (begin
                (maybe-switch-groups group)
                (nntp-body-command (news-group:connection group)
               (gdbm-fetch gdbf (news-header:message-id header)))))))
 
 (define (pre-read-body group key)
-  (let ((datum
-        (with-string-output-port
-          (lambda (port)
-            (nntp-body-command (news-group:connection group)
-                               key
-                               port)))))
-    (gdbm-store (news-group:body-gdbf group #t) key datum GDBM_REPLACE)
-    datum))
+  (let ((valid?))
+    (let ((datum
+          (with-string-output-port
+            (lambda (port)
+              (maybe-switch-groups group)
+              (set! valid?
+                    (nntp-body-command (news-group:connection group)
+                                       key
+                                       port))
+              unspecific))))
+      (and valid?
+          (begin
+            (gdbm-store (news-group:body-gdbf group #t) key datum
+                        GDBM_REPLACE)
+            datum)))))
 \f
 (define (news-group:purge-pre-read-headers group predicate)
   (if (gdbm-available?)
                        (let ((header
                               (news-group:id->header
                                group id allow-server-probes?)))
-                         (and header
+                         (and (news-header? header)
                               (begin
                                 (if (eq? (hash-table/get id-table id #t)
                                          #t)