From f6492cdbd6e364c94f03c36113d44a7fef9ace95 Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Tue, 13 Nov 2018 19:26:19 +0530
Subject: email: Discard angle brackets in address fields only.

* email/email.scm (define-angle-addr): New macro.
(unbracketed-angle-addr): New pattern.
(name-addr): Use unbracketed-angle-addr instead of angle-addr.
(post-process-mailbox): Do not trim angle brackets from address. That
is now handled by the grammar itself.
---
 email/email.scm | 32 ++++++++++++++++++++++----------
 1 file changed, 22 insertions(+), 10 deletions(-)

(limited to 'email')

diff --git a/email/email.scm b/email/email.scm
index 2c9dea4..df69394 100644
--- a/email/email.scm
+++ b/email/email.scm
@@ -253,13 +253,30 @@
 (define-peg-pattern addr-spec body
   (and local-part "@" domain))
 
-(define-peg-pattern angle-addr body
+(define-syntax-rule (define-angle-addr-pattern
+                      name opening-bracket closing-bracket)
+  (define-peg-pattern name body
+    (and (ignore (? cfws))
+         opening-bracket addr-spec closing-bracket
+         (ignore (? cfws)))))
+
+(define-angle-addr-pattern angle-addr "<" ">")
+
+;; When handling email addresses, we need to drop the angle
+;; brackets. But in the Received field we need to include the angle
+;; brackes. So, we define unbracketed-angle-addr, a variant of
+;; angle-addr in which the angle brackets are ignored.
+
+(define-angle-addr-pattern
+  unbracketed-angle-addr (ignore "<") (ignore ">"))
+
+(define-peg-pattern unbracketed-angle-addr body
   (and (ignore (? cfws))
-       "<" addr-spec ">"
+       (ignore "<") addr-spec (ignore ">")
        (ignore (? cfws))))
 
 (define-peg-pattern name-addr body
-  (and (? display-name) angle-addr))
+  (and (? display-name) unbracketed-angle-addr))
 
 (define-peg-pattern mailbox all
   (or name-addr addr-spec))
@@ -563,20 +580,15 @@ explained in RFC2045), and return that list."
                 (read-while port get-line-with-delimiter identity))))))
 
 (define (post-process-mailbox . args)
-  (define (trim-address address)
-    (string-trim-right
-     (string-trim (string-trim-both address) #\<)
-     #\>))
-
   (match args
     ;; name-addr email address
     (`(mailbox (display-name ,name) ,address)
      `((name . ,(decode-mime-encoded-word
                  (string-trim-both name)))
-       (address . ,(trim-address address))))
+       (address . ,(string-trim-both address))))
     ;; addr-spec email address
     (`(mailbox ,address)
-     `((address . ,(trim-address address))))
+     `((address . ,(string-trim-both address))))
     (_ (error "Failed to parse mailbox"))))
 
 (define (post-process-content-transfer-encoding _ value)
-- 
cgit v1.2.3