X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=lib%2FPublicInbox%2FMDA.pm;h=8c2d6ed25e2301959961b9b758463e0de9fbcab7;hb=f76f265a851944b5dedcc3be5f3b5224b6ebda89;hp=bb14ae50cf27a8d28dd9bf87d40686814a2f8650;hpb=a8d9e2f1853032016db6ff177979873b3bdadd85;p=public-inbox.git diff --git a/lib/PublicInbox/MDA.pm b/lib/PublicInbox/MDA.pm index bb14ae50..8c2d6ed2 100644 --- a/lib/PublicInbox/MDA.pm +++ b/lib/PublicInbox/MDA.pm @@ -1,12 +1,11 @@ -# Copyright (C) 2013, Eric Wong and all contributors +# Copyright (C) 2013-2015 all contributors # License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt) package PublicInbox::MDA; use strict; use warnings; use Email::Address; -use Encode qw/decode encode/; use Date::Parse qw(strptime); -use constant MAX_SIZE => 1024 * 500; # same as spamc default +use constant MAX_SIZE => 1024 * 500; # same as spamc default, should be tunable use constant cmd => qw/ssoma-mda -1/; # drop plus addressing for matching @@ -18,7 +17,7 @@ sub __drop_plus { # do not allow Bcc, only Cc and To if recipient is set sub precheck { - my ($klass, $filter, $recipient) = @_; + my ($klass, $filter, $address) = @_; my $simple = $filter->simple; my $mid = $simple->header("Message-ID"); return 0 unless usable_str(length(''), $mid) && $mid =~ /\@/; @@ -26,7 +25,7 @@ sub precheck { return 0 unless usable_str(length(':o'), $simple->header("Subject")); return 0 unless usable_date($simple->header("Date")); return 0 if length($simple->as_string) > MAX_SIZE; - recipient_specified($filter, $recipient); + alias_specified($filter, $address); } sub usable_str { @@ -39,48 +38,57 @@ sub usable_date { scalar @t; } -sub recipient_specified { - my ($filter, $recipient) = @_; - defined($recipient) or return 1; # for mass imports - my @recip = Email::Address->parse($recipient); - my $oaddr = __drop_plus($recip[0]->address); - $oaddr = qr/\b\Q$oaddr\E\b/i; - my @to = Email::Address->parse($filter->to); - my @cc = Email::Address->parse($filter->cc); - foreach my $addr (@to, @cc) { - if (__drop_plus($addr->address) =~ $oaddr) { - return 1; +sub alias_specified { + my ($filter, $address) = @_; + + my @address = ref($address) eq 'ARRAY' ? @$address : ($address); + my %ok = map { + my @recip = Email::Address->parse($_); + lc(__drop_plus($recip[0]->address)) => 1; + } @address; + + foreach my $line ($filter->cc, $filter->to) { + foreach my $addr (Email::Address->parse($line)) { + if ($ok{lc(__drop_plus($addr->address))}) { + return 1; + } } } return 0; } -# RFC2919 and RFC2369 sub set_list_headers { my ($class, $simple, $dst) = @_; - my $pa = "<$dst->{-primary_address}>"; - $simple->header_set("List-Id", $pa); - $simple->header_set("List-Post", $pa); + my $pa = $dst->{-primary_address}; + + $simple->header_set("List-Id", "<$pa>"); # RFC2919 + + # remove Delivered-To: prevent training loops + # The rest are taken from Mailman 2.1.15, some may be used for phishing + foreach my $h (qw(delivered-to approved approve x-approved x-approve + urgent return-receipt-to disposition-notification-to + x-confirm-reading-to x-pmrqc)) { + $simple->header_set($h); + } - my $url = $dst->{url}; - if (defined $url) { - $simple->header_set("List-Archive", "<$url>"); - $simple->header_set("List-Help", "<${url}help>"); + # Remove any "DomainKeys" (or similar) header lines. + # Any modifications (including List-Id) will cause a message + # to appear invalid + foreach my $h (qw(domainkey-signature dkim-signature + authentication-results)) { + $simple->header_set($h); } } # returns a 3-element array: name, email, date sub author_info { - my ($class, $simple) = @_; + my ($class, $mime) = @_; - my $from = decode('MIME-Header', $simple->header('From')); - $from = encode('utf8', $from); + my $from = $mime->header('From'); my @from = Email::Address->parse($from); my $name = $from[0]->name; - defined $name or $name = ''; my $email = $from[0]->address; - defined $email or $email = ''; - ($name, $email, $simple->header('Date')); + ($name, $email, $mime->header('Date')); } 1;