diff options
| author | Arun Isaac | 2025-02-09 23:09:26 +0000 |
|---|---|---|
| committer | Arun Isaac | 2025-02-09 23:23:03 +0000 |
| commit | 32eb61f81ce9d069f5e73091ee2b6729f1404a6d (patch) | |
| tree | 99d23e0963452e33b58b4f5d00315e4d6c3dfa45 | |
| parent | 9a82ce70b9eded77a148336feb8913156a31bab8 (diff) | |
| download | guile-email-32eb61f81ce9d069f5e73091ee2b6729f1404a6d.tar.gz guile-email-32eb61f81ce9d069f5e73091ee2b6729f1404a6d.tar.lz guile-email-32eb61f81ce9d069f5e73091ee2b6729f1404a6d.zip | |
email: Quote display names when serializing email addresses.
* email/email.scm (interpret-address): Quote display names when they
have illegal characters.
* tests/email.scm ("quote display-name when serializing email
addresses with illegal characters", "do not quote display-name when
serializing email addresses without illegal characters"): New tests.
| -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 |