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); |
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 | |
20 | my $email = Email::Simple->new($message); |
21 | my $recipient = $email->header('To'); |
8ad89cb2 |
22 | my $local_user = user_for_address($recipient); |
f5baca29 |
23 | my $sender = $email->header('From'); |
24 | my $subject = $email->header('Subject'); |
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 | |
58 | my $sender = $email->header('From'); |
8ad89cb2 |
59 | my $sender_address = bare_address($sender); |
f5baca29 |
60 | my $recipient = $email->header('To'); |
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 |
71 | my $body = $email->body; |
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 |
76 | my $new_message = Email::Simple->create( |
77 | header => [ |
8ad89cb2 |
78 | From => $recipient, |
f5baca29 |
79 | To => $subscriber, |
8ad89cb2 |
80 | Subject => $email->header('Subject'), |
f5baca29 |
81 | ], |
82 | body => $body, |
83 | ); |
84 | # XXX no queuing or job distribution for now beyond what the MTA provides |
85 | # -- apeiron, 2010-03-13 |
86 | sendmail($new_message); |
87 | } |
88 | } |
89 | |
21baaef0 |
90 | # XXX make this actually not suck -- apeiron, 2010-03-13 |
91 | sub reject { |
8ad89cb2 |
92 | my ($recipient, $sender) = @_; |
21baaef0 |
93 | my $email = Email::Simple->create( |
94 | header => [ |
95 | From => $recipient, |
96 | To => $sender, |
97 | Subject => 'Rejected', |
98 | ], |
99 | body => <<BODY, |
100 | Sorry, your message to $recipient has been denied. |
101 | BODY |
102 | ); |
103 | sendmail($email); |
104 | } |
105 | |
106 | sub not_subscribed { |
8ad89cb2 |
107 | my ($list, $recipient, $sender) = @_; |
21baaef0 |
108 | my $email = Email::Simple->create( |
8ad89cb2 |
109 | # XXX need admin address |
21baaef0 |
110 | header => [ |
8ad89cb2 |
111 | From => $recipient, |
21baaef0 |
112 | To => $sender, |
113 | Subject => 'Not subscribed', |
114 | ], |
115 | body => <<BODY, |
8ad89cb2 |
116 | Sorry, you are not subscribed to $list. |
21baaef0 |
117 | BODY |
118 | ); |
119 | sendmail($email); |
120 | } |
121 | |
122 | sub already_subscribed { |
8ad89cb2 |
123 | my ($list, $recipient, $sender) = @_; |
21baaef0 |
124 | my $email = Email::Simple->create( |
125 | header => [ |
8ad89cb2 |
126 | From => $recipient, |
21baaef0 |
127 | To => $sender, |
128 | Subject => 'Already subscribed', |
129 | ], |
130 | body => <<BODY, |
8ad89cb2 |
131 | Sorry, you are already subscribed to $list. |
21baaef0 |
132 | BODY |
133 | ); |
134 | sendmail($email); |
135 | } |
f5baca29 |
136 | |
8ad89cb2 |
137 | sub bare_address { |
138 | my ($full_addr) = @_; |
139 | my ($addr_obj) = Email::Address->parse($full_addr); |
140 | return $addr_obj->address; |
141 | } |
142 | |
143 | sub user_for_address { |
144 | my ($full_addr) = @_; |
145 | my ($addr_obj) = Email::Address->parse($full_addr); |
146 | return $addr_obj->user; |
147 | } |
148 | |
f5baca29 |
149 | 'http://www.shadowcat.co.uk/blog/matt-s-trout/oh-subdispatch-oh-subdispatch/'; |