Ignore any received headers that don't parse correctly.

diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm
index d131661ee162b611a246fed9ae7e2ce61dbdf14b..8f67c48809f3bd2e4c58e69f43fc14cc19eafb39 100644 (file)
--- a/v7/src/imail/imail-core.scm
+++ b/v7/src/imail/imail-core.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-core.scm,v 1.82 2000/05/22 03:36:52 cph Exp $
+;;; $Id: imail-core.scm,v 1.83 2000/05/22 15:07:55 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -422,17 +422,28 @@
 (define-method message-internal-time ((message <message>))
   (let loop ((headers (get-all-header-fields message "received")) (winner #f))
     (if (pair? headers)
-       (call-with-values
-           (lambda ()
-             (rfc822:received-header-components
-              (header-field-value (car headers))))
-         (lambda (from by via with id for time)
-           from by via with id for     ;ignored
-           (loop (cdr headers)
-                 (if (or (not winner) (< time winner)) time winner))))
+       (loop (cdr headers)
+             (let ((time (received-header-time (car headers))))
+               (if (and time (or (not winner) (< time winner)))
+                   time
+                   winner)))
        (or winner
            (message-time message)))))
 
+(define (received-header-time header)
+  (let ((time
+        (ignore-errors
+         (lambda ()
+           (call-with-values
+               (lambda ()
+                 (rfc822:received-header-components
+                  (header-field-value header)))
+             (lambda (from by via with id for time)
+               from by via with id for ;ignored
+               time))))))
+    (and (not (condition? time))
+        time)))
+
 (define (message-time message)
   (let ((date (get-first-header-field-value message "date" #f)))
     (and date