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