Commit dd635ab7 authored by sikeda's avatar sikeda
Browse files

[-bug] Problems of DMARC protection: It breaks archived messages; resent...

[-bug] Problems of DMARC protection: It breaks archived messages; resent messages via WWSympa mailer won't be protected.  Fixed by making protection to occur at the time of bulk sending.


git-svn-id: https://subversion.renater.fr/sympa/branches/sympa-6.2-branch@11755 05aa8bb8-cd2b-0410-b1d7-8918dfa770ce
parent e27fb511
......@@ -786,10 +786,10 @@ our %in_regexp = (
'dump' => '[^<>\\\*\$]+', # contents email + gecos
 
## Search
'filter' => '.*', # search subscriber
'filter' => '.*', # search subscriber
'filter_list' => '.*', # search list
'key_word' => '.*',
'format' => '[^<>\\\$\n]+', # dump format/filter string
'key_word' => '.*',
'format' => '[^<>\\\$\n]+', # dump format/filter string
 
## File names
'file' => '[^<>\*\$\n]+',
......@@ -1755,34 +1755,40 @@ while ($query = new_loop()) {
) {
wwslog('notice', 'Could not set HTTP cookie');
}
$param->{'is_user_allowed_to'} = sub {
my $permission = shift;
my $list = shift;
return 0 unless $permission and $list;
$list = Sympa::List->new($list, $robot) unless ref $list eq 'Sympa::List';
my $result = Sympa::Scenario::request_action(
$list,
$permission,
$param->{'auth_method'},
{
'sender' => $param->{'user'}{'email'},
'remote_host' => $param->{'remote_host'},
'remote_addr' => $param->{'remote_addr'}
}
);
return 0 unless ref($result) eq 'HASH' and $result->{'action'} ne 'reject';
return 0 if $permission eq 'subscribe' and $list->is_list_member($param->{'user'}{'email'});
return 0 if $permission eq 'web_archive.access' and not defined $list->{'admin'}{'web_archive'};
return 1;
};
my $permission = shift;
my $list = shift;
return 0 unless $permission and $list;
$list = Sympa::List->new($list, $robot)
unless ref $list eq 'Sympa::List';
my $result = Sympa::Scenario::request_action(
$list,
$permission,
$param->{'auth_method'},
{ 'sender' => $param->{'user'}{'email'},
'remote_host' => $param->{'remote_host'},
'remote_addr' => $param->{'remote_addr'}
}
);
return 0
unless ref($result) eq 'HASH'
and $result->{'action'} ne 'reject';
return 0
if $permission eq 'subscribe'
and $list->is_list_member($param->{'user'}{'email'});
return 0
if $permission eq 'web_archive.access'
and not defined $list->{'admin'}{'web_archive'};
return 1;
};
 
