diff options
Diffstat (limited to 'email')
| -rw-r--r-- | email/email.scm | 18 |
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) |