Commit | Line | Data |
f5baca29 |
1 | package Promulger::Dispatch; |
2 | use strict; |
3 | use warnings; |
4 | |
8ad89cb2 |
5 | use Email::Address; |
b179831b |
6 | use Email::MIME; |
f5baca29 |
7 | # XXX allow the user to specify their own Email::Sender::Transport -- apeiron, |
8 | # 2010-03-13 |
9 | use Email::Sender::Simple qw(sendmail); |
9f8395b9 |
10 | # XXX not yet -- apeiron, 2010-06-25 |
11 | #use Mail::Verp; |
f5baca29 |
12 | |
21baaef0 |
13 | use Promulger::Config; |
14 | |
15 | # XXX no bounce parsing yet -- apeiron, 2010-03-13 |
f5baca29 |
16 | sub dispatch { |
8ad89cb2 |
17 | my ($message) = @_; |
21baaef0 |
18 | my $config = Promulger::Config->config; |
f5baca29 |
19 | |
b179831b |
20 | my $email = Email::MIME->new($message); |
21 | my $recipient = $email->header_str('To'); |
8ad89cb2 |
22 | my $local_user = user_for_address($recipient); |
b179831b |
23 | my $sender = $email->header_str('From'); |
24 | my $subject = $email->header_str('Subject'); |
f5baca29 |
25 | |
8ad89cb2 |
26 | my $list = Promulger::List->resolve($local_user); |
f5baca29 |
27 | unless($list) { |
28 | reject($recipient, $sender); |
8ad89cb2 |
29 | return; |
f5baca29 |
30 | } |
31 | |
8ad89cb2 |
32 | if($local_user =~ /-request$/) { |
33 | handle_request($list, $sender, $local_user, $subject, $config); |
34 | return; |
f5baca29 |
35 | } |
36 | |
37 | # they don't have a request for us, so they want to post a message |
38 | post_message($list, $email, $config); |
8ad89cb2 |
39 | return; |
f5baca29 |
40 | } |
41 | |
42 | sub handle_request { |
21baaef0 |
43 | my ($list, $sender, $recipient, $subject) = @_; |
f5baca29 |
44 | |
8ad89cb2 |
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); |
f5baca29 |
52 | } |
53 | } |
54 | |
55 | sub post_message { |
8ad89cb2 |
56 | my ($list, $email, $config) = @_; |
f5baca29 |
57 | |
b179831b |
58 | my $sender = $email->header_str('From'); |
8ad89cb2 |
59 | my $sender_address = bare_address($sender); |
b179831b |
60 | my $recipient = $email->header_str('To'); |
f5baca29 |
61 | |
8ad89cb2 |
62 | unless($list->accept_posts_from($sender_address) && $list->active) { |
63 | reject($recipient, $sender); |
64 | return; |
65 | } |
f5baca29 |
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 |
b179831b |
71 | my $body = $email->body_str; |
8ad89cb2 |
72 | for my $subscriber (keys %{$list->subscribers}) { |
73 | #my $verped_from = Mail::Verp->encode($recipient, $subscriber); |
f5baca29 |
74 | # XXX we let the MTA create the message-id for us for now -- apeiron, |
75 | # 2010-03-13 |
b179831b |
76 | my $new_message = Email::MIME->create( |
f5baca29 |
77 | header => [ |
e9b4d3bc |
78 | From => $sender_address, |
79 | To => $subscriber, |
b179831b |
80 | Subject => $email->header_str('Subject'), |
e9b4d3bc |
81 | 'Reply-to' => $recipient, |
f5baca29 |
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 | |
21baaef0 |
91 | # XXX make this actually not suck -- apeiron, 2010-03-13 |
92 | sub reject { |
8ad89cb2 |
93 | my ($recipient, $sender) = @_; |
b179831b |
94 | my $email = Email::MIME->create( |
21baaef0 |
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 { |
8ad89cb2 |
108 | my ($list, $recipient, $sender) = @_; |
b179831b |
109 | my $email = Email::MIME->create( |
8ad89cb2 |
110 | # XXX need admin address |
21baaef0 |
111 | header => [ |
8ad89cb2 |
112 | From => $recipient, |
21baaef0 |
113 | To => $sender, |
114 | Subject => 'Not subscribed', |
115 | ], |
116 | body => <<BODY, |
8ad89cb2 |
117 | Sorry, you are not subscribed to $list. |
21baaef0 |
118 | BODY |
119 | ); |
120 | sendmail($email); |
121 | } |
122 | |
123 | sub already_subscribed { |
8ad89cb2 |
124 | my ($list, $recipient, $sender) = @_; |
b179831b |
125 | my $email = Email::MIME->create( |
21baaef0 |
126 | header => [ |
8ad89cb2 |
127 | From => $recipient, |
21baaef0 |
128 | To => $sender, |
129 | Subject => 'Already subscribed', |
130 | ], |
131 | body => <<BODY, |
8ad89cb2 |
132 | Sorry, you are already subscribed to $list. |
21baaef0 |
133 | BODY |
134 | ); |
135 | sendmail($email); |
136 | } |
f5baca29 |
137 | |
8ad89cb2 |
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 | |
f5baca29 |
150 | 'http://www.shadowcat.co.uk/blog/matt-s-trout/oh-subdispatch-oh-subdispatch/'; |