Make the characters used for e-mail addresses conform to RFC 5322

src/cgi/wwsympa.fcgi.in

@@ -3038,18 +3038,20 @@ sub do_ticket {
         or $param->{'ticket_context'}{'result'} eq 'closed');
     # if the ticket is related to someone which is not logged in, the system
-    # performs the same operation as for a login
-    my $email_regexp = Sympa::Regexps::email();
-    if (($param->{'ticket_context'}{'result'} eq 'success')
-        || # a valid ticket or a closed or expired ticket but with a valid pre-existing session
-        (   (      ($param->{'ticket_context'}{'result'} eq 'expired')
-                || ($param->{'ticket_context'}{'result'} eq 'closed')
+    # performs the same operation as for a login.
+    # - a valid ticket, or
+    # - a closed or expired ticket but with a valid pre-existing session
+    if ($param->{'ticket_context'}{'result'} eq 'success'
+        or ((      $param->{'ticket_context'}{'result'} eq 'expired'
+                or $param->{'ticket_context'}{'result'} eq 'closed'
             )
-            && (lc($param->{'ticket_context'}{'email'}) eq
-                $session->{'email'})
+            and Sympa::Tools::Text::canonic_email(
+                $param->{'ticket_context'}{'email'}
+            ) eq $session->{'email'}
         )
     ) {
-        $session->{'email'} = lc($param->{'ticket_context'}{'email'});
+        $session->{'email'} = Sympa::Tools::Text::canonic_email(
+            $param->{'ticket_context'}{'email'});
         $param->{'user'} = Sympa::User::get_global_user($session->{'email'});
         $param->{'user'}{'email'} = $session->{'email'};
         # Save and update last login info.
@@ -6227,8 +6229,7 @@ sub do_show_sessions {
 sub do_set_session_email {
     wwslog('info', '');
-    my $email_regexp = Sympa::Regexps::email();
-    unless ($in{'email'} =~ /^\s*$email_regexp\s*$/) {
+    unless (Sympa::Tools::Text::valid_email($in{'email'})) {
         Sympa::WWW::Report::reject_report_web('user',
             'Invalid email provided.',
             {}, $param->{'action'}, $list);

src/lib/Sympa/CommandDef.pm

@@ -33,7 +33,7 @@ use warnings;
 use Conf;
 use Sympa::Regexps;
 
-my $_email_re = Sympa::Regexps::addrspec();
+my $_email_re = Sympa::Regexps::email();
 our %comms = (
     add => {
         cmd_regexp => qr'add'i,

src/lib/Sympa/Config/Schema.pm

@@ -232,7 +232,7 @@ our %pinfo = (
         split_char => ',',                                #FIXME
         gettext_comment =>
             'Email addresses of the listmasters (users authorized to perform global server commands). Some error reports may also be sent to these addresses. Listmasters can be defined for each virtual host, however, the default listmasters will have privileges to manage all virtual hosts.',
-        format_s   => '$addrspec',
+        format_s   => '$email',
         occurrence => '1-n',
     },
 

src/lib/Sympa/DataSource/File.pm

@@ -48,8 +48,6 @@ sub _open {
 sub _next {
     my $self = shift;
 
-    my $email_re = Sympa::Regexps::addrspec();
-
     my $lines = 0;
     my $found = 0;
 
@@ -70,12 +68,15 @@ sub _next {
         next if $line =~ /^\s*$/;
         next if $line =~ /^\s*\#/;
 
-        # Skip badly formed emails.
-        unless ($line =~ /\A\s*($email_re)(?:\s+(\S.*))?\z/) {
+        unless ($line =~ /\A\s*(\S+)(?:\s+(\S.*))?\z/) {
             $log->syslog('err', 'Skip badly formed line: "%s"', $line);
             next;
         }
         my ($email, $gecos) = ($1, $2);
+        unless (Sympa::Tools::Text::valid_email($email)) {
+            $log->syslog('err', 'Skip badly formed email: "%s"', $email);
+            next;
+        }
         $gecos =~ s/\s+\z// if defined $gecos;
         $found++;
 

src/lib/Sympa/HTMLDecorator.pm

@@ -111,15 +111,17 @@ sub _start_document {
     $self->_queue_clear;
 }
 
+my $email_like_re = sprintf '(?:<%s>|%s)', Sympa::Regexps::email(),
+    Sympa::Regexps::email();
+
 sub _text {
     my $self = shift;
     my %options;
     @options{qw(event text)} = @_;
 
-    my $dtext    = Sympa::Tools::Text::decode_html($options{text});
-    my $email_re = Sympa::Regexps::addrspec();
+    my $dtext = Sympa::Tools::Text::decode_html($options{text});
 
-    if ($self->_queue_tagname eq 'a' or $dtext =~ /\b$email_re\b/) {
+    if ($self->_queue_tagname eq 'a' or $dtext =~ /\b$email_like_re\b/) {
         $self->_queue_push(%options);
         return;
     }
@@ -207,12 +209,11 @@ sub decorate_email_at {
     my $self = shift;
 
     my $decorated = '';
-    my $email_re  = Sympa::Regexps::addrspec();
     while (my $item = $self->_queue_shift) {
         if ($item->{event} eq 'text') {
             my $dtext = Sympa::Tools::Text::decode_html($item->{text});
-            if ($dtext =~ s{\b($email_re)\b}{join ' AT ', split(/\@/, $1)}eg)
-            {
+            if ($dtext =~
+                s{\b($email_like_re)\b}{join ' AT ', split(/\@/, $1)}eg) {
                 $decorated .= Sympa::Tools::Text::encode_html($dtext);
             } else {
                 $decorated .= $item->{text};
@@ -236,13 +237,12 @@ sub decorate_email_gecos {
     my $self = shift;
 
     my $decorated = '';
-    my $email_re  = Sympa::Regexps::addrspec();
     my $language  = Sympa::Language->instance;
     while (my $item = $self->_queue_shift) {
         if ($item->{event} eq 'text') {
             my $dtext       = Sympa::Tools::Text::decode_html($item->{text});
             my $replacement = $language->gettext('address@concealed');
-            if ($dtext =~ s{\b($email_re)\b}{$replacement}g) {
+            if ($dtext =~ s{\b($email_like_re)\b}{$replacement}g) {
                 $decorated .= Sympa::Tools::Text::encode_html($dtext);
             } else {
                 $decorated .= $item->{text};
@@ -270,10 +270,9 @@ sub decorate_email_js {
     }
 
     my $decorated = '';
-    my $email_re  = Sympa::Regexps::addrspec();
     my $dtext     = Sympa::Tools::Text::decode_html($text);
     pos $dtext = 0;
-    while ($dtext =~ /\G((?:\n|.)*?)\b($email_re)\b/cg) {
+    while ($dtext =~ /\G((?:\n|.)*?)\b($email_like_re)\b/cg) {
         $decorated .=
               Sympa::Tools::Text::encode_html($1)
             . _decorate_email_js(Sympa::Tools::Text::encode_html($2));

src/lib/Sympa/Regexps.pm

@@ -30,11 +30,18 @@ package Sympa::Regexps;
 use strict;
 use warnings;
 
-# This is the same as email below except that it does never give any groups.
-use constant addrspec => qr{(?:[-&+'./\w=]+|".*")\@[-\w]+(?:[.][-\w]+)+};
-# Caution: If this regexp changes (more/less parenthesis), then regexp using
-# it should also be changed.  By this reason it would be obsoleted.
-use constant email => qr'([\w\-\_\.\/\+\=\'\&]+|\".*\")\@[\w\-]+(\.[\w\-]+)+';
+# These are relaxed variants of the syntax for mailbox described in RFC 5322.
+# See also RFC 5322, 3.2.3 & 3.4.1 for details on format.
+use constant email =>
+    qr{(?:[A-Za-z0-9!\#\$%\&'*+\-/=?^_`{|}~.]+|"(?:\\.|[^\\"])*")\@[-\w]+(?:[.][-\w]+)+};
+
+# This is older definition used by 6.2.65b and earlier.
+#use constant addrspec => qr{(?:[-&+'./\w=]+|".*")\@[-\w]+(?:[.][-\w]+)+};
+
+# This is the same as above except that it gave some groups, then regexp
+# using it should also be changed.  By this reason it has been deprecated.
+#use constant email => qr'([\w\-\_\.\/\+\=\'\&]+|\".*\")\@[\w\-]+(\.[\w\-]+)+';
+
 use constant family_name => qr'[a-z0-9][a-z0-9\-\.\+_]*';
 ## Allow \s for template names
 use constant template_name => qr'[a-zA-Z0-9][a-zA-Z0-9\-\.\+_\s]*';

src/lib/Sympa/Spindle/ProcessBounce.pm

@@ -340,7 +340,6 @@ sub _twist {
         # Overwrite context.
         $message->{context} = $list;
 
-        my $email_regexp = Sympa::Regexps::email();
         my @reports =
             _parse_multipart_report($message, 'message/feedback-report');
         foreach my $report (@reports) {
@@ -352,8 +351,9 @@ sub _twist {
 
             my $feedback_type = lc($report->{feedback_type}->[0] || '');
             my @original_rcpts =
-                grep {m/$email_regexp/}
-                map { lc($_ || '') } @{$report->{original_rcpt_to} || []};
+                grep { Sympa::Tools::Text::valid_email($_) }
+                map { Sympa::Tools::Text::canonic_email($_ || '') }
+                @{$report->{original_rcpt_to} || []};
 
             # Malformed reports are forwarded to listmaster.
             unless (@original_rcpts) {

src/lib/Sympa/Tools/Text.pm

@@ -45,6 +45,10 @@ BEGIN { eval 'use Unicode::UTF8 qw()'; }
 use Sympa::Language;
 use Sympa::Regexps;
 
+my $email_re = Sympa::Regexps::email();
+my $email_like_re = sprintf '(?:<%s>|%s)', Sympa::Regexps::email(),
+    Sympa::Regexps::email();
+
 # Old name: tools::addrencode().
 sub addrencode {
     my $addr    = shift;
@@ -172,11 +176,10 @@ sub wrap_text {
     $cols //= 78;
     return $text unless $cols;
 
-    my $email_re = Sympa::Regexps::email();
     my $linefold = Text::LineFold->new(
         Language   => Sympa::Language->instance->get_lang,
         Prep       => 'NONBREAKURI',
-        prep       => [$email_re, sub { shift; @_ }],
+        prep       => [$email_like_re, sub { shift; @_ }],
         ColumnsMax => $cols,
         Format     => sub {
             shift;
@@ -505,11 +508,7 @@ sub unescape_chars {
 sub valid_email {
     my $email = shift;
 
-    my $email_re = Sympa::Regexps::email();
-    return undef unless $email =~ /^${email_re}$/;
-
-    # Forbidden characters.
-    return undef if $email =~ /[\|\$\*\?\!]/;
+    return undef unless $email =~ /\A$email_re\z/;
 
     return 1;
 }