summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArun Isaac2018-10-01 23:29:59 +0530
committerArun Isaac2018-10-01 23:29:59 +0530
commit3f61bc4bf0999e9b6ac6a48e4fa525716bfaaaf3 (patch)
tree99ba09a478437d24cca455297f524d8ffdeec727
parentfd432bcd88b489913369b82afeea5f15636a2901 (diff)
downloadguile-email-3f61bc4bf0999e9b6ac6a48e4fa525716bfaaaf3.tar.gz
guile-email-3f61bc4bf0999e9b6ac6a48e4fa525716bfaaaf3.tar.lz
guile-email-3f61bc4bf0999e9b6ac6a48e4fa525716bfaaaf3.zip
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.
-rw-r--r--email/email.scm18
1 files changed, 9 insertions, 9 deletions
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)