summary refs log tree commit diff
path: root/email
diff options
context:
space:
mode:
Diffstat (limited to 'email')
-rw-r--r--email/email.scm26
1 files changed, 22 insertions, 4 deletions
diff --git a/email/email.scm b/email/email.scm
index 0d51eef..a29a532 100644
--- a/email/email.scm
+++ b/email/email.scm
@@ -1,5 +1,5 @@
 ;;; guile-email --- Guile email parser
-;;; Copyright © 2018, 2019, 2020, 2021 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2018, 2019, 2020, 2021, 2023 Arun Isaac <arunisaac@systemreboot.net>
 ;;; Copyright © 2021 Mathieu Othacehe <othacehe@gnu.org>
 ;;; Copyright © 2023 Andrew Whatson <whatson@tailcall.au>
 ;;;
@@ -179,6 +179,9 @@
        (and (ignore (? cfws)) (+ atext) (ignore (? cfws)))))
     ((define-atom-pattern name cfws)
      (define-peg-pattern name body
+       (and (? cfws) (+ atext) (? cfws))))
+    ((define-atom-pattern name cfws atext)
+     (define-peg-pattern name body
        (and (? cfws) (+ atext) (? cfws))))))
 
 (define-atom-pattern atom)
@@ -225,8 +228,11 @@
 (define-atom-pattern cfws-captured-atom cfws)
 (define-word-pattern cfws-captured-word cfws-captured-atom)
 
-(define-peg-pattern obs-phrase body
-  (and cfws-captured-word (* (or cfws-captured-word "." cfws))))
+(define-syntax-rule (define-phrase-pattern name word)
+  (define-peg-pattern name body
+    (and word (* (or word "." cfws)))))
+
+(define-phrase-pattern obs-phrase cfws-captured-word)
 
 ;; We set phrase to be the same as obs-phrase since, according to
 ;; their definitions in RFC5322, all phrases are obs-phrases.
@@ -350,8 +356,20 @@
 
 ;;; Address specification
 
+;; People tend to put strange characters in their display names, and
+;; MUAs tend to pass on these non-standard names without any
+;; quoting. Tolerate such names.
+
+;; Tolerate non-standard ( and ) in atext.
+(define-peg-pattern liberal-atext body
+  (or atext "(" ")"))
+
+(define-atom-pattern liberal-cfws-captured-atom cfws liberal-atext)
+(define-word-pattern liberal-cfws-captured-word liberal-cfws-captured-atom)
+(define-phrase-pattern liberal-phrase liberal-cfws-captured-word)
+
 (define-peg-pattern display-name all
-  phrase)
+  liberal-phrase)
 
 (define-peg-pattern obs-local-part body
   (and word (* (and "." word))))