use strict;
use warnings;
+use Email::Address;
use Email::Simple;
# XXX allow the user to specify their own Email::Sender::Transport -- apeiron,
# 2010-03-13
# XXX no bounce parsing yet -- apeiron, 2010-03-13
sub dispatch {
- my($message) = @_;
+ my ($message) = @_;
my $config = Promulger::Config->config;
my $email = Email::Simple->new($message);
my $recipient = $email->header('To');
+ my $local_user = user_for_address($recipient);
my $sender = $email->header('From');
my $subject = $email->header('Subject');
- my $list = Promulger::List->resolve($recipient);
+ my $list = Promulger::List->resolve($local_user);
unless($list) {
reject($recipient, $sender);
+ return;
}
- if($recipient =~ /-request$/) {
- handle_request($list, $sender, $recipient, $subject, $config);
+ if($local_user =~ /-request$/) {
+ handle_request($list, $sender, $local_user, $subject, $config);
+ return;
}
# they don't have a request for us, so they want to post a message
post_message($list, $email, $config);
+ return;
}
sub handle_request {
my ($list, $sender, $recipient, $subject) = @_;
- if($subject =~ /^subscribe/i) {
- $list->subscribe($sender)
- or already_subscribed($list, $sender);
- } elsif($subject =~ /^unsubscribe/i) {
- $list->unsubscribe($sender)
- or not_subscribed($list, $sender);
+ my $sender_address = bare_address($sender);
+ if($subject =~ /^\s*subscribe/i) {
+ $list->subscribe($sender_address)
+ or already_subscribed($list, $recipient, $sender_address);
+ } elsif($subject =~ /^\s*unsubscribe/i) {
+ $list->unsubscribe($sender_address)
+ or not_subscribed($list, $recipient, $sender_address);
}
}
sub post_message {
- my($list, $email, $config) = @_;
+ my ($list, $email, $config) = @_;
my $sender = $email->header('From');
+ my $sender_address = bare_address($sender);
my $recipient = $email->header('To');
- reject($recipient, $sender) unless $list->accept_posts_from($sender);
- reject($recipient, $sender) unless $list->active;
+ unless($list->accept_posts_from($sender_address) && $list->active) {
+ reject($recipient, $sender);
+ return;
+ }
# they're allowed to post (subscribed or not), the list is active. let's do
# this thing.
# XXX no MIME or other fancy handling for now -- apeiron, 2010-03-13
my $body = $email->body;
- for my $subscriber ($list->subscribers) {
- my $verped_from = Mail::Verp->encode($list->address, $subscriber);
+ for my $subscriber (keys %{$list->subscribers}) {
+ #my $verped_from = Mail::Verp->encode($recipient, $subscriber);
# XXX we let the MTA create the message-id for us for now -- apeiron,
# 2010-03-13
my $new_message = Email::Simple->create(
header => [
- From => $verped_from,
+ From => $recipient,
To => $subscriber,
- Subject => $email->subject,
+ Subject => $email->header('Subject'),
],
body => $body,
);
# XXX make this actually not suck -- apeiron, 2010-03-13
sub reject {
- my($recipient, $sender) = @_;
+ my ($recipient, $sender) = @_;
my $email = Email::Simple->create(
header => [
From => $recipient,
}
sub not_subscribed {
- my($list, $sender) = @_;
- my $list_address = $list->address;
+ my ($list, $recipient, $sender) = @_;
my $email = Email::Simple->create(
+ # XXX need admin address
header => [
- From => $list->admin_address,
+ From => $recipient,
To => $sender,
Subject => 'Not subscribed',
],
body => <<BODY,
-Sorry, you are not subscribed to $list_address;
+Sorry, you are not subscribed to $list.
BODY
);
sendmail($email);
}
sub already_subscribed {
- my($list, $sender) = @_;
- my $list_address = $list->address;
+ my ($list, $recipient, $sender) = @_;
my $email = Email::Simple->create(
header => [
- From => $list->admin_address,
+ From => $recipient,
To => $sender,
Subject => 'Already subscribed',
],
body => <<BODY,
-Sorry, you are already subscribed to $list_address;
+Sorry, you are already subscribed to $list.
BODY
);
sendmail($email);
}
+sub bare_address {
+ my ($full_addr) = @_;
+ my ($addr_obj) = Email::Address->parse($full_addr);
+ return $addr_obj->address;
+}
+
+sub user_for_address {
+ my ($full_addr) = @_;
+ my ($addr_obj) = Email::Address->parse($full_addr);
+ return $addr_obj->user;
+}
+
'http://www.shadowcat.co.uk/blog/matt-s-trout/oh-subdispatch-oh-subdispatch/';
sub subscribe {
my ($self, $new) = @_;
- return if $self->subscribers->at($new);
- $self->subscribers->put($new, 1);
- $self->store(find_path_for($self->name));
+ return if $self->subscribers->{$new};
+ $self->subscribers->{$new} = 1;
+ $self->store(find_path_for($self->listname)->stringify);
+ return 1;
}
sub unsubscribe {
my ($self, $ex) = @_;
- return unless $self->subscribers->at($ex);
- $self->subscribers->delete($ex);
- $self->store(find_path_for($self->name));
+ return unless exists $self->subscribers->{$ex};
+ delete $self->subscribers->{$ex};
+ $self->store(find_path_for($self->listname)->stringify);
+ return 1;
}
# XXX implement ACLs and other shinies -- apeiron, 2010-03-13
sub accept_posts_from {
my ($self, $sender) = @_;
- return grep { $sender eq $_ } @{$self->subscribers};
+ return grep { $sender eq $_ } keys %{$self->subscribers};
}
sub setup {
$_ !~ /^$list_aliases[1]:/
} @aliases;
- unlink find_path_for($self->listname);
+ unlink find_path_for($self->listname)->stringify;
}
sub find_path_for {