From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 26 Oct 2000 15:05:03 +0000 (+0000)
Subject: Fix bugs in address parsing, reported by hal.
X-Git-Tag: 20090517-FFI~3219
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=523ecfa9aeddc0d0e81e8c638fe01ed2b860082e;p=mit-scheme.git

Fix bugs in address parsing, reported by hal.
---

diff --git a/v7/src/edwin/rfc822.scm b/v7/src/edwin/rfc822.scm
index e2c732002..cc28a268a 100644
--- 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