Fix bugs in address parsing, reported by hal.

diff --git a/v7/src/edwin/rfc822.scm b/v7/src/edwin/rfc822.scm
index e2c73200262c5de5fb6e530446a77aa7b3703fe5..cc28a268afa5669a2ba247eb61fc14a485f2d9b5 100644 (file)
--- a/v7/src/edwin/rfc822.scm
+++ b/v7/src/edwin/rfc822.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: rfc822.scm,v 3.2 2000/06/08 18:02:58 cph Exp $
+;;; $Id: rfc822.scm,v 3.3 2000/10/26 15:05:03 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -66,7 +66,19 @@
          (rfc822:strip-whitespace! (rfc822:string->tokens string)))))
     (if (and address-list (null? (cdr address-list)))
        (car address-list)
-       (map string-trim (burst-string string #\, #f)))))
+       (map (lambda (string)
+              (let ((string (string-trim string)))
+                (let ((end (string-length string)))
+                  (let loop ((start 0))
+                    (let ((index
+                           (substring-find-next-char-in-set
+                            string start end char-set:whitespace)))
+                      (if index
+                          (begin
+                            (string-set! string index #\space)
+                            (loop (fix:+ index 1)))))))
+                string))
+            (burst-string string #\, #f)))))
 
 (define (rfc822:canonicalize-address-string string)
   (rfc822:addresses->string (rfc822:string->addresses string)))
@@ -298,35 +310,38 @@
   (rfc822:parse-list tokens #\,
     (lambda (tokens)
       (or (rfc822:parse-addr-spec tokens)
-         (let ((word (rfc822:parse-word tokens)))
-           (and word
-                (let ((tokens
-                       (let loop ((tokens (cdr word)))
-                         (let ((word (rfc822:parse-word tokens)))
-                           (if word
-                               (loop (cdr word))
-                               tokens)))))
-                  (and (pair? tokens)
-                       (eqv? #\< (car tokens))
-                       (let ((addr-spec
-                              (rfc822:parse-addr-spec
-                               (let ((domains
-                                      (rfc822:parse-list (cdr tokens) #\,
-                                        (lambda (tokens)
-                                          (and (pair? tokens)
-                                               (eqv? #\@ (car tokens))
-                                               (rfc822:parse-domain
-                                                (cdr tokens)))))))
-                                 (if (and domains
-                                          (pair? (cdr domains))
-                                          (eqv? #\: (cadr domains)))
-                                     (cddr domains)
-                                     (cdr tokens))))))
-                         (and addr-spec
-                              (pair? (cdr addr-spec))
-                              (eqv? #\> (cadr addr-spec))
-                              (cons (car addr-spec)
-                                    (cddr addr-spec))))))))))))
+         (let ((tokens
+                (let loop
+                    ((tokens
+                      (let ((word (rfc822:parse-word tokens)))
+                        (if word
+                            (cdr word)
+                            tokens))))
+                  (let ((word (rfc822:parse-word tokens)))
+                    (if word
+                        (loop (cdr word))
+                        tokens)))))
+           (and (pair? tokens)
+                (eqv? #\< (car tokens))
+                (let ((addr-spec
+                       (rfc822:parse-addr-spec
+                        (let ((domains
+                               (rfc822:parse-list (cdr tokens) #\,
+                                 (lambda (tokens)
+                                   (and (pair? tokens)
+                                        (eqv? #\@ (car tokens))
+                                        (rfc822:parse-domain
+                                         (cdr tokens)))))))
+                          (if (and domains
+                                   (pair? (cdr domains))
+                                   (eqv? #\: (cadr domains)))
+                              (cddr domains)
+                              (cdr tokens))))))
+                  (and addr-spec
+                       (pair? (cdr addr-spec))
+                       (eqv? #\> (cadr addr-spec))
+                       (cons (car addr-spec)
+                             (cddr addr-spec))))))))))
 
 (define (rfc822:strip-comments tokens)
   (list-transform-negative tokens