summaryrefslogtreecommitdiff
path: root/email/email.scm
diff options
context:
space:
mode:
Diffstat (limited to 'email/email.scm')
-rw-r--r--email/email.scm32
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)