lib/Promulger/Dispatch.pm

   1 package Promulger::Dispatch;
   2 use strict;
   3 use warnings;
   4
   5 use Email::Simple;
   6 # XXX allow the user to specify their own Email::Sender::Transport -- apeiron,
   7 # 2010-03-13
   8 use Email::Sender::Simple qw(sendmail);
   9 use Mail::Verp;
  10
  11 use Promulger::Config;
  12
  13 # XXX no bounce parsing yet -- apeiron, 2010-03-13
  14 sub dispatch {
  15   my($message) = @_;
  16   my $config = Promulger::Config->config;
  17
  18   my $email = Email::Simple->new($message);
  19   my $recipient = $email->header('To');
  20   my $sender = $email->header('From');
  21   my $subject = $email->header('Subject');
  22
  23   my $list = Promulger::List->resolve($recipient);
  24   unless($list) {
  25     reject($recipient, $sender);
  26   }
  27
  28   if($recipient =~ /-request$/) {
  29     handle_request($list, $sender, $recipient, $subject, $config);
  30   }
  31
  32   # they don't have a request for us, so they want to post a message
  33   post_message($list, $email, $config);
  34 }
  35
  36 sub handle_request {
  37   my ($list, $sender, $recipient, $subject) = @_;
  38
  39   if($subject =~ /^subscribe/i) {
  40     $list->subscribe($sender)
  41       or already_subscribed($list, $sender);
  42   } elsif($subject =~ /^unsubscribe/i) {
  43     $list->unsubscribe($sender)
  44       or not_subscribed($list, $sender);
  45   }
  46 }
  47
  48 sub post_message {
  49   my($list, $email, $config) = @_;
  50
  51   my $sender = $email->header('From');
  52   my $recipient = $email->header('To');
  53
  54   reject($recipient, $sender) unless $list->accept_posts_from($sender);
  55   reject($recipient, $sender) unless $list->active;
  56
  57   # they're allowed to post (subscribed or not), the list is active. let's do
  58   # this thing.
  59
  60   # XXX no MIME or other fancy handling for now -- apeiron, 2010-03-13
  61   my $body = $email->body;
  62   for my $subscriber ($list->subscribers) {
  63     my $verped_from = Mail::Verp->encode($list->address, $subscriber);
  64     # XXX we let the MTA create the message-id for us for now -- apeiron,
  65     # 2010-03-13
  66     my $new_message = Email::Simple->create(
  67       header => [
  68         From => $verped_from,
  69         To   => $subscriber,
  70         Subject => $email->subject,
  71       ],
  72       body => $body,
  73     );
  74     # XXX no queuing or job distribution for now beyond what the MTA provides
  75     # -- apeiron, 2010-03-13
  76     sendmail($new_message);
  77   }
  78 }
  79
  80 # XXX make this actually not suck -- apeiron, 2010-03-13
  81 sub reject {
  82   my($recipient, $sender) = @_;
  83   my $email = Email::Simple->create(
  84     header => [
  85       From => $recipient,
  86       To   => $sender,
  87       Subject => 'Rejected',
  88     ],
  89     body => <<BODY,
  90 Sorry, your message to $recipient has been denied.
  91 BODY
  92   );
  93   sendmail($email);
  94 }
  95
  96 sub not_subscribed {
  97   my($list, $sender) = @_;
  98   my $list_address = $list->address;
  99   my $email = Email::Simple->create(
 100     header => [
 101       From => $list->admin_address,
 102       To   => $sender,
 103       Subject => 'Not subscribed',
 104     ],
 105     body => <<BODY,
 106 Sorry, you are not subscribed to $list_address;
 107 BODY
 108   );
 109   sendmail($email);
 110 }
 111
 112 sub already_subscribed {
 113   my($list, $sender) = @_;
 114   my $list_address = $list->address;
 115   my $email = Email::Simple->create(
 116     header => [
 117       From => $list->admin_address,
 118       To   => $sender,
 119       Subject => 'Already subscribed',
 120     ],
 121     body => <<BODY,
 122 Sorry, you are already subscribed to $list_address;
 123 BODY
 124   );
 125   sendmail($email);
 126 }
 127
 128 'http://www.shadowcat.co.uk/blog/matt-s-trout/oh-subdispatch-oh-subdispatch/';