Unverified Commit 55622ef4 authored by IKEDA Soji's avatar IKEDA Soji Committed by GitHub
Browse files

Merge pull request #1218 from ikedas/email_address_format by ikedas

Make the characters used for e-mail addresses conform to RFC 5322
parents 75ebdbd5 1fb977bf
...@@ -1347,11 +1347,9 @@ while ($query = Sympa::WWW::FastCGI->new) { ...@@ -1347,11 +1347,9 @@ while ($query = Sympa::WWW::FastCGI->new) {
if (defined $net_id) { # the ticket is valid net-id if (defined $net_id) { # the ticket is valid net-id
$log->syslog('notice', 'Login CAS OK server netid=%s', $log->syslog('notice', 'Login CAS OK server netid=%s',
$net_id); $net_id);
$param->{'user'}{'email'} = lc( $param->{'user'}{'email'} =
Sympa::WWW::Auth::get_email_by_net_id( Sympa::WWW::Auth::get_email_by_net_id($robot,
$robot, $cas_id, {'uid' => $net_id} $cas_id, {'uid' => $net_id});
)
);
$session->{'auth'} = 'cas'; $session->{'auth'} = 'cas';
$session->{'email'} = $param->{user}{email}; $session->{'email'} = $param->{user}{email};
   
...@@ -2051,8 +2049,8 @@ sub get_parameters { ...@@ -2051,8 +2049,8 @@ sub get_parameters {
# mod_ssl sets SSL_PROTOCOL; Apache-SSL sets SSL_PROTOCOL_VERSION. # mod_ssl sets SSL_PROTOCOL; Apache-SSL sets SSL_PROTOCOL_VERSION.
$param->{'use_ssl'} = ($ENV{HTTPS} && $ENV{HTTPS} eq 'on'); $param->{'use_ssl'} = ($ENV{HTTPS} && $ENV{HTTPS} eq 'on');
   
## Lowercase email addresses # Canonicalize email addresses.
$in{'email'} = lc($in{'email'}); $in{'email'} = Sympa::Tools::Text::canonic_email($in{'email'});
   
## Don't get multiple listnames ## Don't get multiple listnames
if ($in{'list'}) { if ($in{'list'}) {
...@@ -3029,18 +3027,20 @@ sub do_ticket { ...@@ -3029,18 +3027,20 @@ sub do_ticket {
or $param->{'ticket_context'}{'result'} eq 'closed'); or $param->{'ticket_context'}{'result'} eq 'closed');
   
# if the ticket is related to someone which is not logged in, the system # if the ticket is related to someone which is not logged in, the system
# performs the same operation as for a login # performs the same operation as for a login.
my $email_regexp = Sympa::Regexps::email(); # - a valid ticket, or
if (($param->{'ticket_context'}{'result'} eq 'success') # - a closed or expired ticket but with a valid pre-existing session
|| # a valid ticket or a closed or expired ticket but with a valid pre-existing session if ($param->{'ticket_context'}{'result'} eq 'success'
( ( ($param->{'ticket_context'}{'result'} eq 'expired') or (( $param->{'ticket_context'}{'result'} eq 'expired'
|| ($param->{'ticket_context'}{'result'} eq 'closed') or $param->{'ticket_context'}{'result'} eq 'closed'
) )
&& (lc($param->{'ticket_context'}{'email'}) eq and Sympa::Tools::Text::canonic_email(
$session->{'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'} = Sympa::User::get_global_user($session->{'email'});
$param->{'user'}{'email'} = $session->{'email'}; $param->{'user'}{'email'} = $session->{'email'};
# Save and update last login info. # Save and update last login info.
...@@ -3409,7 +3409,8 @@ sub do_sso_login { ...@@ -3409,7 +3409,8 @@ sub do_sso_login {
{'email_http_header'} && !$email_is_trusted) { {'email_http_header'} && !$email_is_trusted) {
my @email_list = split( my @email_list = split(
/$Conf::Conf{'auth_services'}{$robot}[$sso_id]{'http_header_value_separator'}/, /$Conf::Conf{'auth_services'}{$robot}[$sso_id]{'http_header_value_separator'}/,
lc( $ENV{ Sympa::Tools::Text::canonic_email(
$ENV{
$Conf::Conf{'auth_services'}{$robot}[$sso_id] $Conf::Conf{'auth_services'}{$robot}[$sso_id]
{'email_http_header'} {'email_http_header'}
} }
...@@ -3577,7 +3578,8 @@ sub do_sso_login { ...@@ -3577,7 +3578,8 @@ sub do_sso_login {
my @email_list = split( my @email_list = split(
$Conf::Conf{'auth_services'}{$robot}[$sso_id] $Conf::Conf{'auth_services'}{$robot}[$sso_id]
{'http_header_value_separator'}, {'http_header_value_separator'},
lc( $ENV{ Sympa::Tools::Text::canonic_email(
$ENV{
$Conf::Conf{'auth_services'}{$robot}[$sso_id] $Conf::Conf{'auth_services'}{$robot}[$sso_id]
{'email_http_header'} {'email_http_header'}
} }
...@@ -5261,12 +5263,11 @@ sub do_set { ...@@ -5261,12 +5263,11 @@ sub do_set {
'update_date' => time 'update_date' => time
}; };
   
## Lower-case new email address # Canonicalize new email address.
$in{'new_email'} = lc($in{'new_email'}); $in{'new_email'} = Sympa::Tools::Text::canonic_email($in{'new_email'});
   
if ($in{'new_email'} and $in{'email'} ne $in{'new_email'}) { if ($in{'new_email'} and $in{'email'} ne $in{'new_email'}) {
unless ($in{'new_email'} unless (Sympa::Tools::Text::valid_email($in{'new_email'})) {
and Sympa::Tools::Text::valid_email($in{'new_email'})) {
wwslog('notice', 'Incorrect email %s', $in{'new_email'}); wwslog('notice', 'Incorrect email %s', $in{'new_email'});
Sympa::WWW::Report::reject_report_web('user', 'incorrect_email', Sympa::WWW::Report::reject_report_web('user', 'incorrect_email',
{'email' => $in{'new_email'}}, {'email' => $in{'new_email'}},
...@@ -5556,7 +5557,7 @@ sub do_subscribe { ...@@ -5556,7 +5557,7 @@ sub do_subscribe {
wwslog('notice', "Missing required custom attributes"); wwslog('notice', "Missing required custom attributes");
return 1; return 1;
} }
unless ($email and Sympa::Tools::Text::valid_email($email)) { unless (Sympa::Tools::Text::valid_email($email)) {
return 1; return 1;
} }
   
...@@ -5687,7 +5688,7 @@ sub do_auto_signoff { ...@@ -5687,7 +5688,7 @@ sub do_auto_signoff {
   
my $email = Sympa::Tools::Text::canonic_email($in{'email'}); my $email = Sympa::Tools::Text::canonic_email($in{'email'});
return $default_home return $default_home
unless $email and Sympa::Tools::Text::valid_email($email); unless Sympa::Tools::Text::valid_email($email);
   
$param->{'email'} = $email; $param->{'email'} = $email;
   
...@@ -5753,7 +5754,7 @@ sub do_family_signoff { ...@@ -5753,7 +5754,7 @@ sub do_family_signoff {
unless $family; unless $family;
my $email = Sympa::Tools::Text::canonic_email($in{'email'}); my $email = Sympa::Tools::Text::canonic_email($in{'email'});
return $default_home return $default_home
unless $email and Sympa::Tools::Text::valid_email($email); unless Sympa::Tools::Text::valid_email($email);
   
$param->{'email'} = $email; $param->{'email'} = $email;
$param->{'family'} = $family->{name}; $param->{'family'} = $family->{name};
...@@ -5827,7 +5828,7 @@ sub do_signoff { ...@@ -5827,7 +5828,7 @@ sub do_signoff {
   
$param->{email} = $email; $param->{email} = $email;
   
unless ($email and Sympa::Tools::Text::valid_email($email)) { unless (Sympa::Tools::Text::valid_email($email)) {
return 1; return 1;
} }
   
...@@ -6198,8 +6199,7 @@ sub do_show_sessions { ...@@ -6198,8 +6199,7 @@ sub do_show_sessions {
sub do_set_session_email { sub do_set_session_email {
wwslog('info', ''); wwslog('info', '');
   
my $email_regexp = Sympa::Regexps::email(); unless (Sympa::Tools::Text::valid_email($in{'email'})) {
unless ($in{'email'} =~ /^\s*$email_regexp\s*$/) {
Sympa::WWW::Report::reject_report_web('user', Sympa::WWW::Report::reject_report_web('user',
'Invalid email provided.', 'Invalid email provided.',
{}, $param->{'action'}, $list); {}, $param->{'action'}, $list);
...@@ -7981,7 +7981,7 @@ sub do_add_frommod { ...@@ -7981,7 +7981,7 @@ sub do_add_frommod {
next; next;
} }
my $email = $message->{sender}; my $email = $message->{sender};
next unless $email and Sympa::Tools::Text::valid_email($email); next unless Sympa::Tools::Text::valid_email($email);
my $fullname = $message->{gecos} my $fullname = $message->{gecos}
if defined $message->{gecos} and $message->{gecos} =~ /\S/; if defined $message->{gecos} and $message->{gecos} =~ /\S/;
   
...@@ -10764,7 +10764,7 @@ sub _notify_deleted_topic { ...@@ -10764,7 +10764,7 @@ sub _notify_deleted_topic {
); );
unless ( unless (
$list->update_list_member( $list->update_list_member(
lc($subscriber->{'email'}), $subscriber->{'email'},
update_date => time, update_date => time,
topics => join(',', @{$topics->{'added'}}) topics => join(',', @{$topics->{'added'}})
) )
...@@ -13611,7 +13611,7 @@ sub do_d_set_owner { ...@@ -13611,7 +13611,7 @@ sub do_d_set_owner {
# The email must look like an email "somebody@somewhere". # The email must look like an email "somebody@somewhere".
my $email = Sympa::Tools::Text::canonic_email($in{'content'}) my $email = Sympa::Tools::Text::canonic_email($in{'content'})
if $in{'content'}; if $in{'content'};
unless ($email and Sympa::Tools::Text::valid_email($email)) { unless (Sympa::Tools::Text::valid_email($email)) {
Sympa::WWW::Report::reject_report_web('user', 'incorrect_email', Sympa::WWW::Report::reject_report_web('user', 'incorrect_email',
{'email' => $in{'content'}}, {'email' => $in{'content'}},
$param->{'action'}, $list); $param->{'action'}, $list);
...@@ -17129,7 +17129,7 @@ sub do_auth { ...@@ -17129,7 +17129,7 @@ sub do_auth {
   
my $default_home = Conf::get_robot_conf($robot, 'default_home'); my $default_home = Conf::get_robot_conf($robot, 'default_home');
return $default_home return $default_home
unless $email and Sympa::Tools::Text::valid_email($email); unless Sympa::Tools::Text::valid_email($email);
   
@{$param}{qw(id heldaction listname email)} = @{$param}{qw(id heldaction listname email)} =
($keyauth, $heldaction, $listname, $email); ($keyauth, $heldaction, $listname, $email);
...@@ -17402,8 +17402,7 @@ sub _add_in_blocklist { ...@@ -17402,8 +17402,7 @@ sub _add_in_blocklist {
my $list = shift; my $list = shift;
   
$log->syslog('info', '(%s, %s, %s)', $entry, $robot, $list->{'name'}); $log->syslog('info', '(%s, %s, %s)', $entry, $robot, $list->{'name'});
$entry = lc($entry); $entry = Sympa::Tools::Text::canonic_email($entry);
chomp $entry;
   
# robot blocklist not yet availible # robot blocklist not yet availible
unless ($list) { unless ($list) {
......
...@@ -669,6 +669,7 @@ sub get_listmasters_email { ...@@ -669,6 +669,7 @@ sub get_listmasters_email {
} }
my @listmasters = my @listmasters =
map { Sympa::Tools::Text::canonic_email($_) }
grep { Sympa::Tools::Text::valid_email($_) } split /\s*,\s*/, grep { Sympa::Tools::Text::valid_email($_) } split /\s*,\s*/,
$listmaster; $listmaster;
# If no valid adresses found, use listmaster of site config. # If no valid adresses found, use listmaster of site config.
...@@ -753,8 +754,8 @@ sub is_listmaster { ...@@ -753,8 +754,8 @@ sub is_listmaster {
my $who = Sympa::Tools::Text::canonic_email(shift); my $who = Sympa::Tools::Text::canonic_email(shift);
return undef unless defined $who; return undef unless defined $who;
return 1 if grep { lc $_ eq $who } Sympa::get_listmasters_email($that); return 1 if grep { $_ eq $who } Sympa::get_listmasters_email($that);
return 1 if grep { lc $_ eq $who } Sympa::get_listmasters_email('*'); return 1 if grep { $_ eq $who } Sympa::get_listmasters_email('*');
return 0; return 0;
} }
......
...@@ -33,7 +33,7 @@ use warnings; ...@@ -33,7 +33,7 @@ use warnings;
use Conf; use Conf;
use Sympa::Regexps; use Sympa::Regexps;
my $_email_re = Sympa::Regexps::addrspec(); my $_email_re = Sympa::Regexps::email();
our %comms = ( our %comms = (
add => { add => {
cmd_regexp => qr'add'i, cmd_regexp => qr'add'i,
......
...@@ -235,7 +235,7 @@ our %pinfo = ( ...@@ -235,7 +235,7 @@ our %pinfo = (
split_char => ',', #FIXME split_char => ',', #FIXME
gettext_comment => 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.', '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', occurrence => '1-n',
}, },
......
...@@ -48,8 +48,6 @@ sub _open { ...@@ -48,8 +48,6 @@ sub _open {
sub _next { sub _next {
my $self = shift; my $self = shift;
my $email_re = Sympa::Regexps::addrspec();
my $lines = 0; my $lines = 0;
my $found = 0; my $found = 0;
...@@ -70,8 +68,7 @@ sub _next { ...@@ -70,8 +68,7 @@ sub _next {
next if $line =~ /^\s*$/; next if $line =~ /^\s*$/;
next if $line =~ /^\s*\#/; next if $line =~ /^\s*\#/;
# Skip badly formed emails. unless ($line =~ /\A\s*(\S+)(?:\s+(\S.*))?\z/) {
unless ($line =~ /\A\s*($email_re)(?:\s+(\S.*))?\z/) {
$log->syslog('err', 'Skip badly formed line: "%s"', $line); $log->syslog('err', 'Skip badly formed line: "%s"', $line);
next; next;
} }
......
...@@ -114,15 +114,17 @@ sub _start_document { ...@@ -114,15 +114,17 @@ sub _start_document {
$self->_queue_clear; $self->_queue_clear;
} }
my $email_like_re = sprintf '(?:<%s>|%s)', Sympa::Regexps::email(),
Sympa::Regexps::email();
sub _text { sub _text {
my $self = shift; my $self = shift;
my %options; my %options;
@options{qw(event text)} = @_; @options{qw(event text)} = @_;
my $dtext = Sympa::Tools::Text::decode_html($options{text}); my $dtext = Sympa::Tools::Text::decode_html($options{text});
my $email_re = Sympa::Regexps::addrspec();
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); $self->_queue_push(%options);
return; return;
} }
...@@ -209,12 +211,11 @@ sub decorate_email_at { ...@@ -209,12 +211,11 @@ sub decorate_email_at {
my $self = shift; my $self = shift;
my $decorated = ''; my $decorated = '';
my $email_re = Sympa::Regexps::addrspec();
while (my $item = $self->_queue_shift) { while (my $item = $self->_queue_shift) {
if ($item->{event} eq 'text') { if ($item->{event} eq 'text') {
my $dtext = Sympa::Tools::Text::decode_html($item->{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); $decorated .= Sympa::Tools::Text::encode_html($dtext);
} else { } else {
$decorated .= $item->{text}; $decorated .= $item->{text};
...@@ -238,13 +239,12 @@ sub decorate_email_concealed { ...@@ -238,13 +239,12 @@ sub decorate_email_concealed {
my $self = shift; my $self = shift;
my $decorated = ''; my $decorated = '';
my $email_re = Sympa::Regexps::addrspec();
my $language = Sympa::Language->instance; my $language = Sympa::Language->instance;
while (my $item = $self->_queue_shift) { while (my $item = $self->_queue_shift) {
if ($item->{event} eq 'text') { if ($item->{event} eq 'text') {
my $dtext = Sympa::Tools::Text::decode_html($item->{text}); my $dtext = Sympa::Tools::Text::decode_html($item->{text});
my $replacement = $language->gettext('address@concealed'); 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); $decorated .= Sympa::Tools::Text::encode_html($dtext);
} else { } else {
$decorated .= $item->{text}; $decorated .= $item->{text};
...@@ -277,10 +277,9 @@ sub decorate_email_js { ...@@ -277,10 +277,9 @@ sub decorate_email_js {
} }
my $decorated = ''; my $decorated = '';
my $email_re = Sympa::Regexps::addrspec();
my $dtext = Sympa::Tools::Text::decode_html($text); my $dtext = Sympa::Tools::Text::decode_html($text);
pos $dtext = 0; pos $dtext = 0;
while ($dtext =~ /\G((?:\n|.)*?)\b($email_re)\b/cg) { while ($dtext =~ /\G((?:\n|.)*?)\b($email_like_re)\b/cg) {
$decorated .= $decorated .=
Sympa::Tools::Text::encode_html($1) Sympa::Tools::Text::encode_html($1)
. _decorate_email_js(Sympa::Tools::Text::encode_html($2)); . _decorate_email_js(Sympa::Tools::Text::encode_html($2));
......
...@@ -260,7 +260,8 @@ sub _get_sender_email { ...@@ -260,7 +260,8 @@ sub _get_sender_email {
## Try to get envelope sender ## Try to get envelope sender
if ( $self->{'envelope_sender'} if ( $self->{'envelope_sender'}
and $self->{'envelope_sender'} ne '<>') { and $self->{'envelope_sender'} ne '<>') {
$sender = lc($self->{'envelope_sender'}); $sender = Sympa::Tools::Text::canonic_email(
$self->{'envelope_sender'});
} }
} elsif ($hdr->get($field)) { } elsif ($hdr->get($field)) {
## Try to get message header. ## Try to get message header.
...@@ -271,7 +272,8 @@ sub _get_sender_email { ...@@ -271,7 +272,8 @@ sub _get_sender_email {
my $addr = $hdr->get($field, 0); # get the first one my $addr = $hdr->get($field, 0); # get the first one
my @sender_hdr = Mail::Address->parse($addr); my @sender_hdr = Mail::Address->parse($addr);
if (@sender_hdr and $sender_hdr[0]->address) { if (@sender_hdr and $sender_hdr[0]->address) {
$sender = lc($sender_hdr[0]->address); $sender = Sympa::Tools::Text::canonic_email(
$sender_hdr[0]->address);
my $phrase = $sender_hdr[0]->phrase; my $phrase = $sender_hdr[0]->phrase;
if (defined $phrase and length $phrase) { if (defined $phrase and length $phrase) {
$gecos = MIME::EncWords::decode_mimewords($phrase, $gecos = MIME::EncWords::decode_mimewords($phrase,
...@@ -1305,7 +1307,7 @@ sub check_smime_signature { ...@@ -1305,7 +1307,7 @@ sub check_smime_signature {
## Messages that should not be altered (no footer) ## Messages that should not be altered (no footer)
$self->{'protected'} = 1; $self->{'protected'} = 1;
my $sender = $self->{'sender'}; my $sender = Sympa::Tools::Text::canonic_email($self->{'sender'});
# First step is to check if message signing is OK. # First step is to check if message signing is OK.
my $smime = Crypt::SMIME->new; my $smime = Crypt::SMIME->new;
...@@ -1329,7 +1331,7 @@ sub check_smime_signature { ...@@ -1329,7 +1331,7 @@ sub check_smime_signature {
foreach my $cert (@{$signers || []}) { foreach my $cert (@{$signers || []}) {
my $parsed = Sympa::Tools::SMIME::parse_cert(text => $cert); my $parsed = Sympa::Tools::SMIME::parse_cert(text => $cert);
next unless $parsed; next unless $parsed;
next unless $parsed->{'email'}{lc $sender}; next unless $parsed->{'email'}{$sender};
if ($parsed->{'purpose'}{'sign'} and $parsed->{'purpose'}{'enc'}) { if ($parsed->{'purpose'}{'sign'} and $parsed->{'purpose'}{'enc'}) {
$certs{'both'} = $cert; $certs{'both'} = $cert;
...@@ -1353,8 +1355,8 @@ sub check_smime_signature { ...@@ -1353,8 +1355,8 @@ sub check_smime_signature {
# or a pair of single-purpose. save them, as email@addr if combined, # or a pair of single-purpose. save them, as email@addr if combined,
# or as email@addr@sign / email@addr@enc for split certs. # or as email@addr@sign / email@addr@enc for split certs.
foreach my $c (keys %certs) { foreach my $c (keys %certs) {
my $filename = sprintf '%s/%s', $Conf::Conf{ssl_cert_dir}, my $filename = sprintf '%s/%s', $Conf::Conf{'ssl_cert_dir'},
Sympa::Tools::Text::encode_filesystem_safe(lc $sender); Sympa::Tools::Text::encode_filesystem_safe($sender);
if ($c ne 'both') { if ($c ne 'both') {
unlink $filename; # just in case there's an old cert left... unlink $filename; # just in case there's an old cert left...
$filename .= "\@$c"; $filename .= "\@$c";
......
...@@ -30,11 +30,18 @@ package Sympa::Regexps; ...@@ -30,11 +30,18 @@ package Sympa::Regexps;
use strict; use strict;
use warnings; use warnings;
# This is the same as email below except that it does never give any groups. # These are relaxed variants of the syntax for mailbox described in RFC 5322.
use constant addrspec => qr{(?:[-&+'./\w=]+|".*")\@[-\w]+(?:[.][-\w]+)+}; # See also RFC 5322, 3.2.3 & 3.4.1 for details on format.
# Caution: If this regexp changes (more/less parenthesis), then regexp using use constant email =>
# it should also be changed. By this reason it would be obsoleted. qr{(?:[A-Za-z0-9!\#\$%\&'*+\-/=?^_`{|}~.]+|"(?:\\.|[^\\"])*")\@[-\w]+(?:[.][-\w]+)+};
use constant email => qr'([\w\-\_\.\/\+\=\'\&]+|\".*\")\@[\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\-\.\+_]*'; use constant family_name => qr'[a-z0-9][a-z0-9\-\.\+_]*';
## Allow \s for template names ## Allow \s for template names
use constant template_name => qr'[a-zA-Z0-9][a-zA-Z0-9\-\.\+_\s]*'; use constant template_name => qr'[a-zA-Z0-9][a-zA-Z0-9\-\.\+_\s]*';
......
...@@ -36,6 +36,7 @@ use Sympa::List; ...@@ -36,6 +36,7 @@ use Sympa::List;
use Sympa::LockedFile; use Sympa::LockedFile;
use Sympa::Log; use Sympa::Log;
use Sympa::Template; use Sympa::Template;
use Sympa::Tools::Text;
use base qw(Sympa::Request::Handler); use base qw(Sympa::Request::Handler);
......
...@@ -31,6 +31,7 @@ use Sympa::DatabaseManager; ...@@ -31,6 +31,7 @@ use Sympa::DatabaseManager;
use Sympa::DataSource; use Sympa::DataSource;
use Sympa::LockedFile; use Sympa::LockedFile;
use Sympa::Log; use Sympa::Log;
use Sympa::Tools::Text;
use base qw(Sympa::Request::Handler); use base qw(Sympa::Request::Handler);
......
...@@ -39,6 +39,7 @@ use Sympa::ListDef; ...@@ -39,6 +39,7 @@ use Sympa::ListDef;
use Sympa::Log; use Sympa::Log;
use Sympa::Tools::Data; use Sympa::Tools::Data;
use Sympa::Tools::File; use Sympa::Tools::File;
use Sympa::Tools::Text;
my $language = Sympa::Language->instance; my $language = Sympa::Language->instance;
my $log = Sympa::Log->instance; my $log = Sympa::Log->instance;
......
...@@ -118,7 +118,7 @@ sub _twist { ...@@ -118,7 +118,7 @@ sub _twist {
# Pick address only. # Pick address only.
my @to = Mail::Address->parse($to); my @to = Mail::Address->parse($to);
if (@to and $to[0] and $to[0]->address) { if (@to and $to[0] and $to[0]->address) {
$to = lc($to[0]->address); $to = Sympa::Tools::Text::canonic_email($to[0]->address);
} else { } else {
undef $to; undef $to;
} }
...@@ -340,7 +340,6 @@ sub _twist { ...@@ -340,7 +340,6 @@ sub _twist {
# Overwrite context. # Overwrite context.
$message->{context} = $list; $message->{context} = $list;
my $email_regexp = Sympa::Regexps::email();
my @reports = my @reports =
_parse_multipart_report($message, 'message/feedback-report'); _parse_multipart_report($message, 'message/feedback-report');
foreach my $report (@reports) { foreach my $report (@reports) {
...@@ -352,8 +351,9 @@ sub _twist { ...@@ -352,8 +351,9 @@ sub _twist {
my $feedback_type = lc($report->{feedback_type}->[0] || ''); my $feedback_type = lc($report->{feedback_type}->[0] || '');
my @original_rcpts = my @original_rcpts =
grep {m/$email_regexp/} grep { Sympa::Tools::Text::valid_email($_) }
map { lc($_ || '') } @{$report->{original_rcpt_to} || []}; map { Sympa::Tools::Text::canonic_email($_ || '') }
@{$report->{original_rcpt_to} || []};
# Malformed reports are forwarded to listmaster. # Malformed reports are forwarded to listmaster.
unless (@original_rcpts) { unless (@original_rcpts) {
......
...@@ -33,6 +33,7 @@ use English qw(-no_match_vars); ...@@ -33,6 +33,7 @@ use English qw(-no_match_vars);