diff options
Diffstat (limited to 'examples/unsubscribe.milter')
| -rw-r--r-- | examples/unsubscribe.milter | 46 |
1 files changed, 43 insertions, 3 deletions
diff --git a/examples/unsubscribe.milter b/examples/unsubscribe.milter index 23229511..8c682012 100644 --- a/examples/unsubscribe.milter +++ b/examples/unsubscribe.milter @@ -1,8 +1,7 @@ #!/usr/bin/perl -w -# Copyright (C) 2016-2020 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; -use warnings; use Sendmail::PMilter qw(:all); use IO::Socket; use Crypt::CBC; @@ -28,6 +27,28 @@ my $crypt = Crypt::CBC->new(-key => $key, -cipher => 'Blowfish'); $fh = $iv = $key = undef; +my $allow_domains = '/etc/unsubscribe-milter.allow_domains'; +my $ALLOW_DOMAINS; +if (open my $fh, '<', $allow_domains) { + local $/ = "\n"; + chomp(my @l = <$fh>); + die "close: $!" unless eof($fh) && close($fh); + my %l = map { lc($_) => 1 } @l; + $ALLOW_DOMAINS = \%l; +} else { + warn <<EOM; +W: open $allow_domains: $! (all domains allowed) +W: all mlmmj-looking messages will have List-Unsubscribe added, +W: this is probably not what you want. +EOM +} + +# only allow users hitting SMTP server locally: +# Is a config file necessary? Regexps are ugly for IP addresses +# but Net::Patricia (or similar) seems like overkill. Ugly it is: +my @ALLOW_ADDR = (qr/\A::1\z/, qr/\A127\./); +my $ALLOW_ADDR = join('|', @ALLOW_ADDR); + my %cbs; $cbs{connect} = sub { my ($ctx) = @_; @@ -89,14 +110,29 @@ $cbs{eom} = sub { eval { my $priv = $ctx->getpriv; $ctx->setpriv({ header => {}, envrcpt => {} }); - my @rcpt = keys %{$priv->{envrcpt}}; + + # XXX my postfix (3.5.18-0+deb11u1) + Sendmail::PMilter + # instance doesn't seem to get {client_addr}, but + # {daemon_addr} seems to make sense since I only want it + # to apply to users connecting to postfix locally: + if ($ALLOW_ADDR) { + my $x = $ctx->getsymval('{daemon_addr}'); + return SMFIS_CONTINUE if $x && $x !~ /$ALLOW_ADDR/; + } # one recipient, one unique HTTP(S) URL + my @rcpt = keys %{$priv->{envrcpt}}; return SMFIS_CONTINUE if @rcpt != 1; + if ($ALLOW_DOMAINS) { + my $addr = $ctx->getsymval('{mail_addr}'); + my (undef, $d) = split /\@/, $addr; + return SMFIS_CONTINUE if !$ALLOW_DOMAINS->{$d}; + } return SMFIS_CONTINUE if archive_addr(lc($rcpt[0])); my $unsub = $priv->{header}->{'list-unsubscribe'} || []; my $n = 0; + my $added; foreach my $u (@$unsub) { # Milter indices are 1-based, # not 0-based like Perl arrays @@ -115,7 +151,11 @@ $cbs{eom} = sub { $v .= ",\n <https://$domain/u/$u/$list>"; $ctx->chgheader($k, $index, $v); + $added = 1; } + # RFC 8058 + $added and $ctx->addheader('List-Unsubscribe-Post', + 'List-Unsubscribe=One-Click'); }; warn $@ if $@; SMFIS_CONTINUE; |