From 3f61bc4bf0999e9b6ac6a48e4fa525716bfaaaf3 Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Mon, 1 Oct 2018 23:29:59 +0530
Subject: email: Do not discard trace fields.

* email/email.scm (angle-addr): Capture "<" and ">".
(parse-email-headers): Do not discard trace fields. Trim "<" and ">"
from angle-addr in mailbox, but not from trace fields.
---
 email/email.scm | 18 +++++++++---------
 1 file changed, 9 insertions(+), 9 deletions(-)

(limited to 'email')

diff --git a/email/email.scm b/email/email.scm
index 1075754..53840db 100644
--- a/email/email.scm
+++ b/email/email.scm
@@ -253,9 +253,9 @@
 (define-peg-pattern addr-spec body
   (and local-part "@" domain))
 
-(define-peg-pattern angle-addr all
+(define-peg-pattern angle-addr body
   (and (ignore (? cfws))
-       (ignore"<") addr-spec (ignore">")
+       "<" addr-spec ">"
        (ignore (? cfws))))
 
 (define-peg-pattern name-addr body
@@ -344,7 +344,6 @@
 (define-peg-pattern received-token body
   (or angle-addr addr-spec domain word))
 
-;; TODO: Do not discard the internal structure of received
 (define-field-pattern received "Received"
   (and (* received-token) (ignore ";") date-time))
 
@@ -717,7 +716,10 @@ message. Else, return a single <mime-entity> record."
 (define (parse-email-headers headers)
   "Parse string HEADERS as email headers and return an association
 list of header keys and values."
-  (define (extract-value _ value) value)
+  (define (trim-address address)
+    (string-trim-right
+     (string-trim (string-trim-both address) #\<)
+     #\>))
 
   (pre-post-order
    (peg:tree
@@ -747,14 +749,13 @@ list of header keys and values."
                                      (+ (* 60 60 (string->number zone-hours))
                                         (* 60 (string->number zone-minutes))))))))
      (orig-date . ,(lambda (_ date) (list 'date date)))
-     (angle-addr . ,extract-value)
      (mailbox . ,(match-lambda*
                    (`(mailbox (display-name ,name) ,address)
                     `((name . ,(decode-mime-encoded-word
                                 (string-trim-both name)))
-                      (address . ,address)))
+                      (address . ,(trim-address address))))
                    (`(mailbox ,address)
-                    `((address . ,(string-trim-both address))))
+                    `((address . ,(trim-address address))))
                    (_ (error "Failed to parse mailbox"))))
      (address-list *macro* . ,macro-process-address-list)
      (mailbox-list *macro* . ,macro-process-address-list)
@@ -766,14 +767,13 @@ list of header keys and values."
      (fields . ,(lambda (_ . fields)
                   (add-default-headers
                    (filter-map (match-lambda
-                                 (('trace . _) #f)
                                  ((field value)
                                   (cons field value))
                                  ((field . values)
                                   (cons field values))
                                  (_ #f))
                                fields))))
-     (*text* . ,extract-value)
+     (*text* . ,(lambda (_ value) value))
      (*default* . ,(lambda tree tree)))))
 
 (define* (decode-body body encoding #:optional charset)
-- 
cgit v1.2.3