diff options
| -rw-r--r-- | email/email.scm | 32 |
1 files changed, 22 insertions, 10 deletions
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) |