## Set cookies "your_subscribtions" unless in one list page
if ($param->{'user'}{'email'} && ref($list) ne 'Sympa::List') {
......@@ -10428,6 +10434,13 @@ sub do_send_me {
 
# Add footer/header.
$message->decorate;
# Shelve DMARC protection.
$message->{shelved}{dmarc_protect} = 1
if $list->{'admin'}{'dmarc_protection'}
and $list->{'admin'}{'dmarc_protection'}{'mode'}
and not $list->{'admin'}{'anonymous_sender'};
# Shelve personalization.
$message->{shelved}{merge} = 1
if Sympa::Tools::Data::smart_eq($list->{'admin'}{'merge_feature'},
......@@ -12116,11 +12129,10 @@ sub do_edit_attributes {
return 1;
}
 
## list search form
sub do_search_list_request {
wwslog('info', '');
return 1;
}
 
......@@ -12159,8 +12171,17 @@ sub do_search_list {
next unless ($r_action eq 'do_it');
 
if ($param->{'user'}{'email'}
&& ( $list->am_i('owner', $param->{'user'}{'email'}, {'strict' => 1})
|| $list->am_i('editor', $param->{'user'}{'email'}, {'strict' => 1}))
&& ($list->am_i(
'owner',
$param->{'user'}{'email'},
{'strict' => 1}
)
|| $list->am_i(
'editor',
$param->{'user'}{'email'},
{'strict' => 1}
)
)
) {
$is_admin = 1;
}
......@@ -13605,7 +13626,7 @@ sub _prepare_data {
$p_glob->{'type'} = 'enum';
 
foreach my $elt (keys %{$constraint}) {
$elt =~ s/"/&quot;/;
$elt =~ s/"/&quot;/;
$p->{'value'}{$elt}{'selected'} = 0;
}
 
......@@ -22064,9 +22085,12 @@ sub do_send_mail {
unless ($fh) {
wwslog('err', 'Can\'t upload %s', $in{'uploaded_file'});
Sympa::Report::reject_report_web(
'intern', 'cannot_upload',
{'path' => $in{'uploaded_file'}}, $param->{'action'},
$list, $param->{'user'}{'email'},
'intern',
'cannot_upload',
{'path' => $in{'uploaded_file'}},
$param->{'action'},
$list,
$param->{'user'}{'email'},
$robot
);
web_db_log(
......
......@@ -33,10 +33,8 @@ use HTML::Entities qw();
use HTTP::Request;
use IO::Scalar;
use LWP::UserAgent;
use Mail::Address;
use MIME::Charset;
use MIME::EncWords;
use Net::DNS;
use POSIX qw();
use Storable qw();
use Time::Local qw();
......@@ -1585,202 +1583,7 @@ sub distribute_msg {
}
}
# Munge the From header if we are using DMARC Protection mode
if ($self->{'admin'}{'dmarc_protection'}{'mode'}
and not $self->{'admin'}{'anonymous_sender'}) {
Log::do_log('debug', 'DMARC protection on');
my $dkimdomain = $self->{'admin'}{'dmarc_protection'}{'domain_regex'};
my $originalFromHeader = $message->get_header('From');
my $anonaddr;
my @addresses = Mail::Address->parse($originalFromHeader);
my @anonFrom;
my $dkimSignature = $message->get_header('DKIM-Signature');
my $origFrom = '';
my $mungeFrom = 0;
if (@addresses) {
$origFrom = $addresses[0]->address;
Log::do_log('debug', 'From addresses: %s', $origFrom);
}
# Will this message be processed?
if (Sympa::Tools::Data::is_in_array(
$self->{'admin'}{'dmarc_protection'}{'mode'}, 'all'
)
) {
Log::do_log('debug', 'Munging From for ALL messages');
$mungeFrom = 1;
}
if ( !$mungeFrom
and $dkimSignature
and Sympa::Tools::Data::is_in_array(
$self->{'admin'}{'dmarc_protection'}{'mode'},
'dkim_signature'
)
) {
Log::do_log('debug', 'Munging From for DKIM-signed messages');
$mungeFrom = 1;
}
if ( !$mungeFrom
and $origFrom
and $dkimdomain
and Sympa::Tools::Data::is_in_array(
$self->{'admin'}{'dmarc_protection'}{'mode'},
'domain_regex'
)
) {
Log::do_log('debug',
'Munging From for messages based on domain regexp');
$mungeFrom = 1 if ($origFrom =~ /$dkimdomain$/);
}
if ( !$mungeFrom
and $origFrom
and (
Sympa::Tools::Data::is_in_array(
$self->{'admin'}{'dmarc_protection'}{'mode'},
'dmarc_reject')
or Sympa::Tools::Data::is_in_array(
$self->{'admin'}{'dmarc_protection'}{'mode'}, 'dmarc_any')
or Sympa::Tools::Data::is_in_array(
$self->{'admin'}{'dmarc_protection'}{'mode'},
'dmarc_quarantine'
)
)
) {
Log::do_log('debug',
'Munging From for messages with strict policy');
# Strict auto policy - is the sender domain policy to reject
my $dom = $origFrom;
$dom =~ s/^.*\@//;
my $res = Net::DNS::Resolver->new;
my $packet = $res->query("_dmarc.$dom", "TXT");
if ($packet) {
Log::do_log('debug', 'DMARC DNS entry found');
foreach my $rr (grep { $_->type eq 'TXT' } $packet->answer) {
next if ($rr->string !~ /v=DMARC/);
if (!$mungeFrom
and Sympa::Tools::Data::is_in_array(
$self->{'admin'}{'dmarc_protection'}{'mode'},
'dmarc_reject'
)
) {
Log::do_log('debug', 'Will block if DMARC rejects');
if ($rr->string =~ /p=reject/) {
Log::do_log('debug', 'DMARC reject policy found');
$mungeFrom = 1;
}
}
if (!$mungeFrom
and Sympa::Tools::Data::is_in_array(
$self->{'admin'}{'dmarc_protection'}{'mode'},
'dmarc_quarantine'
)
) {
Log::do_log('debug',
'Will block if DMARC quarantine');
if ($rr->string =~ /p=quarantine/) {
Log::do_log('debug',
'DMARC quarantine policy found');
$mungeFrom = 1;
}
}
if (!$mungeFrom
and Sympa::Tools::Data::is_in_array(
$self->{'admin'}{'dmarc_protection'}{'mode'},
'dmarc_any'
)
) {
Log::do_log('debug',
'Will munge whatever DMARC policy is');
$mungeFrom = 1;
}
$message->add_header(
'X-Original-DMARC-Record',
"domain=$dom; " . $rr->string
);
last;
}
}
}
if ($mungeFrom) {
Log::do_log('debug', 'Will munge From field');
# Remove any DKIM signatures we find
if ($dkimSignature) {
$message->add_header('X-Original-DKIM-Signature',
$dkimSignature);
$message->delete_header('DKIM-Signature');
$message->delete_header('DomainKey-Signature');
Log::do_log('debug',
'Removing previous DKIM and DomainKey signatures');
}
# Identify default new From address
my $phraseMode = $self->{'admin'}{'dmarc_protection'}{'phrase'}
|| 'name_via_list';
my $newAddr;
my $displayName;
my $newComment;
$anonaddr = $self->{'admin'}{'dmarc_protection'}{'other_email'};
$anonaddr = $self->get_list_address()
unless $anonaddr and $anonaddr =~ /\@/;
@anonFrom = Mail::Address->parse($anonaddr);
Log::do_log('debug', 'Anonymous From: %s', $anonaddr);
if (@addresses) {
# We should always have a From address in reality, unless the
# message is from a badly-behaved automate
if ($addresses[0]->phrase) {
$displayName = MIME::EncWords::decode_mimewords(
$addresses[0]->phrase, Charset => 'UTF-8');
$newComment = $addresses[0]->address
if $phraseMode =~ /email/;
} else {
# If we dont have a Phrase, should we search the Sympa
# database
# for the sender to obtain their name that way? Might be
# difficult.
$displayName = $addresses[0]->address;
$displayName =~ s/\@.*// unless $phraseMode =~ /email/;
}
if ($phraseMode =~ /list/) {
if ($newComment and $newComment =~ /\S/) {
$newComment = $language->gettext_sprintf(
'%s via %s Mailing List',
$newComment, $self->{'name'});
} else {
$newComment =
$language->gettext_sprintf('via %s Mailing List',
$self->{'name'});
}
}
$message->add_header('Reply-To', $addresses[0]->address)
unless $message->get_header('Reply-To');
}
# If the new From email address has a Phrase component, then
# append it
if (@anonFrom and $anonFrom[0]->phrase) {
if ($displayName and $displayName =~ /\S/) {
$displayName .= ' ' . $anonFrom[0]->phrase;
} else {
$displayName = $anonFrom[0]->phrase;
}
}
$displayName = $language->gettext('Anonymous')
unless $displayName and $displayName =~ /\S/;
$newAddr = tools::addrencode(
(@anonFrom ? $anonFrom[0]->address : $anonaddr),
$displayName, tools::lang2charset($language->get_lang),
$newComment);
$message->add_header('X-Original-From', "$originalFromHeader");
$message->replace_header('From', $newAddr);
}
}
## Hide the sender if the list is anonymoused
# Hide the sender if the list is anonymized
if ($self->{'admin'}{'anonymous_sender'}) {
foreach my $field (@{$Conf::Conf{'anonymous_header_fields'}}) {
$message->delete_header($field);
......@@ -2233,6 +2036,12 @@ sub _mail_message {
my $list = $message->{context};
# Shelve DMARC protection.
$message->{shelved}{dmarc_protect} = 1
if $list->{'admin'}{'dmarc_protection'}
and $list->{'admin'}{'dmarc_protection'}{'mode'}
and not $list->{'admin'}{'anonymous_sender'};
# Shelve personalization.
$message->{shelved}{merge} = 1
if Sympa::Tools::Data::smart_eq($list->{'admin'}{'merge_feature'},
......
......@@ -61,6 +61,7 @@ use MIME::EncWords;
use MIME::Entity;
use MIME::Parser;
use MIME::Tools;
use Net::DNS;
use Scalar::Util qw();
use URI::Escape qw();
......@@ -76,7 +77,6 @@ use Log;
use Sympa::Scenario;
use tools;
use Sympa::Tools::Data;
use Sympa::Tools::DKIM;
use Sympa::Tools::File;
use Sympa::Tools::Password;
use Sympa::Tools::SMIME;
......@@ -4095,6 +4095,226 @@ sub _getCharset {
=over
=item dmarc_protect ( )
I<Instance method>.
Munge the C<From:> header field if we are using DMARC Protection mode.
Parameters:
None.
Returns:
None.
C<From:> field of the message may be modified.
=back
=cut
sub dmarc_protect {
my $self = shift;
my $list = $self->{context};
return unless ref $list eq 'Sympa::List';
return
unless $list->{'admin'}{'dmarc_protection'}
and $list->{'admin'}{'dmarc_protection'}{'mode'};
Log::do_log('debug', 'DMARC protection on');
my $dkimdomain = $list->{'admin'}{'dmarc_protection'}{'domain_regex'};
my $originalFromHeader = $self->get_header('From');
my $anonaddr;
my @addresses = Mail::Address->parse($originalFromHeader);
my @anonFrom;
my $dkimSignature = $self->get_header('DKIM-Signature');
my $origFrom = '';
my $mungeFrom = 0;
if (@addresses) {
$origFrom = $addresses[0]->address;
Log::do_log('debug', 'From addresses: %s', $origFrom);
}
# Will this message be processed?
if (Sympa::Tools::Data::is_in_array(
$list->{'admin'}{'dmarc_protection'}{'mode'}, 'all'
)
) {
Log::do_log('debug', 'Munging From for ALL messages');
$mungeFrom = 1;
}
if ( !$mungeFrom
and $dkimSignature
and Sympa::Tools::Data::is_in_array(
$list->{'admin'}{'dmarc_protection'}{'mode'},
'dkim_signature'
)
) {
Log::do_log('debug', 'Munging From for DKIM-signed messages');
$mungeFrom = 1;
}
if ( !$mungeFrom
and $origFrom
and $dkimdomain
and Sympa::Tools::Data::is_in_array(
$list->{'admin'}{'dmarc_protection'}{'mode'},
'domain_regex'
)
) {
Log::do_log('debug',
'Munging From for messages based on domain regexp');
$mungeFrom = 1 if ($origFrom =~ /$dkimdomain$/);
}
if ( !$mungeFrom
and $origFrom
and (
Sympa::Tools::Data::is_in_array(
$list->{'admin'}{'dmarc_protection'}{'mode'},
'dmarc_reject')
or Sympa::Tools::Data::is_in_array(
$list->{'admin'}{'dmarc_protection'}{'mode'}, 'dmarc_any')
or Sympa::Tools::Data::is_in_array(
$list->{'admin'}{'dmarc_protection'}{'mode'},
'dmarc_quarantine'
)
)
) {
Log::do_log('debug', 'Munging From for messages with strict policy');
# Strict auto policy - is the sender domain policy to reject
my $dom = $origFrom;
$dom =~ s/^.*\@//;
my $res = Net::DNS::Resolver->new;
my $packet = $res->query("_dmarc.$dom", "TXT");
if ($packet) {
Log::do_log('debug', 'DMARC DNS entry found');
foreach my $rr (grep { $_->type eq 'TXT' } $packet->answer) {
next if ($rr->string !~ /v=DMARC/);
if (!$mungeFrom
and Sympa::Tools::Data::is_in_array(
$list->{'admin'}{'dmarc_protection'}{'mode'},
'dmarc_reject'
)
) {
Log::do_log('debug', 'Will block if DMARC rejects');
if ($rr->string =~ /p=reject/) {
Log::do_log('debug', 'DMARC reject policy found');
$mungeFrom = 1;
}
}
if (!$mungeFrom
and Sympa::Tools::Data::is_in_array(
$list->{'admin'}{'dmarc_protection'}{'mode'},
'dmarc_quarantine'
)
) {
Log::do_log('debug', 'Will block if DMARC quarantine');
if ($rr->string =~ /p=quarantine/) {
Log::do_log('debug',
'DMARC quarantine policy found');
$mungeFrom = 1;
}
}
if (!$mungeFrom
and Sympa::Tools::Data::is_in_array(
$list->{'admin'}{'dmarc_protection'}{'mode'},
'dmarc_any'
)
) {
Log::do_log('debug',
'Will munge whatever DMARC policy is');
$mungeFrom = 1;
}
$self->add_header(
'X-Original-DMARC-Record',
"domain=$dom; " . $rr->string
);
last;
}
}
}
if ($mungeFrom) {
Log::do_log('debug', 'Will munge From field');
# Remove any DKIM signatures we find
if ($dkimSignature) {
$self->add_header('X-Original-DKIM-Signature', $dkimSignature);
$self->delete_header('DKIM-Signature');
$self->delete_header('DomainKey-Signature');
Log::do_log('debug',
'Removing previous DKIM and DomainKey signatures');
}
# Identify default new From address
my $phraseMode = $list->{'admin'}{'dmarc_protection'}{'phrase'}
|| 'name_via_list';
my $newAddr;
my $displayName;
my $newComment;
$anonaddr = $list->{'admin'}{'dmarc_protection'}{'other_email'};
$anonaddr = $list->get_list_address()
unless $anonaddr and $anonaddr =~ /\@/;
@anonFrom = Mail::Address->parse($anonaddr);
Log::do_log('debug', 'Anonymous From: %s', $anonaddr);
if (@addresses) {
# We should always have a From address in reality, unless the
# message is from a badly-behaved automate
if ($addresses[0]->phrase) {
$displayName =
MIME::EncWords::decode_mimewords($addresses[0]->phrase,
Charset => 'UTF-8');
$newComment = $addresses[0]->address
if $phraseMode =~ /email/;
} else {
# If we dont have a Phrase, should we search the Sympa
# database
# for the sender to obtain their name that way? Might be
# difficult.
$displayName = $addresses[0]->address;
$displayName =~ s/\@.*// unless $phraseMode =~ /email/;
}
if ($phraseMode =~ /list/) {
if ($newComment and $newComment =~ /\S/) {
$newComment =
$language->gettext_sprintf('%s via %s Mailing List',
$newComment, $list->{'name'});
} else {
$newComment =
$language->gettext_sprintf('via %s Mailing List',
$list->{'name'});
}
}
$self->add_header('Reply-To', $addresses[0]->address)
unless $self->get_header('Reply-To');
}
# If the new From email address has a Phrase component, then
# append it
if (@anonFrom and $anonFrom[0]->phrase) {
if ($displayName and $displayName =~ /\S/) {
$displayName .= ' ' . $anonFrom[0]->phrase;
} else {
$displayName = $anonFrom[0]->phrase;
}
}
$displayName = $language->gettext('Anonymous')
unless $displayName and $displayName =~ /\S/;
$newAddr = tools::addrencode(
(@anonFrom ? $anonFrom[0]->address : $anonaddr), $displayName,
tools::lang2charset($language->get_lang), $newComment
);
$self->add_header('X-Original-From', "$originalFromHeader");
$self->replace_header('From', $newAddr);
}
}
=over
=item get_id ( )
I<Instance method>.
......@@ -4243,6 +4463,10 @@ Currently these items are available:
Adding DKIM signature.
=item dmarc_protect =E<gt> 1
DMARC protection. See also L</dmarc_protect>().
=item merge =E<gt> 1
Personalizing.
......
......@@ -381,13 +381,18 @@ while (!$end) {
## Use an intermediate handler to encode to filesystem_encoding
my $user;