diff options
-rw-r--r-- | email/email.scm | 16 | ||||
-rw-r--r-- | tests/email.scm | 8 |
2 files changed, 23 insertions, 1 deletions
diff --git a/email/email.scm b/email/email.scm index ff0f5e9..22d9739 100644 --- a/email/email.scm +++ b/email/email.scm @@ -957,7 +957,21 @@ For example, (match-lambda ((('name . name) ('address . address)) - (format #f "~a <~a>" name address)) + (string-append + ;; Quote display names with illegal characters. + (let ((char-set:atext (char-set-intersection + char-set:ascii + (char-set-union char-set:letter + char-set:digit + (char-set #\! #\# #\$ #\% + #\& #\' #\* #\+ + #\- #\/ #\= #\? + #\^ #\_ #\` #\{ + #\| #\} #\~))))) + (if (string-every char-set:atext name) + name + (string-append "\"" name "\""))) + " <" address ">")) ((('address . address)) address))) (define (parse-email-body headers body) diff --git a/tests/email.scm b/tests/email.scm index 972233d..510838a 100644 --- a/tests/email.scm +++ b/tests/email.scm @@ -598,6 +598,14 @@ Content-Type: text/plain; charset=utf-8 (parse-email-address "Foo [Bar] <foo@example.com>") '((name . "Foo [Bar]") (address . "foo@example.com"))) +(test-equal "quote display-name when serializing email addresses with illegal characters" + "\"Foo [Bar]\" <foo@example.com>" + (interpret-address '((name . "Foo [Bar]") (address . "foo@example.com")))) + +(test-equal "do not quote display-name when serializing email addresses without illegal characters" + "FooBar <foo@example.com>" + (interpret-address '((name . "FooBar") (address . "foo@example.com")))) + ;;; ;;; MIME encoded words |