lib/PublicInbox/SaPlugin/ListMirror.pm

   1 # Copyright (C) all contributors <meta@public-inbox.org>
   2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   3
   4 # SpamAssassin rules useful for running a mailing list mirror.  We want to:
   5 # * ensure Received: headers are really from the list mail server
   6 #   users expect.  This is to prevent malicious users from
   7 #   injecting spam into mirrors without going through the expected
   8 #   server
   9 # * flag messages where the mailing list is Bcc:-ed since it is
  10 #   common for spam to have wrong or non-existent To:/Cc: headers.
  11
  12 package PublicInbox::SaPlugin::ListMirror;
  13 use strict;
  14 use warnings;
  15 use base qw(Mail::SpamAssassin::Plugin);
  16
  17 # constructor: register the eval rules
  18 sub new {
  19         my ($class, $mail) = @_;
  20
  21         # some boilerplate...
  22         $class = ref($class) || $class;
  23         my $self = $class->SUPER::new($mail);
  24         bless $self, $class;
  25         $mail->{conf}->{list_mirror_check} = [];
  26         $self->register_eval_rule('check_list_mirror_received');
  27         $self->register_eval_rule('check_list_mirror_bcc');
  28         $self->set_config($mail->{conf});
  29         $self;
  30 }
  31
  32 sub check_list_mirror_received {
  33         my ($self, $pms) = @_;
  34         my $recvd = $pms->get('Received') || '';
  35         $recvd =~ s/\n.*\z//s;
  36
  37         foreach my $cfg (@{$pms->{conf}->{list_mirror_check}}) {
  38                 my ($hdr, $hval, $host_re, $addr_re) = @$cfg;
  39                 my $v = $pms->get($hdr) or next;
  40                 local $/ = "\n";
  41                 chomp $v;
  42                 if (ref($hval)) {
  43                         next if $v !~ $hval;
  44                 } else {
  45                         next if $v ne $hval;
  46                 }
  47                 return 1 if $recvd !~ $host_re;
  48         }
  49
  50         0;
  51 }
  52
  53 sub check_list_mirror_bcc {
  54         my ($self, $pms) = @_;
  55         my $tocc = $pms->get('ToCc');
  56
  57         foreach my $cfg (@{$pms->{conf}->{list_mirror_check}}) {
  58                 my ($hdr, $hval, $host_re, $addr_re) = @$cfg;
  59                 defined $addr_re or next;
  60                 my $v = $pms->get($hdr) or next;
  61                 local $/ = "\n";
  62                 chomp $v;
  63                 next if $v ne $hval;
  64                 return 1 if !$tocc || $tocc !~ $addr_re;
  65         }
  66
  67         0;
  68 }
  69
  70 # list_mirror HEADER HEADER_VALUE HOSTNAME_GLOB [LIST_ADDRESS]
  71 # list_mirror X-Mailing-List git@vger.kernel.org *.kernel.org
  72 # list_mirror List-Id <foo.example.org> *.example.org foo@example.org
  73 sub config_list_mirror {
  74         my ($self, $key, $value, $line) = @_;
  75
  76         defined $value or
  77                 return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
  78
  79         my ($hdr, $hval, $host_glob, @extra) = split(/\s+/, $value);
  80         my $addr = shift @extra;
  81
  82         if (defined $addr) {
  83                 $addr !~ /\@/ and
  84                         return $Mail::SpamAssassin::Conf::INVALID_VALUE;
  85                 $addr = join('|', map { quotemeta } split(/,/, $addr));
  86                 $addr = qr/\b$addr\b/i;
  87         }
  88
  89         @extra and return $Mail::SpamAssassin::Conf::INVALID_VALUE;
  90
  91         defined $host_glob or
  92                 return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
  93
  94         my %patmap = ('*' => '\S+', '?' => '.', '[' => '[', ']' => ']');
  95         $host_glob =~ s!(.)!$patmap{$1} || "\Q$1"!ge;
  96         my $host_re = qr/\A\s*from\s+$host_glob(?:\s|$)/si;
  97
  98         (lc($hdr) eq 'list-id' && $hval =~ /<([^>]+)>/) and
  99                 $hval = qr/\A<\Q$1\E>\z/;
 100         push @{$self->{list_mirror_check}}, [ $hdr, $hval, $host_re, $addr ];
 101 }
 102
 103 sub set_config {
 104         my ($self, $conf) = @_;
 105         my @cmds;
 106         push @cmds, {
 107                 setting => 'list_mirror',
 108                 default => '',
 109                 type => $Mail::SpamAssassin::Conf::CONF_TYPE_STRING,
 110                 code => *config_list_mirror,
 111         };
 112         $conf->{parser}->register_commands(\@cmds);
 113 }
 114
 115 1;