diff options
| -rw-r--r-- | email/email.scm | 46 |
1 files changed, 23 insertions, 23 deletions
diff --git a/email/email.scm b/email/email.scm index 6ad2d93..2c9dea4 100644 --- a/email/email.scm +++ b/email/email.scm @@ -562,6 +562,23 @@ explained in RFC2045), and return that list." (values headers (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)))) + ;; addr-spec email address + (`(mailbox ,address) + `((address . ,(trim-address address)))) + (_ (error "Failed to parse mailbox")))) + (define (post-process-content-transfer-encoding _ value) (list 'content-transfer-encoding (string->lcase-symbol value))) @@ -634,16 +651,11 @@ For example, => ((name . \"Foo\") (address . \"foo@example.org\")) (parse-email-address \"foo@example.org\") => ((address . \"foo@example.org\"))" - (cond - ((string-match "([^<]*)<([^>]*)>" address) - => (lambda (match-record) - (let ((name (string-trim-both (match:substring match-record 1))) - (address (match:substring match-record 2))) - (if (string-null? name) - `((address . ,address)) - `((name . ,name) - (address . ,address)))))) - (else `((address . ,address))))) + (pre-post-order + (peg:tree (match-pattern mailbox address)) + `((mailbox . ,post-process-mailbox) + (*text* . ,(lambda (_ text) text)) + (*default* . ,(lambda tree tree))))) (define interpret-address (match-lambda @@ -716,11 +728,6 @@ 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 (trim-address address) - (string-trim-right - (string-trim (string-trim-both address) #\<) - #\>)) - (pre-post-order (peg:tree (match-pattern fields headers)) @@ -749,14 +756,7 @@ list of header keys and values." (+ (* 60 60 (string->number zone-hours)) (* 60 (string->number zone-minutes)))))))) (orig-date . ,(lambda (_ date) (list 'date date))) - (mailbox . ,(match-lambda* - (`(mailbox (display-name ,name) ,address) - `((name . ,(decode-mime-encoded-word - (string-trim-both name))) - (address . ,(trim-address address)))) - (`(mailbox ,address) - `((address . ,(trim-address address)))) - (_ (error "Failed to parse mailbox")))) + (mailbox . ,post-process-mailbox) (address-list *macro* . ,macro-process-address-list) (mailbox-list *macro* . ,macro-process-address-list) (optional-field . ,post-process-optional-field) |