From 96471cd375f21793da45211e0ca45f15c31c18dc Mon Sep 17 00:00:00 2001
From: "Taylor R. Campbell" <net/mumble/campbell>
Date: Tue, 2 Sep 2008 22:22:07 +0000
Subject: [PATCH] When parsing address lists, disregard all-whitespace entries.

---
 v7/src/edwin/rfc822.scm | 104 ++++++++++++++++++++++++----------------
 1 file changed, 62 insertions(+), 42 deletions(-)

diff --git a/v7/src/edwin/rfc822.scm b/v7/src/edwin/rfc822.scm
index 74818dbcd..2bd58274c 100644
--- a/v7/src/edwin/rfc822.scm
+++ b/v7/src/edwin/rfc822.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rfc822.scm,v 3.12 2008/08/23 17:44:54 riastradh Exp $
+$Id: rfc822.scm,v 3.13 2008/09/02 22:22:07 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -76,21 +76,28 @@ USA.
   (decorated-string-append "" ", " "" addresses))
 
 (define (rfc822:string->addresses string)
-  (let ((tokens (rfc822:string->non-ignored-tokens string)))
-    (let ((address-list (rfc822:strip-quoted-names tokens)))
-      (if (and address-list (null? (cdr address-list)))
-	  (car address-list)
-	  (rfc822:split-address-tokens tokens)))))
+  (let ((address-list
+         (rfc822:strip-quoted-names
+          (rfc822:string->non-ignored-tokens string))))
+    (if (and address-list
+             (for-all? (cdr address-list)
+               (lambda (token) (eqv? token #\,))))
+        (car address-list)
+        (rfc822:split-address-tokens (rfc822:string->tokens string)))))
 
 (define (rfc822:string->named-addresses string)
   (rfc822:split-address-tokens (rfc822:string->tokens string)))
 
 (define (rfc822:split-address-tokens tokens)
   (let recur ((tokens tokens))
-    (receive (tokens tokens*)
+    (receive (address-tokens tokens)
 	(span (lambda (token) (not (eqv? token #\,))) tokens)
-      (cons (string-trim (rfc822:tokens->string tokens))
-	    (if (pair? tokens*) (recur (cdr tokens*)) '())))))
+      (let ((name (string-trim (rfc822:tokens->string address-tokens)))
+            (tokens (drop-while (lambda (token) (eqv? token #\,)) tokens)))
+        (let ((continue (lambda () (if (pair? tokens) (recur tokens) '()))))
+          (if (string-null? name)
+              (continue)
+              (cons name (continue))))))))
 
 (define (rfc822:canonicalize-address-string string)
   (rfc822:addresses->string (rfc822:string->addresses string)))
@@ -316,39 +323,52 @@ USA.
 (define (rfc822:strip-quoted-names tokens)
   (rfc822:parse-list tokens #\,
     (lambda (tokens)
-      (or (rfc822:parse-addr-spec tokens)
-	  (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))))))))))
+      ((lambda (result)
+         (and (pair? result)
+              (cons (car result) (rfc822:skip-commas (cdr result)))))
+       (or (rfc822:parse-addr-spec tokens)
+           (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:skip-commas tokens)
+  (if (and (pair? tokens)
+           (eqv? #\, (car tokens)))
+      (let loop ((tokens tokens))
+        (let ((tokens* (cdr tokens)))
+          (if (and (pair? tokens*)
+                   (eqv? #\, (car tokens*)))
+              (loop tokens*)
+              tokens)))
+      tokens))
 
 (define (rfc822:strip-comments tokens)
   (list-transform-negative tokens
-- 
2.25.1