]>
Commit | Line | Data |
---|---|---|
14726412 | 1 | package PMG::SMTP; |
73238bb3 DM |
2 | |
3 | use strict; | |
14726412 | 4 | use warnings; |
73238bb3 | 5 | use IO::Socket; |
00eaaf69 | 6 | use Encode; |
cebfe036 | 7 | use MIME::Entity; |
73238bb3 | 8 | |
14726412 DM |
9 | use PVE::SafeSyslog; |
10 | ||
11 | use PMG::MailQueue; | |
cebfe036 | 12 | use PMG::Utils; |
14726412 | 13 | |
73238bb3 DM |
14 | sub new { |
15 | my($this, $sock) = @_; | |
14726412 | 16 | |
73238bb3 DM |
17 | my $class = ref($this) || $this; |
18 | ||
9ef3f143 | 19 | die("undefined socket: ERROR") if !defined($sock); |
73238bb3 DM |
20 | |
21 | my $self = {}; | |
22 | $self->{sock} = $sock; | |
23 | $self->{lmtp} = undef; | |
24 | bless($self, $class); | |
25 | ||
26 | $self->reset(); | |
27 | ||
28 | $self->reply ("220 Proxmox SMTP Ready."); | |
29 | return $self; | |
30 | } | |
31 | ||
32 | sub reset { | |
33 | my $self = shift; | |
34 | ||
35 | $self->{from} = undef; | |
36 | $self->{to} = []; | |
37 | $self->{queue} = undef; | |
4a00e01d | 38 | delete $self->{smtputf8}; |
73238bb3 DM |
39 | delete $self->{xforward}; |
40 | delete $self->{status}; | |
ad1c6bce | 41 | delete $self->{param}; |
73238bb3 DM |
42 | } |
43 | ||
44 | sub abort { | |
45 | shift->{sock}->close(); | |
46 | } | |
47 | ||
48 | sub reply { | |
49 | print {shift->{sock}} @_, "\r\n";; | |
50 | ||
51 | } | |
52 | ||
53 | sub loop { | |
54 | my ($self, $func, $data, $maxcount) = @_; | |
55 | ||
56 | my($cmd, $args); | |
73238bb3 | 57 | |
14726412 | 58 | my $sock = $self->{sock}; |
73238bb3 DM |
59 | |
60 | my $count = 0; | |
61 | ||
62 | while(<$sock>) { | |
63 | chomp; | |
64 | s/^\s+//; | |
65 | s/\s+$//; | |
66 | ||
67 | if (!length ($_)) { | |
68 | $self->reply ("500 5.5.1 Error: bad syntax"); | |
69 | next; | |
70 | } | |
71 | ($cmd, $args) = split(/\s+/, $_, 2); | |
72 | $cmd = lc ($cmd); | |
73 | ||
74 | if ($cmd eq 'helo' || $cmd eq 'ehlo' || $cmd eq 'lhlo') { | |
75 | $self->reset(); | |
76 | ||
73238bb3 DM |
77 | $self->reply ("250-PIPELINING"); |
78 | $self->reply ("250-ENHANCEDSTATUSCODES"); | |
79 | $self->reply ("250-8BITMIME"); | |
00eaaf69 | 80 | $self->reply ("250-SMTPUTF8"); |
ad1c6bce | 81 | $self->reply ("250-DSN"); |
73238bb3 DM |
82 | $self->reply ("250-XFORWARD NAME ADDR PROTO HELO"); |
83 | $self->reply ("250 OK."); | |
84 | $self->{lmtp} = 1 if ($cmd eq 'lhlo'); | |
85 | next; | |
86 | } elsif ($cmd eq 'xforward') { | |
87 | my @tmp = split (/\s+/, $args); | |
88 | foreach my $attr (@tmp) { | |
89 | my ($n, $v) = ($attr =~ /^(.*?)=(.*)$/); | |
90 | $self->{xforward}->{lc($n)} = $v; | |
91 | } | |
92 | $self->reply ("250 2.5.0 OK"); | |
93 | next; | |
94 | } elsif ($cmd eq 'noop') { | |
95 | $self->reply ("250 2.5.0 OK"); | |
96 | next; | |
97 | } elsif ($cmd eq 'quit') { | |
98 | $self->reply ("221 2.2.0 OK"); | |
99 | last; | |
100 | } elsif ($cmd eq 'rset') { | |
101 | $self->reset(); | |
102 | $self->reply ("250 2.5.0 OK"); | |
103 | next; | |
104 | } elsif ($cmd eq 'mail') { | |
89b8996d | 105 | if ($args =~ m/^from:\s*<([^\s\>]*?)>( .*)?$/i) { |
73238bb3 | 106 | delete $self->{to}; |
89b8996d | 107 | my ($from, $opts) = ($1, $2 // ''); |
ad1c6bce SI |
108 | |
109 | for my $opt (split(' ', $opts)) { | |
110 | if ($opt =~ /(ret|envid)=([^ =]+)/i ) { | |
111 | $self->{param}->{mail}->{$1} = $2; | |
112 | } elsif ($opt =~ m/smtputf8/i) { | |
113 | $self->{smtputf8} = 1; | |
a56a4b54 | 114 | $self->{param}->{mail}->{smtputf8} = 1; |
ad1c6bce SI |
115 | $from = decode('UTF-8', $from); |
116 | } else { | |
117 | #ignore everything else | |
118 | } | |
4a00e01d | 119 | } |
00eaaf69 | 120 | $self->{from} = $from; |
73238bb3 DM |
121 | $self->reply ('250 2.5.0 OK'); |
122 | next; | |
123 | } else { | |
124 | $self->reply ("501 5.5.2 Syntax: MAIL FROM: <address>"); | |
125 | next; | |
126 | } | |
127 | } elsif ($cmd eq 'rcpt') { | |
89b8996d | 128 | if ($args =~ m/^to:\s*<([^\s\>]+?)>( .*)?$/i) { |
4a00e01d | 129 | my $to = $self->{smtputf8} ? decode('UTF-8', $1) : $1; |
ad1c6bce | 130 | my $opts = $2 // ''; |
4a00e01d | 131 | push @{$self->{to}} , $to; |
ad1c6bce SI |
132 | for my $opt (split(' ', $opts)) { |
133 | if ($opt =~ /(notify|orcpt)=([^ =]+)/i ) { | |
134 | $self->{param}->{rcpt}->{$to}->{$1} = $2; | |
135 | } else { | |
136 | #ignore everything else | |
137 | } | |
138 | } | |
73238bb3 DM |
139 | $self->reply ('250 2.5.0 OK'); |
140 | next; | |
141 | } else { | |
f6c789ba | 142 | $self->reply ("501 5.5.2 Syntax: RCPT TO: <address>"); |
73238bb3 DM |
143 | next; |
144 | } | |
145 | } elsif ($cmd eq 'data') { | |
146 | if ($self->save_data ()) { | |
147 | eval { &$func ($data, $self); }; | |
9d04575a | 148 | if (my $err = $@) { |
73238bb3 | 149 | $data->{errors} = 1; |
9d04575a | 150 | syslog ('err', $err); |
73238bb3 DM |
151 | } |
152 | ||
88a51503 SI |
153 | my $cfg = $data->{pmg_cfg}; |
154 | ||
73238bb3 DM |
155 | if ($self->{lmtp}) { |
156 | foreach $a (@{$self->{to}}) { | |
157 | if ($self->{queue}->{status}->{$a} eq 'delivered') { | |
158 | $self->reply ("250 2.5.0 OK ($self->{queue}->{logid})"); | |
159 | } elsif ($self->{queue}->{status}->{$a} eq 'blocked') { | |
88a51503 SI |
160 | if ($cfg->get('mail', 'ndr_on_block')) { |
161 | $self->reply ("554 5.7.1 Rejected for policy reasons ($self->{queue}->{logid})"); | |
162 | } else { | |
163 | $self->reply ("250 2.7.0 BLOCKED ($self->{queue}->{logid})"); | |
164 | } | |
73238bb3 DM |
165 | } elsif ($self->{queue}->{status}->{$a} eq 'error') { |
166 | my $code = $self->{queue}->{status_code}->{$a}; | |
167 | my $resp = substr($code, 0, 1); | |
168 | my $mess = $self->{queue}->{status_message}->{$a}; | |
169 | $self->reply ("$code $resp.0.0 $mess"); | |
170 | } else { | |
171 | $self->reply ("451 4.4.0 detected undelivered mail to <$a>"); | |
172 | } | |
173 | } | |
174 | } else { | |
e0cbdf9f SI |
175 | my $queueid = $self->{queue}->{logid}; |
176 | my $qstat = $self->{queue}->{status}; | |
177 | my @rec = keys %$qstat; | |
178 | my @success_rec = grep { $qstat->{$_} eq 'delivered' } @rec; | |
179 | my @reject_rec = grep { $qstat->{$_} eq 'blocked' } @rec; | |
180 | ||
181 | if (scalar(@reject_rec) == scalar(@rec)) { | |
5eaba42b | 182 | $self->reply ("554 5.7.1 Rejected for policy reasons ($queueid)"); |
e0cbdf9f SI |
183 | syslog('info', "reject mail $queueid"); |
184 | } elsif ((scalar(@reject_rec) + scalar(@success_rec)) == scalar(@rec)) { | |
185 | $self->reply ("250 2.5.0 OK ($queueid)"); | |
186 | if ($cfg->get('mail', 'ndr_on_block')) { | |
187 | my $dnsinfo = $cfg->get_host_dns_info(); | |
188 | generate_ndr($self->{from}, [ @reject_rec ], $dnsinfo->{fqdn}, $queueid) if scalar(@reject_rec); | |
73238bb3 | 189 | } |
73238bb3 | 190 | } else { |
5eaba42b | 191 | $self->reply ("451 4.4.0 detected undelivered mail ($queueid)"); |
73238bb3 DM |
192 | } |
193 | } | |
194 | } | |
195 | ||
196 | $self->reset(); | |
197 | ||
198 | $count++; | |
199 | last if $count >= $maxcount; | |
200 | last if $data->{errors}; # abort if we find errors | |
201 | next; | |
202 | } | |
14726412 | 203 | |
73238bb3 DM |
204 | $self->reply ("500 5.5.1 Error: unknown command"); |
205 | } | |
206 | ||
207 | $self->{sock}->close; | |
208 | return $count; | |
209 | } | |
210 | ||
211 | sub save_data { | |
212 | my $self = shift; | |
213 | my $done = undef; | |
14726412 | 214 | |
73238bb3 DM |
215 | if(!defined($self->{from})) { |
216 | $self->reply ("503 5.5.1 Tell me who you are."); | |
217 | return 0; | |
218 | } | |
14726412 | 219 | |
73238bb3 DM |
220 | if(!defined($self->{to})) { |
221 | $self->reply ("503 5.5.1 Tell me who to send it."); | |
222 | return 0; | |
223 | } | |
224 | ||
225 | $self->reply ("354 End data with <CR><LF>.<CR><LF>"); | |
226 | ||
227 | my $sock = $self->{sock}; | |
228 | ||
229 | my $queue; | |
230 | ||
231 | eval { | |
14726412 DM |
232 | $queue = PMG::MailQueue->new ($self->{from}, $self->{to}); |
233 | ||
73238bb3 DM |
234 | while(<$sock>) { |
235 | ||
236 | if(/^\.\015\012$/) { | |
237 | $done = 1; | |
238 | last; | |
239 | } | |
14726412 | 240 | |
73238bb3 DM |
241 | # RFC 2821 compliance. |
242 | s/^\.\./\./; | |
243 | ||
14726412 | 244 | s/\015\012/\n/; |
73238bb3 DM |
245 | |
246 | print {$queue->{fh}} $_; | |
247 | $queue->{bytes} += length ($_); | |
248 | } | |
249 | ||
250 | $queue->{fh}->flush (); | |
251 | ||
14726412 | 252 | $self->{queue} = $queue; |
73238bb3 | 253 | }; |
9d04575a DM |
254 | if (my $err = $@) { |
255 | syslog ('err', $err); | |
256 | $self->reply ("451 4.5.0 Local delivery failed: $err"); | |
73238bb3 DM |
257 | return 0; |
258 | } | |
259 | if(!defined($done)) { | |
260 | $self->reply ("451 4.5.0 Local delivery failed: unfinished data"); | |
261 | return 0; | |
262 | } | |
263 | ||
264 | return 1; | |
265 | } | |
266 | ||
cebfe036 SI |
267 | sub generate_ndr { |
268 | my ($sender, $receivers, $hostname, $queueid) = @_; | |
269 | ||
270 | my $ndr_text = <<EOF | |
271 | This is the mail system at host $hostname. | |
272 | ||
273 | I'm sorry to have to inform you that your message could not | |
274 | be delivered to one or more recipients. | |
275 | ||
276 | For further assistance, please send mail to postmaster. | |
277 | ||
278 | If you do so, please include this problem report. | |
279 | The mail system | |
280 | ||
281 | 554 5.7.1 Recipient address(es) rejected for policy reasons | |
282 | EOF | |
283 | ; | |
284 | my $ndr = MIME::Entity->build( | |
285 | Type => 'multipart/report; report-type=delivery-status;', | |
286 | To => $sender, | |
287 | From => 'postmaster', | |
288 | Subject => 'Undelivered Mail'); | |
289 | ||
290 | $ndr->attach( | |
291 | Data => $ndr_text, | |
292 | Type => 'text/plain; charset=utf-8', | |
293 | Encoding => '8bit'); | |
294 | ||
295 | my $delivery_status = <<EOF | |
296 | Reporting-MTA: dns; $hostname | |
297 | X-Proxmox-Queue-ID: $queueid | |
298 | X-Proxmox-Sender: rfc822; $sender | |
299 | EOF | |
300 | ; | |
301 | foreach my $rec (@$receivers) { | |
302 | $delivery_status .= <<EOF | |
303 | Final-Recipient: rfc822; $rec | |
304 | Original-Recipient: rfc822;$rec | |
305 | Action: failed | |
306 | Status: 5.7.1 | |
307 | Diagnostic-Code: smtp; 554 5.7.1 Recipient address rejected for policy reasons | |
308 | ||
309 | EOF | |
310 | ; | |
311 | } | |
312 | $ndr->attach( | |
313 | Data => $delivery_status, | |
314 | Type => 'message/delivery-status', | |
315 | Encoding => '7bit', | |
316 | Description => 'Delivery report'); | |
317 | ||
a56a4b54 | 318 | my $qid = PMG::Utils::reinject_local_mail($ndr, '', [$sender], undef, $hostname); |
cebfe036 SI |
319 | if ($qid) { |
320 | syslog('info', "sent NDR for rejecting recipients - $qid"); | |
321 | } else { | |
322 | syslog('err', "sending NDR for rejecting recipients failed"); | |
323 | } | |
324 | } | |
325 | ||
73238bb3 | 326 | 1; |