Commit 1ced6143 authored by IKEDA Soji's avatar IKEDA Soji
Browse files

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

parent e1555fc1
...@@ -3038,18 +3038,20 @@ sub do_ticket { ...@@ -3038,18 +3038,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.
...@@ -6227,8 +6229,7 @@ sub do_show_sessions { ...@@ -6227,8 +6229,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);
......
...@@ -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,
......
...@@ -232,7 +232,7 @@ our %pinfo = ( ...@@ -232,7 +232,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,12 +68,15 @@ sub _next { ...@@ -70,12 +68,15 @@ 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;
} }
my ($email, $gecos) = ($1, $2); 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; $gecos =~ s/\s+\z// if defined $gecos;
$found++; $found++;
......
...@@ -111,15 +111,17 @@ sub _start_document { ...@@ -111,15 +111,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;
} }
...@@ -207,12 +209,11 @@ sub decorate_email_at { ...@@ -207,12 +209,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};
...@@ -236,13 +237,12 @@ sub decorate_email_gecos { ...@@ -236,13 +237,12 @@ sub decorate_email_gecos {
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};
...@@ -270,10 +270,9 @@ sub decorate_email_js { ...@@ -270,10 +270,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));
......
...@@ -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]*';
......
...@@ -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) {
......
...@@ -45,6 +45,10 @@ BEGIN { eval 'use Unicode::UTF8 qw()'; } ...@@ -45,6 +45,10 @@ BEGIN { eval 'use Unicode::UTF8 qw()'; }
use Sympa::Language; use Sympa::Language;
use Sympa::Regexps; 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(). # Old name: tools::addrencode().
sub addrencode { sub addrencode {
my $addr = shift; my $addr = shift;
...@@ -172,11 +176,10 @@ sub wrap_text { ...@@ -172,11 +176,10 @@ sub wrap_text {
$cols //= 78; $cols //= 78;
return $text unless $cols; return $text unless $cols;
my $email_re = Sympa::Regexps::email();
my $linefold = Text::LineFold->new( my $linefold = Text::LineFold->new(
Language => Sympa::Language->instance->get_lang, Language => Sympa::Language->instance->get_lang,
Prep => 'NONBREAKURI', Prep => 'NONBREAKURI',
prep => [$email_re, sub { shift; @_ }], prep => [$email_like_re, sub { shift; @_ }],
ColumnsMax => $cols, ColumnsMax => $cols,
Format => sub { Format => sub {
shift; shift;
...@@ -505,11 +508,7 @@ sub unescape_chars { ...@@ -505,11 +508,7 @@ sub unescape_chars {
sub valid_email { sub valid_email {
my $email = shift; my $email = shift;
my $email_re = Sympa::Regexps::email(); return undef unless $email =~ /\A$email_re\z/;
return undef unless $email =~ /^${email_re}$/;
# Forbidden characters.
return undef if $email =~ /[\|\$\*\?\!]/;
return 1; return 1;
} }
......
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