Fixes from actual testing
Chris Nehren [Sun, 20 Jun 2010 06:54:45 +0000 (02:54 -0400)]
lib/Promulger/Dispatch.pm
lib/Promulger/List.pm

index 36fc651..55b11cf 100644 (file)
@@ -2,6 +2,7 @@ package Promulger::Dispatch;
 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 
@@ -12,62 +13,70 @@ use Promulger::Config;
 
 # 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,
     );
@@ -79,7 +88,7 @@ sub post_message {
 
 # 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,
@@ -94,35 +103,46 @@ BODY
 }
 
 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/';
index eda923c..5238e99 100644 (file)
@@ -48,22 +48,24 @@ sub resolve {
 
 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 {
@@ -102,7 +104,7 @@ sub delete {
     $_ !~ /^$list_aliases[1]:/
   } @aliases;
 
-  unlink find_path_for($self->listname);
+  unlink find_path_for($self->listname)->stringify;
 }
 
 sub find_path_for {