1 # Copyright (C) 2016-2020 all contributors <meta@public-inbox.org>
2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
4 # Standalone PSGI app to handle HTTP(s) unsubscribe links generated
5 # by milters like examples/unsubscribe.milter to mailing lists.
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;
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');
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";
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";
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,
35 -cipher => 'Blowfish');
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";
42 pi_config => $opt{pi_config}, # PublicInbox::Config
43 owner_email => $opt{owner_email},
45 unsubscribe => $unsubscribe,
46 contact => qq(<a\nhref="mailto:$e">$e</a>),
47 code_url => $opt{code_url} || $CODE_URL,
48 confirm => $opt{confirm},
52 # entry point for PSGI
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);
63 Plack::Util::encode_html($m).' method not allowed');
68 my ($self, $env) = @_;
69 my ($blank, $u, $list) = split('/', $env->{PATH_INFO});
71 if (!defined $u || $u eq '') {
72 return r($self, 400, 'Bad request',
73 'Missing encrypted email address in path component');
75 if (!defined $list && $list eq '') {
76 return r($self, 400, 'Bad request',
77 'Missing mailing list name in path component');
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");
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];
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;
103 my $xl = Plack::Util::encode_html($list_addr);
104 my $xu = Plack::Util::encode_html($user_addr);
106 "Confirmation required to remove", '',
108 "from the mailing list at", '',
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" />) .
115 push @body, archive_info($self, $env, $list_addr);
117 r($self, 200, "Confirm unsubscribe for $xl", @body);
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;
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);
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);
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>'
148 my ($self, $env, $list_addr) = @_;
149 my $archive_url = $self->{archive_urls}->{$list_addr};
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;
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";
165 # maybe there are other places where we could map
166 # list_addr => archive_url without ~/.public-inbox/config
168 $archive_url = Plack::Util::encode_html($archive_url);
170 'HTML and git clone-able archives are available at:',
171 qq(<a\nhref="$archive_url">$archive_url</a>))
174 'There ought to be archives for this list,',
175 'but unfortunately the admin did not configure '.
176 __PACKAGE__. ' to show you the URL');