lib/PublicInbox/Unsubscribe.pm

   1 # Copyright (C) 2016-2018 all contributors <meta@public-inbox.org>
   2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   3 #
   4 # Standalone PSGI app to handle HTTP(s) unsubscribe links generated
   5 # by milters like examples/unsubscribe.milter to mailing lists.
   6 #
   7 # This does not depend on any other modules in the PublicInbox::*
   8 # and ought to be usable with any mailing list software.
   9 package PublicInbox::Unsubscribe;
  10 use strict;
  11 use warnings;
  12 use Crypt::CBC;
  13 use Plack::Util;
  14 use MIME::Base64 qw(decode_base64url);
  15 my $CODE_URL = 'https://public-inbox.org/public-inbox.git';
  16 my @CT_HTML = ('Content-Type', 'text/html; charset=UTF-8');
  17
  18 sub new {
  19         my ($class, %opt) = @_;
  20         my $key_file = $opt{key_file};
  21         defined $key_file or die "`key_file' needed";
  22         open my $fh, '<', $key_file or die
  23                 "failed to open key_file=$key_file: $!\n";
  24         my ($key, $iv);
  25         if (read($fh, $key, 8) != 8 || read($fh, $iv, 8) != 8 ||
  26                                 read($fh, my $end, 8) != 0) {
  27                 die "key_file must be 16 bytes\n";
  28         }
  29
  30         # these parameters were chosen to generate shorter parameters
  31         # to reduce the possibility of copy+paste errors
  32         my $cipher = Crypt::CBC->new(-key => $key,
  33                         -iv => $iv,
  34                         -header => 'none',
  35                         -cipher => 'Blowfish');
  36
  37         my $e = $opt{owner_email} or die "`owner_email' not specified\n";
  38         my $unsubscribe = $opt{unsubscribe} or
  39                 die "`unsubscribe' callback not given\n";
  40
  41         bless {
  42                 pi_config => $opt{pi_config}, # PublicInbox::Config
  43                 owner_email => $opt{owner_email},
  44                 cipher => $cipher,
  45                 unsubscribe => $unsubscribe,
  46                 contact => qq(<a\nhref="mailto:$e">$e</a>),
  47                 code_url => $opt{code_url} || $CODE_URL,
  48                 confirm => $opt{confirm},
  49         }, $class;
  50 }
  51
  52 # entry point for PSGI
  53 sub call {
  54         my ($self, $env) = @_;
  55         my $m = $env->{REQUEST_METHOD};
  56         if ($m eq 'GET' || $m eq 'HEAD') {
  57                 $self->{confirm} ? confirm_prompt($self, $env)
  58                                  : finalize_unsub($self, $env);
  59         } elsif ($m eq 'POST') {
  60                 finalize_unsub($self, $env);
  61         } else {
  62                 r($self, 405,
  63                         Plack::Util::encode_html($m).' method not allowed');
  64         }
  65 }
  66
  67 sub _user_list_addr {
  68         my ($self, $env) = @_;
  69         my ($blank, $u, $list) = split('/', $env->{PATH_INFO});
  70
  71         if (!defined $u || $u eq '') {
  72                 return r($self, 400, 'Bad request',
  73                         'Missing encrypted email address in path component');
  74         }
  75         if (!defined $list && $list eq '') {
  76                 return r($self, 400, 'Bad request',
  77                         'Missing mailing list name in path component');
  78         }
  79         my $user = eval { $self->{cipher}->decrypt(decode_base64url($u)) };
  80         if (!defined $user || index($user, '@') < 1) {
  81                 my $err = quotemeta($@);
  82                 my $errors = $env->{'psgi.errors'};
  83                 $errors->print("error decrypting: $u\n");
  84                 $errors->print("$_\n") for split("\n", $err);
  85                 $u = Plack::Util::encode_html($u);
  86                 return r($self, 400, 'Bad request', "Failed to decrypt: $u");
  87         }
  88
  89         # The URLs are too damn long if we have the encrypted domain
  90         # name in the PATH_INFO
  91         if (index($list, '@') < 0) {
  92                 my $host = (split(':', $env->{HTTP_HOST}))[0];
  93                 $list .= '@'.$host;
  94         }
  95         ($user, $list);
  96 }
  97
  98 sub confirm_prompt { # on GET
  99         my ($self, $env) = @_;
 100         my ($user_addr, $list_addr) = _user_list_addr($self, $env);
 101         return $user_addr if ref $user_addr;
 102
 103         my $xl = Plack::Util::encode_html($list_addr);
 104         my $xu = Plack::Util::encode_html($user_addr);
 105         my @body = (
 106                 "Confirmation required to remove", '',
 107                 "\t$xu", '',
 108                 "from the mailing list at", '',
 109                 "\t$xl", '',
 110                 'You will get one last email once you hit "Confirm" below:',
 111                 qq(</pre><form\nmethod=post\naction="">) .
 112                 qq(<input\ntype=submit\nvalue="Confirm" />) .
 113                 '</form><pre>');
 114
 115         push @body, archive_info($self, $env, $list_addr);
 116
 117         r($self, 200, "Confirm unsubscribe for $xl", @body);
 118 }
 119
 120 sub finalize_unsub { # on POST
 121         my ($self, $env) = @_;
 122         my ($user_addr, $list_addr) = _user_list_addr($self, $env);
 123         return $user_addr if ref $user_addr;
 124
 125         my @archive = archive_info($self, $env, $list_addr);
 126         if (my $err = $self->{unsubscribe}->($user_addr, $list_addr)) {
 127                 return r($self, 500, Plack::Util::encode_html($err), @archive);
 128         }
 129
 130         my $xl = Plack::Util::encode_html($list_addr);
 131         r($self, 200, "Unsubscribed from $xl",
 132                 'You may get one final goodbye message', @archive);
 133 }
 134
 135 sub r {
 136         my ($self, $code, $title, @body) = @_;
 137         [ $code, [ @CT_HTML ], [
 138                 "<html><head><title>$title</title></head><body><pre>".
 139                 join("\n", "<b>$title</b>\n", @body) . '</pre><hr>'.
 140                 "<pre>This page is available under AGPL-3.0+\n" .
 141                 "git clone $self->{code_url}\n" .
 142                 qq(Email $self->{contact} if you have any questions).
 143                 '</pre></body></html>'
 144         ] ];
 145 }
 146
 147 sub archive_info {
 148         my ($self, $env, $list_addr) = @_;
 149         my $archive_url = $self->{archive_urls}->{$list_addr};
 150
 151         unless ($archive_url) {
 152                 if (my $config = $self->{pi_config}) {
 153                         # PublicInbox::Config::lookup
 154                         my $ibx = $config->lookup($list_addr);
 155                         # PublicInbox::Inbox::base_url
 156                         $archive_url = $ibx->base_url if $ibx;
 157                 }
 158         }
 159
 160         # protocol-relative URL:  "//example.com/" => "https://example.com/"
 161         if ($archive_url && $archive_url =~ m!\A//!) {
 162                 $archive_url = "$env->{'psgi.url_scheme'}:$archive_url";
 163         }
 164
 165         # maybe there are other places where we could map
 166         # list_addr => archive_url without ~/.public-inbox/config
 167         if ($archive_url) {
 168                 $archive_url = Plack::Util::encode_html($archive_url);
 169                 ('',
 170                 'HTML and git clone-able archives are available at:',
 171                 qq(<a\nhref="$archive_url">$archive_url</a>))
 172         } else {
 173                 ('',
 174                 'There ought to be archives for this list,',
 175                 'but unfortunately the admin did not configure '.
 176                 __PACKAGE__. ' to show you the URL');
 177         }
 178 }
 179
 180 1;