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) {
if (defined $net_id) { # the ticket is valid net-id
$log->syslog('notice', 'Login CAS OK server netid=%s',
$net_id);
$param->{'user'}{'email'} = lc(
Sympa::WWW::Auth::get_email_by_net_id(
$robot, $cas_id, {'uid' => $net_id}
)
);
$param->{'user'}{'email'} =
Sympa::WWW::Auth::get_email_by_net_id($robot,
$cas_id, {'uid' => $net_id});
$session->{'auth'} = 'cas';
$session->{'email'} = $param->{user}{email};
 
......@@ -2051,8 +2049,8 @@ sub get_parameters {
# mod_ssl sets SSL_PROTOCOL; Apache-SSL sets SSL_PROTOCOL_VERSION.
$param->{'use_ssl'} = ($ENV{HTTPS} && $ENV{HTTPS} eq 'on');
 
## Lowercase email addresses
$in{'email'} = lc($in{'email'});
# Canonicalize email addresses.
$in{'email'} = Sympa::Tools::Text::canonic_email($in{'email'});
 
## Don't get multiple listnames
if ($in{'list'}) {
......@@ -3029,18 +3027,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.
......@@ -3409,7 +3409,8 @@ sub do_sso_login {
{'email_http_header'} && !$email_is_trusted) {
my @email_list = split(
/$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]
{'email_http_header'}
}
......@@ -3577,7 +3578,8 @@ sub do_sso_login {
my @email_list = split(
$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]
{'email_http_header'}
}
......@@ -5261,12 +5263,11 @@ sub do_set {
'update_date' => time
};
 
## Lower-case new email address
$in{'new_email'} = lc($in{'new_email'});
# Canonicalize new email address.
$in{'new_email'} = Sympa::Tools::Text::canonic_email($in{'new_email'});
 
if ($in{'new_email'} and $in{'email'} ne $in{'new_email'}) {
unless ($in{'new_email'}
and Sympa::Tools::Text::valid_email($in{'new_email'})) {
unless (Sympa::Tools::Text::valid_email($in{'new_email'})) {
wwslog('notice', 'Incorrect email %s', $in{'new_email'});
Sympa::WWW::Report::reject_report_web('user', 'incorrect_email',
{'email' => $in{'new_email'}},
......@@ -5556,7 +5557,7 @@ sub do_subscribe {
wwslog('notice', "Missing required custom attributes");
return 1;
}
unless ($email and Sympa::Tools::Text::valid_email($email)) {
unless (Sympa::Tools::Text::valid_email($email)) {
return 1;
}
 
......@@ -5687,7 +5688,7 @@ sub do_auto_signoff {
 
my $email = Sympa::Tools::Text::canonic_email($in{'email'});
return $default_home
unless $email and Sympa::Tools::Text::valid_email($email);
unless Sympa::Tools::Text::valid_email($email);
 
$param->{'email'} = $email;
 
......@@ -5753,7 +5754,7 @@ sub do_family_signoff {
unless $family;
my $email = Sympa::Tools::Text::canonic_email($in{'email'});
return $default_home
unless $email and Sympa::Tools::Text::valid_email($email);
unless Sympa::Tools::Text::valid_email($email);
 
$param->{'email'} = $email;
$param->{'family'} = $family->{name};
......@@ -5827,7 +5828,7 @@ sub do_signoff {
 
$param->{email} = $email;
 
unless ($email and Sympa::Tools::Text::valid_email($email)) {
unless (Sympa::Tools::Text::valid_email($email)) {
return 1;
}
 
......@@ -6198,8 +6199,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);
......@@ -7981,7 +7981,7 @@ sub do_add_frommod {
next;
}
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}
if defined $message->{gecos} and $message->{gecos} =~ /\S/;
 
......@@ -10764,7 +10764,7 @@ sub _notify_deleted_topic {
);
unless (
$list->update_list_member(
lc($subscriber->{'email'}),
$subscriber->{'email'},
update_date => time,
topics => join(',', @{$topics->{'added'}})
)
......@@ -13611,7 +13611,7 @@ sub do_d_set_owner {
# The email must look like an email "somebody@somewhere".
my $email = Sympa::Tools::Text::canonic_email($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',
{'email' => $in{'content'}},
$param->{'action'}, $list);
......@@ -17129,7 +17129,7 @@ sub do_auth {
 
my $default_home = Conf::get_robot_conf($robot, '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)} =
($keyauth, $heldaction, $listname, $email);
......@@ -17402,8 +17402,7 @@ sub _add_in_blocklist {
my $list = shift;
 
$log->syslog('info', '(%s, %s, %s)', $entry, $robot, $list->{'name'});
$entry = lc($entry);
chomp $entry;
$entry = Sympa::Tools::Text::canonic_email($entry);
 
# robot blocklist not yet availible
unless ($list) {
......
......@@ -669,6 +669,7 @@ sub get_listmasters_email {
}
my @listmasters =
map { Sympa::Tools::Text::canonic_email($_) }
grep { Sympa::Tools::Text::valid_email($_) } split /\s*,\s*/,
$listmaster;
# If no valid adresses found, use listmaster of site config.
......@@ -753,8 +754,8 @@ sub is_listmaster {
my $who = Sympa::Tools::Text::canonic_email(shift);
return undef unless defined $who;
return 1 if grep { lc $_ 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($that);
return 1 if grep { $_ eq $who } Sympa::get_listmasters_email('*');
return 0;
}
......
......@@ -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,
......
......@@ -235,7 +235,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',
},
......
......@@ -48,8 +48,6 @@ sub _open {
sub _next {
my $self = shift;
my $email_re = Sympa::Regexps::addrspec();
my $lines = 0;
my $found = 0;
......@@ -70,8 +68,7 @@ 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;
}
......
......@@ -114,15 +114,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;
}
......@@ -209,12 +211,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};
......@@ -238,13 +239,12 @@ sub decorate_email_concealed {
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};
......@@ -277,10 +277,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));
......
......@@ -260,7 +260,8 @@ sub _get_sender_email {
## Try to get envelope sender
if ( $self->{'envelope_sender'}
and $self->{'envelope_sender'} ne '<>') {
$sender = lc($self->{'envelope_sender'});
$sender = Sympa::Tools::Text::canonic_email(
$self->{'envelope_sender'});
}
} elsif ($hdr->get($field)) {
## Try to get message header.
......@@ -271,7 +272,8 @@ sub _get_sender_email {
my $addr = $hdr->get($field, 0); # get the first one
my @sender_hdr = Mail::Address->parse($addr);
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;
if (defined $phrase and length $phrase) {
$gecos = MIME::EncWords::decode_mimewords($phrase,
......@@ -1305,7 +1307,7 @@ sub check_smime_signature {
## Messages that should not be altered (no footer)
$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.
my $smime = Crypt::SMIME->new;
......@@ -1329,7 +1331,7 @@ sub check_smime_signature {
foreach my $cert (@{$signers || []}) {
my $parsed = Sympa::Tools::SMIME::parse_cert(text => $cert);
next unless $parsed;
next unless $parsed->{'email'}{lc $sender};
next unless $parsed->{'email'}{$sender};
if ($parsed->{'purpose'}{'sign'} and $parsed->{'purpose'}{'enc'}) {
$certs{'both'} = $cert;
......@@ -1353,8 +1355,8 @@ sub check_smime_signature {
# or a pair of single-purpose. save them, as email@addr if combined,
# or as email@addr@sign / email@addr@enc for split certs.
foreach my $c (keys %certs) {
my $filename = sprintf '%s/%s', $Conf::Conf{ssl_cert_dir},
Sympa::Tools::Text::encode_filesystem_safe(lc $sender);
my $filename = sprintf '%s/%s', $Conf::Conf{'ssl_cert_dir'},
Sympa::Tools::Text::encode_filesystem_safe($sender);
if ($c ne 'both') {
unlink $filename; # just in case there's an old cert left...
$filename .= "\@$c";
......
......@@ -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]*';
......
......@@ -36,6 +36,7 @@ use Sympa::List;
use Sympa::LockedFile;
use Sympa::Log;
use Sympa::Template;
use Sympa::Tools::Text;
use base qw(Sympa::Request::Handler);
......
......@@ -31,6 +31,7 @@ use Sympa::DatabaseManager;
use Sympa::DataSource;
use Sympa::LockedFile;
use Sympa::Log;
use Sympa::Tools::Text;
use base qw(Sympa::Request::Handler);
......
......@@ -39,6 +39,7 @@ use Sympa::ListDef;
use Sympa::Log;
use Sympa::Tools::Data;
use Sympa::Tools::File;
use Sympa::Tools::Text;
my $language = Sympa::Language->instance;
my $log = Sympa::Log->instance;
......
......@@ -118,7 +118,7 @@ sub _twist {
# Pick address only.
my @to = Mail::Address->parse($to);
if (@to and $to[0] and $to[0]->address) {
$to = lc($to[0]->address);
$to = Sympa::Tools::Text::canonic_email($to[0]->address);
} else {
undef $to;
}
......@@ -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) {
......
......@@ -33,6 +33,7 @@ use English qw(-no_match_vars);
use Conf;
use Sympa::Log;
use Sympa::Tools::Text;
my $log = Sympa::Log->instance;
......
......@@ -44,6 +44,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;
......@@ -171,11 +175,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;
......@@ -522,11 +525,8 @@ sub _gc_length {
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 defined $email and $email =~ /\A$email_re\z/;
return 1;
}
......
......@@ -353,12 +353,13 @@ sub get_email_by_net_id {
$db->disconnect();
## return only the first attribute
my @results = $mesg->entries;
foreach my $result (@results) {
return (lc($result->get_value($ldap->{'email_attribute'})));
# Return only the first attribute.
foreach my $result ($mesg->entries) {
my $email = $result->get_value($ldap->{'email_attribute'});
return undef unless Sympa::Tools::Text::valid_email($email);
return Sympa::Tools::Text::canonic_email($email);
}
return undef;
}
# check trusted_application_name et trusted_application_password : return 1 or
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment