lib/Promulger/Dispatch.pm

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