examples/unsubscribe.psgi

   1 #!/usr/bin/perl -w
   2 # Copyright (C) 2016-2020 all contributors <meta@public-inbox.org>
   3 # License: GPL-3.0+ <https://www.gnu.org/licenses/gpl-3.0.txt>
   4 # This should not require any other PublicInbox code, but may use
   5 # PublicInbox::Config if ~/.public-inbox/config exists or
   6 # PI_CONFIG is pointed to an appropriate location
   7 use strict;
   8 use Plack::Builder;
   9 use PublicInbox::Unsubscribe;
  10 my $app = PublicInbox::Unsubscribe->new(
  11         pi_config => eval { # optional, for pointing out archives
  12                 require PublicInbox::Config;
  13                 # uses ~/.public-inbox/config by default,
  14                 # can override with PI_CONFIG or here since
  15                 # I run this .psgi as the mlmmj user while the
  16                 # public-inbox-mda code which actually writes to
  17                 # the archives runs as a different user.
  18                 PublicInbox::Config->new('/home/pi/.public-inbox/config')
  19         },
  20         # change if you fork
  21         code_url => 'https://public-inbox.org/public-inbox.git',
  22         owner_email => 'BOFH@example.com',
  23         confirm => 0,
  24
  25         # First 8 bytes is for the key, next 8 bytes is for the IV
  26         # using Blowfish.  We want as short URLs as possible to avoid
  27         # copy+paste errors
  28         # umask 077 && dd if=/dev/urandom bs=16 count=1 of=.unsubscribe.key
  29         key_file => '/home/mlmmj/.unsubscribe.key',
  30
  31         # this runs as whatever user has perms to run /usr/bin/mlmmj-unsub
  32         # users of other mailing lists.  Returns '' on success.
  33         unsubscribe => sub {
  34                 my ($user_addr, $list_addr) = @_;
  35
  36                 # map list_addr to mlmmj spool, I use:
  37                 # /home/mlmmj/spool/$LIST here
  38                 my ($list, $domain) = split('@', $list_addr, 2);
  39                 my $spool = "/home/mlmmj/spool/$list";
  40
  41                 return "Invalid list: $list" unless -d $spool;
  42
  43                 # -c to send a confirmation email, -s is important
  44                 # in case a user is click-happy and clicks twice.
  45                 my @cmd = (qw(/usr/bin/mlmmj-unsub -c -s),
  46                                 '-L', $spool, '-a', $user_addr);
  47
  48                 # we don't know which version they're subscribed to,
  49                 # try both non-digest and digest
  50                 my $normal = system(@cmd);
  51                 my $digest = system(@cmd, '-d');
  52
  53                 # success if either succeeds:
  54                 return '' if ($normal == 0 || $digest == 0);
  55
  56                 # missing executable or FS error,
  57                 # otherwise -s always succeeds, right?
  58                 return 'Unknown error, contact admin';
  59         },
  60 );
  61
  62 builder {
  63         mount '/u' => builder {
  64                 eval { enable 'ReverseProxy' }; # optional
  65                 enable 'Head';
  66                 sub { $app->call(@_) };
  67         };
  68 };