about summary refs log tree commit homepage
path: root/examples
diff options
context:
space:
mode:
Diffstat (limited to 'examples')
-rw-r--r--examples/README.unsubscribe40
-rw-r--r--examples/unsubscribe-milter.socket10
-rw-r--r--examples/unsubscribe-milter@.service24
-rw-r--r--examples/unsubscribe-psgi.socket11
-rw-r--r--examples/unsubscribe-psgi@.service20
-rw-r--r--examples/unsubscribe.milter137
-rw-r--r--examples/unsubscribe.psgi68
7 files changed, 310 insertions, 0 deletions
diff --git a/examples/README.unsubscribe b/examples/README.unsubscribe
new file mode 100644
index 00000000..7c41067c
--- /dev/null
+++ b/examples/README.unsubscribe
@@ -0,0 +1,40 @@
+Unsubscribe endpoints for mlmmj users (and possibly Mailman, too)
+
+* examples/unsubscribe.milter filters outgoing messages
+  and appends an HTTPS URL to the List-Unsubscribe header.
+  This List-Unsubscribe header should point to the PSGI
+  described below.
+  Currently, this is only active for a whitelist of test
+  addresses in /etc/unsubscribe-milter.whitelist
+  with one email address per line.
+
+* examples/unsubscribe.psgi is a PSGI which needs to run
+  as the mlmmj user with permission to run mlmmj-unsub.
+  This depends on the PublicInbox::Unsubscribe module
+  which may be extracted from the rest of public-inbox.
+  It is strongly recommended to NOT run the rest of the
+  public-inbox WWW code in the same process as this PSGI.
+  (The public-inbox WWW code will never need write
+   permissions to anything besides stderr).
+
+* Both the .milter and .psgi examples are bundled with
+  systemd service and socket activation examples.
+  AFAIK no other PSGI server besides public-inbox-httpd
+  supports systemd socket activation.
+
+To wire up the milter for postfix, I use the following
+in /etc/postfix/main.cf:
+
+  # Milter configuration
+  milter_default_action = accept
+  milter_protocol = 2
+
+  # other milters may be chained here (e.g. opendkim)
+  # chroot users will need to adjust this path
+  smtpd_milters = local:/var/spool/postfix/unsubscribe/unsubscribe.sock
+
+  # This is not needed for mlmmj since mlmmj uses SMTP:
+  # non_smtpd_milters = local:/var/spool/postfix/unsubscribe/unsubscribe.sock
+
+Copyright (C) 2016 all contributors <meta@public-inbox.org>
+License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
diff --git a/examples/unsubscribe-milter.socket b/examples/unsubscribe-milter.socket
new file mode 100644
index 00000000..bfaa97a1
--- /dev/null
+++ b/examples/unsubscribe-milter.socket
@@ -0,0 +1,10 @@
+# ==> /etc/systemd/system/unsubscribe-milter.socket <==
+[Unit]
+Description = unsubscribe.milter socket
+
+[Socket]
+ListenStream = /var/spool/postfix/unsubscribe/unsubscribe.sock
+Service = unsubscribe-milter@1.service
+
+[Install]
+WantedBy = sockets.target
diff --git a/examples/unsubscribe-milter@.service b/examples/unsubscribe-milter@.service
new file mode 100644
index 00000000..98e3d478
--- /dev/null
+++ b/examples/unsubscribe-milter@.service
@@ -0,0 +1,24 @@
+# ==> /etc/systemd/system/unsubscribe-milter@.service <==
+# The '@' is to allow multiple simultaneous services to start
+# and share the same socket so new code can be cycled in
+# without downtime
+
+[Unit]
+Description = unsubscribe milter %i
+Wants = unsubscribe-milter.socket
+After = unsubscribe-milter.socket
+
+[Service]
+# First 8 bytes is for the key, next 8 bytes is for the IV
+# using Blowfish.  We want as short URLs as possible to avoid
+# copy+paste errors
+# umask 077 && dd if=/dev/urandom bs=16 count=1 of=.unsubscribe.key
+ExecStart = /usr/local/sbin/unsubscribe.milter /home/mlmmj/.unsubscribe.key
+Sockets = unsubscribe-milter.socket
+
+# the corresponding PSGI app needs permissions to modify the
+# mlmmj spool, so we might as well use the same user since
+User = mlmmj
+
+[Install]
+WantedBy = multi-user.target
diff --git a/examples/unsubscribe-psgi.socket b/examples/unsubscribe-psgi.socket
new file mode 100644
index 00000000..e7ab797b
--- /dev/null
+++ b/examples/unsubscribe-psgi.socket
@@ -0,0 +1,11 @@
+# ==> /etc/systemd/system/unsubscribe-psgi.socket <==
+[Unit]
+Description = unsubscribe PSGI socket
+
+[Socket]
+# Forward to the PSGI using nginx or similar
+ListenStream = /run/unsubscribe-psgi.sock
+Service = unsubscribe-psgi@1.service
+
+[Install]
+WantedBy = sockets.target
diff --git a/examples/unsubscribe-psgi@.service b/examples/unsubscribe-psgi@.service
new file mode 100644
index 00000000..2dc4270f
--- /dev/null
+++ b/examples/unsubscribe-psgi@.service
@@ -0,0 +1,20 @@
+# ==> /etc/systemd/system/unsubscribe-psgi@.service <==
+# The '@' is to allow multiple simultaneous services to start
+# and share the same socket so new code can be cycled in
+# without downtime
+
+[Unit]
+Description = unsubscribe PSGI %i
+Wants = unsubscribe-psgi.socket
+After = unsubscribe-psgi.socket
+
+[Service]
+# any PSGI server ought to work,
+# but public-inbox-httpd supports socket activation like unsubscribe.milter
+ExecStart = /usr/local/bin/public-inbox-httpd -W0 /etc/unsubscribe.psgi
+Sockets = unsubscribe-psgi.socket
+# we need to modify the mlmmj spool
+User = mlmmj
+
+[Install]
+WantedBy = multi-user.target
diff --git a/examples/unsubscribe.milter b/examples/unsubscribe.milter
new file mode 100644
index 00000000..eb1717ba
--- /dev/null
+++ b/examples/unsubscribe.milter
@@ -0,0 +1,137 @@
+#!/usr/bin/perl -w
+# Copyright (C) 2016 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;
+use MIME::Base64 qw(encode_base64url);
+
+my $key_file = shift @ARGV or die "Usage: $0 KEY_FILE\n";
+open my $fh, '<', $key_file or die "failed to open $key_file\n";
+my ($key, $iv);
+if (read($fh, $key, 8) != 8 || read($fh, $iv, 8) != 8 ||
+                        read($fh, my $end, 8) != 0) {
+        die "KEY_FILE must be 16 bytes\n";
+}
+
+# these parameters were chosen to generate shorter parameters
+# to reduce the possibility of copy+paste errors
+my $crypt = Crypt::CBC->new(-key => $key,
+                        -iv => $iv,
+                        -header => 'none',
+                        -cipher => 'Blowfish');
+$fh = $iv = $key = undef;
+
+my %cbs;
+$cbs{connect} = sub {
+        my ($ctx) = @_;
+        eval { $ctx->setpriv({ header => {}, envrcpt => {} }) };
+        warn $@ if $@;
+        SMFIS_CONTINUE;
+};
+
+$cbs{envrcpt} = sub {
+        my ($ctx, $addr) = @_;
+        eval {
+                $addr =~ tr!<>!!d;
+                $ctx->getpriv->{envrcpt}->{$addr} = 1;
+        };
+        warn $@ if $@;
+        SMFIS_CONTINUE;
+};
+
+$cbs{header} = sub {
+        my ($ctx, $k, $v) = @_;
+        eval {
+                my $k_ = lc $k;
+                if ($k_ eq 'list-unsubscribe') {
+                        my $header = $ctx->getpriv->{header} ||= {};
+                        my $ary = $header->{$k_} ||= [];
+
+                        # we create placeholders in case there are
+                        # multiple headers of the same name
+                        my $cur = [];
+                        push @$ary, $cur;
+
+                        # This relies on mlmmj convention:
+                        #        $LIST+unsubscribe@$DOMAIN
+                        if ($v =~ /\A<mailto:([^@]+)\+unsubscribe@([^>]+)>\z/) {
+                                @$cur = ($k, $v, $1, $2);
+
+                        # Mailman convention:
+                        #        $LIST-request@$DOMAIN?subject=unsubscribe
+                        } elsif ($v =~ /\A<mailto:([^@]+)-request@
+                                        ([^\?]+)\?subject=unsubscribe>\z/x) {
+                                # @$cur = ($k, $v, $1, $2);
+                        }
+                }
+        };
+        warn $@ if $@;
+        SMFIS_CONTINUE;
+};
+
+# only whitelist a few users for testing:
+my $whitelist = '/etc/unsubscribe-milter.whitelist';
+my %TEST_WHITELIST = map { $_ => 1 } eval {
+                open my $fh, '<', $whitelist or
+                        die "Failed to open $whitelist: $!";
+                local $/ = "\n";
+                chomp(my @lines = (<$fh>));
+                @lines;
+        };
+die "No whitelist at $whitelist\n" unless scalar keys %TEST_WHITELIST;
+
+$cbs{eom} = sub {
+        my ($ctx) = @_;
+        eval {
+                my $priv = $ctx->getpriv;
+                $ctx->setpriv({ header => {}, envrcpt => {} });
+                my @rcpt = keys %{$priv->{envrcpt}};
+
+                # one recipient, one unique HTTP(S) URL
+                return SMFIS_CONTINUE if @rcpt != 1;
+                return SMFIS_CONTINUE unless $TEST_WHITELIST{$rcpt[0]};
+
+                my $unsub = $priv->{header}->{'list-unsubscribe'} || [];
+                my $n = 0;
+                foreach my $u (@$unsub) {
+                        # Milter indices are 1-based,
+                        # not 0-based like Perl arrays
+                        my $index = ++$n;
+                        my ($k, $v, $list, $domain) = @$u;
+
+                        next unless $k && $v && $list && $domain;
+                        my $u = $crypt->encrypt($rcpt[0]);
+                        $u = encode_base64url($u);
+                        $v .= ",\n <https://$domain/u/$u/$list>";
+
+                        $ctx->chgheader($k, $index, $v);
+                }
+        };
+        warn $@ if $@;
+        SMFIS_CONTINUE;
+};
+
+my $milter = Sendmail::PMilter->new;
+
+# Try to inherit a socket from systemd or similar:
+my $fds = $ENV{LISTEN_FDS};
+if ($fds && (($ENV{LISTEN_PID} || 0) == $$)) {
+        die "$0 can only listen on one FD\n" if $fds != 1;
+        my $start_fd = 3;
+        my $s = IO::Socket->new_from_fd($start_fd, 'r') or
+                die "inherited bad FD from LISTEN_FDS: $!\n";
+        $milter->set_socket($s);
+} else {
+        # fall back to binding a socket:
+        my $sock = 'unix:/var/spool/postfix/unsubscribe/unsubscribe.sock';
+        $milter->set_listen(1024);
+        my $umask = umask 0000;
+        $milter->setconn($sock);
+        umask $umask;
+}
+
+$milter->register('unsubscribe', \%cbs, SMFI_CURR_ACTS);
+$milter->main();
diff --git a/examples/unsubscribe.psgi b/examples/unsubscribe.psgi
new file mode 100644
index 00000000..82e186b1
--- /dev/null
+++ b/examples/unsubscribe.psgi
@@ -0,0 +1,68 @@
+#!/usr/bin/perl -w
+# Copyright (C) 2016 all contributors <meta@public-inbox.org>
+# License: GPL-3.0+ <https://www.gnu.org/licenses/gpl-3.0.txt>
+# This should not require any other PublicInbox code, but may use
+# PublicInbox::Config if ~/.public-inbox/config exists or
+# PI_CONFIG is pointed to an appropriate location
+use strict;
+use Plack::Builder;
+use PublicInbox::Unsubscribe;
+my $app = PublicInbox::Unsubscribe->new(
+        pi_config => eval { # optional, for pointing out archives
+                require PublicInbox::Config;
+                # uses ~/.public-inbox/config by default,
+                # can override with PI_CONFIG or here since
+                # I run this .psgi as the mlmmj user while the
+                # public-inbox-mda code which actually writes to
+                # the archives runs as a different user.
+                PublicInbox::Config->new('/home/pi/.public-inbox/config')
+        },
+        code_url => 'git://80x24.org/public-inbox.git', # change if you fork
+        owner_email => 'BOFH@example.com',
+        confirm => 1,
+
+        # First 8 bytes is for the key, next 8 bytes is for the IV
+        # using Blowfish.  We want as short URLs as possible to avoid
+        # copy+paste errors
+        # umask 077 && dd if=/dev/urandom bs=16 count=1 of=.unsubscribe.key
+        key_file => '/home/mlmmj/.unsubscribe.key',
+
+        # this runs as whatever user has perms to run /usr/bin/mlmmj-unsub
+        # users of other mailing lists.  Returns '' on success.
+        unsubscribe => sub {
+                my ($user_addr, $list_addr) = @_;
+
+                # map list_addr to mlmmj spool, I use:
+                # /home/mlmmj/spool/$LIST here
+                my ($list, $domain) = split('@', $list_addr, 2);
+                my $spool = "/home/mlmmj/spool/$list";
+
+                return "Invalid list: $list" unless -d $spool;
+
+                # -c to send a confirmation email, -s is important
+                # in case a user is click-happy and clicks twice.
+                my @cmd = (qw(/usr/bin/mlmmj-unsub -c -s),
+                                '-L', $spool, '-a', $user_addr);
+
+                # we don't know which version they're subscribed to,
+                # try both non-digest and digest
+                my $normal = system(@cmd);
+                my $digest = system(@cmd, '-d');
+
+                # success if either succeeds:
+                return '' if ($normal == 0 || $digest == 0);
+
+                # missing executable or FS error,
+                # otherwise -s always succeeds, right?
+                return 'Unknown error, contact admin';
+        },
+);
+
+builder {
+        mount '/u' => builder {
+                eval { enable 'Deflater' }; # optional
+                eval { enable 'ReverseProxy' }; # optional
+                enable 'Head';
+                sub { $app->call(@_) };
+        };
+};