Commit | Line | Data |
f5baca29 |
1 | package Promulger::Dispatch; |
9e4ca637 |
2 | use Moo; |
3 | use Method::Signatures::Simple; |
4 | use autodie ':all'; |
018a0a65 |
5 | use Scalar::Util 'blessed'; |
f5baca29 |
6 | |
8ad89cb2 |
7 | use Email::Address; |
b179831b |
8 | use Email::MIME; |
9e4ca637 |
9 | use Email::Sender::Simple (); |
9f8395b9 |
10 | # XXX not yet -- apeiron, 2010-06-25 |
11 | #use Mail::Verp; |
f5baca29 |
12 | |
21baaef0 |
13 | use Promulger::Config; |
14 | |
9e4ca637 |
15 | has transport => ( |
16 | is => 'rw', |
17 | isa => sub { |
18 | my $proto = $_[0]; |
19 | blessed $proto and |
20 | $proto->can('does') and |
21 | $proto->does('Email::Sender::Transport') |
22 | or die "transport must do Email::Sender::Transport role"; |
23 | }, |
24 | default => sub { |
018a0a65 |
25 | my $config = Promulger::Config->config; |
26 | my $class; |
27 | if($class = $config->{mailer}) { |
28 | if($class !~ /::/) { |
29 | $class = "Email::Sender::Transport::${class}"; |
30 | } |
31 | } else { |
32 | $class = 'Email::Sender::Transport::Sendmail'; |
33 | } |
34 | Class::MOP::load_class($class); |
35 | $class->new; |
9e4ca637 |
36 | }, |
37 | ); |
38 | |
21baaef0 |
39 | # XXX no bounce parsing yet -- apeiron, 2010-03-13 |
9e4ca637 |
40 | method dispatch ($message) { |
21baaef0 |
41 | my $config = Promulger::Config->config; |
f5baca29 |
42 | |
b179831b |
43 | my $email = Email::MIME->new($message); |
f7a55eac |
44 | my $recipient = $email->header('To'); |
9e4ca637 |
45 | my $local_user = $self->user_for_address($recipient); |
f7a55eac |
46 | my $sender = $email->header('From'); |
47 | my $subject = $email->header('Subject'); |
f5baca29 |
48 | |
8ad89cb2 |
49 | my $list = Promulger::List->resolve($local_user); |
f5baca29 |
50 | unless($list) { |
9e4ca637 |
51 | $self->reject($recipient, $sender); |
8ad89cb2 |
52 | return; |
f5baca29 |
53 | } |
54 | |
8ad89cb2 |
55 | if($local_user =~ /-request$/) { |
9e4ca637 |
56 | $self->handle_request($list, $sender, $local_user, $subject, $config); |
8ad89cb2 |
57 | return; |
f5baca29 |
58 | } |
59 | |
60 | # they don't have a request for us, so they want to post a message |
9e4ca637 |
61 | $self->post_message($list, $email, $config); |
8ad89cb2 |
62 | return; |
f5baca29 |
63 | } |
64 | |
9e4ca637 |
65 | method handle_request ($list, $sender, $recipient, $subject) { |
66 | my $sender_address = $self->bare_address($sender); |
8ad89cb2 |
67 | if($subject =~ /^\s*subscribe/i) { |
68 | $list->subscribe($sender_address) |
9e4ca637 |
69 | or $self->already_subscribed($list, $recipient, $sender_address); |
8ad89cb2 |
70 | } elsif($subject =~ /^\s*unsubscribe/i) { |
71 | $list->unsubscribe($sender_address) |
9e4ca637 |
72 | or $self->not_subscribed($list, $recipient, $sender_address); |
f5baca29 |
73 | } |
74 | } |
75 | |
9e4ca637 |
76 | method post_message ($list, $email, $config) { |
f7a55eac |
77 | my $sender = $email->header('From'); |
9e4ca637 |
78 | my $sender_address = $self->bare_address($sender); |
f7a55eac |
79 | my $recipient = $email->header('To'); |
f5baca29 |
80 | |
8ad89cb2 |
81 | unless($list->accept_posts_from($sender_address) && $list->active) { |
9e4ca637 |
82 | $self->reject($recipient, $sender); |
8ad89cb2 |
83 | return; |
84 | } |
f5baca29 |
85 | |
f5baca29 |
86 | # XXX no MIME or other fancy handling for now -- apeiron, 2010-03-13 |
b179831b |
87 | my $body = $email->body_str; |
8ad89cb2 |
88 | for my $subscriber (keys %{$list->subscribers}) { |
f7a55eac |
89 | # my $verped_from = Mail::Verp->encode($recipient, $subscriber); |
90 | |
f5baca29 |
91 | # XXX we let the MTA create the message-id for us for now -- apeiron, |
92 | # 2010-03-13 |
b179831b |
93 | my $new_message = Email::MIME->create( |
f5baca29 |
94 | header => [ |
e9b4d3bc |
95 | From => $sender_address, |
96 | To => $subscriber, |
f7a55eac |
97 | Subject => $email->header('Subject'), |
e9b4d3bc |
98 | 'Reply-to' => $recipient, |
f5baca29 |
99 | ], |
100 | body => $body, |
101 | ); |
102 | # XXX no queuing or job distribution for now beyond what the MTA provides |
103 | # -- apeiron, 2010-03-13 |
9e4ca637 |
104 | $self->send_message($new_message); |
f5baca29 |
105 | } |
106 | } |
107 | |
9e4ca637 |
108 | method send_message ($message) { |
9e4ca637 |
109 | Email::Sender::Simple::sendmail( |
f7a55eac |
110 | $message, |
111 | { |
9e4ca637 |
112 | transport => $self->transport, |
f7a55eac |
113 | } |
114 | ); |
115 | } |
116 | |
21baaef0 |
117 | # XXX make this actually not suck -- apeiron, 2010-03-13 |
9e4ca637 |
118 | method reject ($recipient, $sender) { |
b179831b |
119 | my $email = Email::MIME->create( |
21baaef0 |
120 | header => [ |
121 | From => $recipient, |
122 | To => $sender, |
123 | Subject => 'Rejected', |
124 | ], |
125 | body => <<BODY, |
126 | Sorry, your message to $recipient has been denied. |
127 | BODY |
128 | ); |
9e4ca637 |
129 | $self->send_message($email); |
21baaef0 |
130 | } |
131 | |
9e4ca637 |
132 | method not_subscribed ($list, $recipient, $sender) { |
b179831b |
133 | my $email = Email::MIME->create( |
8ad89cb2 |
134 | # XXX need admin address |
21baaef0 |
135 | header => [ |
8ad89cb2 |
136 | From => $recipient, |
21baaef0 |
137 | To => $sender, |
138 | Subject => 'Not subscribed', |
139 | ], |
140 | body => <<BODY, |
8ad89cb2 |
141 | Sorry, you are not subscribed to $list. |
21baaef0 |
142 | BODY |
143 | ); |
9e4ca637 |
144 | $self->send_message($email); |
21baaef0 |
145 | } |
146 | |
9e4ca637 |
147 | method already_subscribed ($list, $recipient, $sender) { |
b179831b |
148 | my $email = Email::MIME->create( |
21baaef0 |
149 | header => [ |
8ad89cb2 |
150 | From => $recipient, |
21baaef0 |
151 | To => $sender, |
152 | Subject => 'Already subscribed', |
153 | ], |
154 | body => <<BODY, |
8ad89cb2 |
155 | Sorry, you are already subscribed to $list. |
21baaef0 |
156 | BODY |
157 | ); |
9e4ca637 |
158 | $self->send_message($email); |
21baaef0 |
159 | } |
f5baca29 |
160 | |
9e4ca637 |
161 | method bare_address ($full_addr) { |
8ad89cb2 |
162 | my ($addr_obj) = Email::Address->parse($full_addr); |
163 | return $addr_obj->address; |
164 | } |
165 | |
9e4ca637 |
166 | method user_for_address ($full_addr) { |
8ad89cb2 |
167 | my ($addr_obj) = Email::Address->parse($full_addr); |
168 | return $addr_obj->user; |
169 | } |
170 | |
f5baca29 |
171 | 'http://www.shadowcat.co.uk/blog/matt-s-trout/oh-subdispatch-oh-subdispatch/'; |