]>
Commit | Line | Data |
---|---|---|
3164123a | 1 | #!/usr/bin/perl |
ddaec666 DM |
2 | |
3 | use strict; | |
3164123a | 4 | use warnings; |
ddaec666 | 5 | use Getopt::Long; |
ddaec666 DM |
6 | use POSIX qw(errno_h signal_h); |
7 | ||
8 | use Net::Server::PreForkSimple; | |
9 | use Net::DNS::Resolver; | |
10 | use Mail::SPF; | |
11 | use Fcntl; | |
12 | use Fcntl ':flock'; | |
13 | use IO::Multiplex; | |
3164123a | 14 | use Time::HiRes qw(gettimeofday); |
ddaec666 | 15 | |
3164123a DM |
16 | use PVE::INotify; |
17 | use PVE::Tools; | |
18 | use PVE::SafeSyslog; | |
ddaec666 | 19 | |
3164123a DM |
20 | use PMG::Utils; |
21 | use PMG::RuleDB; | |
22 | use PMG::DBTools; | |
23 | use PMG::RuleCache; | |
24 | use PMG::Config; | |
25 | use PMG::ClusterConfig; | |
26 | ||
27 | use base qw(Net::Server::PreForkSimple); | |
ddaec666 DM |
28 | |
29 | my $greylist_delay = 3*60; # greylist window | |
30 | my $greylist_lifetime = 3600*24*2; # retry window | |
31 | my $greylist_awlifetime = 3600*24*36; # expire window | |
32 | ||
33 | my $opt_commandline = [$0, @ARGV]; | |
34 | my $opt_policy_port = 10022; | |
35 | my $opt_max_dequeue = 1; | |
36 | my $opt_dequeue_time = 60*2; | |
37 | ||
38 | my $opt_testmode; | |
39 | my $opt_pidfile; | |
40 | my $opt_database; | |
41 | ||
3164123a DM |
42 | if (!GetOptions ('pidfile=s' => \$opt_pidfile, |
43 | 'testmode' => \$opt_testmode, | |
ddaec666 DM |
44 | 'database=s' => \$opt_database)) { |
45 | die "usage error\n"; | |
46 | exit (-1); | |
47 | } | |
48 | ||
3164123a | 49 | $opt_pidfile = "/var/run/pmgpolicy.pid" if !$opt_pidfile; |
ddaec666 DM |
50 | $opt_max_dequeue = 0 if $opt_testmode; |
51 | ||
3164123a DM |
52 | initlog('pmgpolicy', 'mail'); |
53 | ||
54 | my $max_servers = 5; | |
ddaec666 DM |
55 | |
56 | if (!$opt_testmode) { | |
57 | ||
3164123a DM |
58 | my $pmg_cfg = PMG::Config->new (); |
59 | my $demo = $pmg_cfg->get('admin', 'demo'); | |
60 | $max_servers = $pmg_cfg->get('mail', 'max_policy'); | |
ddaec666 DM |
61 | |
62 | if ($demo) { | |
3164123a DM |
63 | syslog('info', 'demo mode detected - not starting server'); |
64 | exit(0); | |
ddaec666 DM |
65 | } |
66 | } | |
67 | ||
68 | my $daemonize = 1; | |
69 | if (defined ($ENV{BOUND_SOCKETS})) { | |
70 | $daemonize = undef; | |
71 | } | |
72 | ||
ddaec666 DM |
73 | |
74 | my $server_attr = { | |
75 | port => [ $opt_policy_port ], | |
76 | host => '127.0.0.1', | |
77 | max_servers => $max_servers, | |
78 | max_dequeue => $opt_max_dequeue, | |
79 | check_for_dequeue => $opt_dequeue_time, | |
80 | log_level => 3, | |
81 | pid_file => $opt_pidfile, | |
82 | commandline => $opt_commandline, | |
83 | no_close_by_child => 1, | |
84 | setsid => $daemonize, | |
85 | }; | |
86 | ||
87 | my $database; | |
88 | if (defined($opt_database)) { | |
89 | $database = $opt_database; | |
90 | } else { | |
91 | $database = "Proxmox_ruledb"; | |
92 | } | |
93 | ||
94 | $SIG{'__WARN__'} = sub { | |
95 | my $err = $@; | |
96 | my $t = $_[0]; | |
97 | chomp $t; | |
98 | syslog('warning', "WARNING: %s", $t); | |
99 | $@ = $err; | |
100 | }; | |
101 | ||
102 | sub run_dequeue { | |
103 | my $self = shift; | |
104 | ||
3164123a | 105 | $self->log(2, "starting greylist database maintainance"); |
ddaec666 DM |
106 | |
107 | my ($csec, $usec) = gettimeofday (); | |
108 | ||
3164123a | 109 | my $cinfo = PVE::INotify::read_file("cluster.conf"); |
ddaec666 | 110 | my $lcid = $cinfo->{local}->{cid}; |
3164123a DM |
111 | my $role = $cinfo->{local}->{type} // '-'; |
112 | ||
ddaec666 | 113 | my $dbh; |
3164123a | 114 | |
ddaec666 | 115 | eval { |
3164123a | 116 | $dbh = PMG::DBTools::open_ruledb($database); |
ddaec666 DM |
117 | }; |
118 | my $err = $@; | |
119 | ||
120 | if ($err) { | |
3164123a | 121 | $self->log(0, PMG::Utils::msgquote("ERROR: $err")); |
ddaec666 DM |
122 | return; |
123 | } | |
124 | ||
3164123a | 125 | my $now = time(); |
ddaec666 DM |
126 | |
127 | my $ecount = 0; | |
128 | ||
ddaec666 DM |
129 | eval { |
130 | ||
131 | $dbh->begin_work; | |
132 | ||
133 | # we do not lock the table here to avoid delays | |
134 | # but that is OK, because we only touch expired records | |
135 | # which do not change nornmally | |
136 | ## $dbh->do ("LOCK TABLE CGreylist IN ROW EXCLUSIVE MODE"); | |
137 | ||
138 | # move expired and undelivered records from Greylist to Statistic | |
3164123a | 139 | |
ddaec666 | 140 | my $rntxt = ''; |
3164123a | 141 | if (!$lcid) { |
ddaec666 DM |
142 | $rntxt = "AND CID = 0"; |
143 | } else { | |
3164123a | 144 | if ($role eq 'master') { |
ddaec666 DM |
145 | # master is responsible for all non-cluster (deleted) nodes |
146 | foreach my $rcid (@{$cinfo->{remnodes}}) { | |
147 | $rntxt .= $rntxt ? " AND CID != $rcid" : "AND (CID != $rcid"; | |
148 | } | |
149 | $rntxt .= ")" if $rntxt; | |
150 | } else { | |
151 | $rntxt = "AND (CID = 0 OR CID = $lcid)"; | |
152 | } | |
153 | } | |
154 | ||
155 | ||
156 | my $cmds = ''; | |
157 | ||
3164123a DM |
158 | my $sth = $dbh->prepare( |
159 | "SELECT distinct instance, sender FROM CGreylist " . | |
160 | "WHERE passed = 0 AND extime < ? $rntxt"); | |
ddaec666 DM |
161 | |
162 | $sth->execute ($now); | |
163 | ||
164 | ||
165 | while (my $ref = $sth->fetchrow_hashref()) { | |
3164123a DM |
166 | my $sth2 = $dbh->prepare( |
167 | "SELECT * FROM CGreylist WHERE instance = ? AND sender = ?"); | |
ddaec666 DM |
168 | $sth2->execute ($ref->{instance}, $ref->{sender}); |
169 | my $rctime; | |
170 | my @rcvrs; | |
171 | my $bc = 0; | |
172 | ||
173 | while (my $ref2 = $sth2->fetchrow_hashref()) { | |
174 | $rctime = $ref2->{rctime} if !$rctime; | |
175 | $bc += $ref2->{blocked}; | |
176 | push @rcvrs, $ref2->{receiver}; | |
177 | } | |
178 | ||
179 | $sth2->finish(); | |
180 | ||
181 | # hack: sometimes query sth2 does not return anything - maybe a | |
182 | # postgres bug? We simply ignore (when rctime is undefined) it | |
183 | # to avoid problems. | |
184 | ||
185 | if ($rctime) { | |
3164123a DM |
186 | $cmds .= "SELECT nextval ('cstatistic_id_seq');" . |
187 | "INSERT INTO CStatistic " . | |
ddaec666 DM |
188 | "(CID, RID, ID, Time, Bytes, Direction, Spamlevel, VirusInfo, PTime, Sender) VALUES (" . |
189 | "$lcid, currval ('cstatistic_id_seq'), currval ('cstatistic_id_seq'), "; | |
190 | ||
191 | my $sl = $bc >= 100000 ? 4 : 5; | |
192 | $cmds .= $rctime . ", 0, '1', $sl, NULL, 0, "; | |
193 | $cmds .= $dbh->quote ($ref->{sender}) . ');'; | |
194 | ||
195 | foreach my $r (@rcvrs) { | |
196 | my $tmp = $dbh->quote ($r); | |
197 | $cmds .= "INSERT INTO CReceivers (CStatistic_CID, CStatistic_RID, Receiver, Blocked) ". | |
198 | "VALUES ($lcid, currval ('cstatistic_id_seq'), $tmp, '1'); "; | |
199 | } | |
200 | } | |
201 | ||
202 | if (length ($cmds) > 100000) { | |
203 | $dbh->do ($cmds); | |
204 | $cmds = ''; | |
205 | } | |
206 | ||
ddaec666 DM |
207 | $ecount++; |
208 | ||
209 | # this produces too much log traffic | |
210 | # my $targets = join (", ", @rcvrs); | |
211 | #my $msg = "expire mail $ref->{instance} from $ref->{sender} to $targets"; | |
3164123a | 212 | #$self->log (0, PMG::Utils::msgquote ($msg)); |
ddaec666 DM |
213 | } |
214 | ||
215 | $dbh->do ($cmds) if $cmds; | |
216 | ||
217 | $sth->finish(); | |
218 | ||
219 | if ($ecount > 0) { | |
220 | my $msg = "found $ecount expired mails in greylisting database"; | |
221 | $self->log (0, $msg); | |
222 | } | |
223 | ||
224 | $dbh->do ("DELETE FROM CGreylist WHERE extime < $now"); | |
225 | ||
226 | $dbh->commit; | |
227 | }; | |
228 | ||
229 | $err = $@; | |
230 | ||
231 | my ($csec_end, $usec_end) = gettimeofday (); | |
232 | my $ptime = int (($csec_end-$csec)*1000 + ($usec_end - $usec)/1000); | |
233 | ||
234 | if ($err) { | |
235 | $dbh->rollback if $dbh; | |
3164123a | 236 | $self->log(0, PMG::Utils::msgquote($err)); |
ddaec666 | 237 | } else { |
3164123a | 238 | $self->log(2, "end greylist database maintainance ($ptime ms)"); |
ddaec666 DM |
239 | } |
240 | ||
241 | $dbh->disconnect() if $dbh; | |
242 | } | |
243 | ||
244 | sub pre_loop_hook { | |
3164123a | 245 | my $self = shift; |
ddaec666 | 246 | |
3164123a | 247 | my $prop = $self->{server}; |
ddaec666 | 248 | |
3164123a | 249 | $prop->{log_level} = 3; |
ddaec666 | 250 | |
3164123a | 251 | $self->log(0, "Policy daemon (re)started"); |
ddaec666 | 252 | |
3164123a DM |
253 | $SIG{'USR1'} = sub { |
254 | # reloading server configuration | |
255 | if (defined $prop->{children}) { | |
256 | foreach my $pid (keys %{$prop->{children}}) { | |
257 | kill (10, $pid); # SIGUSR1 childs | |
258 | } | |
259 | } | |
260 | }; | |
ddaec666 | 261 | |
3164123a DM |
262 | my $sig_set = POSIX::SigSet->new; |
263 | $sig_set->addset (&POSIX::SIGHUP); | |
264 | $sig_set->addset (&POSIX::SIGCHLD); | |
265 | my $old_sig_set = POSIX::SigSet->new(); | |
266 | ||
267 | sigprocmask (SIG_UNBLOCK, $sig_set, $old_sig_set); | |
ddaec666 DM |
268 | } |
269 | ||
270 | sub load_config { | |
3164123a | 271 | my $self = shift; |
ddaec666 | 272 | |
3164123a | 273 | my $prop = $self->{server}; |
ddaec666 | 274 | |
3164123a DM |
275 | if ($self->{ruledb}) { |
276 | $self->log(0, "reloading configuration $database"); | |
277 | $self->{ruledb}->close(); | |
278 | } | |
ddaec666 | 279 | |
3164123a DM |
280 | my $pmg_cfg = PMG::Config->new (); |
281 | $self->{use_rbl} = $pmg_cfg->get('mail', 'use_rbl'); | |
282 | $self->{use_spf} = $pmg_cfg->get('mail', 'spf'); | |
283 | $self->{use_greylist} = $pmg_cfg->get('mail', 'greylist'); | |
ddaec666 | 284 | |
3164123a DM |
285 | my $nodename = PVE::INotify::nodename(); |
286 | my $resolv = PVE::INotify::read_file('resolvconf'); | |
287 | my $domain = $resolv->{search}; | |
288 | $self->{fqdn} = "$nodename.$domain"; | |
ddaec666 | 289 | |
3164123a DM |
290 | my $cinfo = PVE::INotify::read_file("cluster.conf"); |
291 | my $lcid = $cinfo->{local}->{cid}; | |
292 | $self->{cinfo} = $cinfo; | |
293 | $self->{lcid} = $lcid; | |
ddaec666 | 294 | |
3164123a | 295 | my $dbh; |
ddaec666 | 296 | |
3164123a DM |
297 | eval { |
298 | $dbh = PMG::DBTools::open_ruledb($database); | |
299 | $self->{ruledb} = PMG::RuleDB->new($dbh); | |
300 | $self->{rulecache} = PMG::RuleCache->new($self->{ruledb}); | |
301 | }; | |
302 | if (my $err = $@) { | |
303 | $self->log(0, PMG::Utils::msgquote("ERROR: unable to load database : $err")); | |
304 | } | |
ddaec666 | 305 | |
3164123a DM |
306 | $self->{reload_config} = 0; |
307 | } | |
ddaec666 | 308 | |
3164123a DM |
309 | sub child_init_hook { |
310 | my $self = shift; | |
311 | ||
312 | my $prop = $self->{server}; | |
ddaec666 | 313 | |
3164123a | 314 | $0 = 'pmgpolicy child'; |
ddaec666 | 315 | |
3164123a DM |
316 | setup_fork_signal_mask(0); # unblocking signals for children |
317 | ||
318 | eval { | |
319 | $self->load_config(); | |
320 | ||
321 | $self->{mux} = IO::Multiplex->new(); | |
322 | $self->{mux}->set_callback_object($self); | |
323 | ||
324 | my %dnsargs = ( | |
325 | tcp_timeout => 3, | |
326 | udp_timeout => 3, | |
327 | retry => 1, | |
328 | retrans => 0, | |
329 | dnsrch => 0, | |
330 | defnames => 0, | |
331 | ); | |
332 | ||
333 | if ($opt_testmode) { | |
334 | # $dnsargs{nameservers} = [ qw (213.129.232.1 213.129.226.2) ]; | |
335 | } | |
ddaec666 | 336 | |
3164123a DM |
337 | $self->{dns_resolver} = Net::DNS::Resolver->new(%dnsargs); |
338 | ||
339 | $self->{spf_server} = Mail::SPF::Server->new( | |
340 | hostname => $self->{fqdn}, dns_resolver => $self->{dns_resolver}); | |
341 | }; | |
342 | if (my $err = $@) { | |
343 | $self->log(0, PMG::Utils::msgquote($err)); | |
344 | $self->child_finish_hook; | |
345 | exit(-1); | |
346 | } | |
347 | ||
348 | $SIG{'USR1'} = sub { | |
349 | $self->{reload_config} = 1; | |
350 | } | |
ddaec666 DM |
351 | } |
352 | ||
353 | sub child_finish_hook { | |
3164123a | 354 | my $self = shift; |
ddaec666 | 355 | |
3164123a | 356 | my $prop = $self->{server}; |
ddaec666 | 357 | |
3164123a DM |
358 | $self->{ruledb}->close() if $self->{ruledb}; |
359 | } | |
ddaec666 DM |
360 | |
361 | sub get_spf_result { | |
362 | my ($self, $instance, $ip, $helo, $sender) = @_; | |
363 | ||
364 | my $result; | |
365 | my $spf_header; | |
366 | my $local_expl; | |
367 | my $auth_expl; | |
368 | ||
369 | # we only use helo tests when we have no sender, | |
3164123a | 370 | # helo is sometimes empty, so we cant use SPF helo tests |
ddaec666 DM |
371 | # in that case - strange |
372 | if ($helo && !$sender) { | |
373 | my $query; | |
374 | ||
3164123a | 375 | if (defined ($self->{cache}->{$instance}) && |
ddaec666 DM |
376 | defined ($self->{cache}->{$instance}->{spf_helo_result})) { |
377 | ||
378 | $query = $self->{cache}->{$instance}->{spf_helo_result}; | |
379 | ||
380 | } else { | |
3164123a DM |
381 | my $request = Mail::SPF::Request->new( |
382 | scope => 'helo', identity => $helo, ip_address => $ip); | |
383 | ||
384 | $query = $self->{cache}->{$instance}->{spf_helo_result} = | |
ddaec666 DM |
385 | $self->{spf_server}->process ($request); |
386 | } | |
387 | ||
388 | $result = $query->code; | |
389 | $spf_header = $query->received_spf_header; | |
390 | $local_expl = $query->local_explanation; | |
391 | $auth_expl = $query->authority_explanation if $query->is_code('fail'); | |
392 | ||
393 | # return if we get a definitive result | |
394 | if ($result eq 'pass' || $result eq 'fail' || $result eq 'temperror') { | |
395 | return ($result, $spf_header, $local_expl, $auth_expl); | |
396 | } | |
397 | } | |
398 | ||
399 | if ($sender) { | |
400 | ||
401 | my $query; | |
402 | ||
3164123a | 403 | if (defined ($self->{cache}->{$instance}) && |
ddaec666 | 404 | defined ($self->{cache}->{$instance}->{spf_mfrom_result})) { |
3164123a | 405 | |
ddaec666 DM |
406 | $query = $self->{cache}->{$instance}->{spf_mfrom_result}; |
407 | ||
408 | } else { | |
409 | ||
3164123a DM |
410 | my $request = Mail::SPF::Request->new( |
411 | scope => 'mfrom', identity => $sender, | |
412 | ip_address => $ip, helo_identity => $helo); | |
413 | ||
ddaec666 DM |
414 | $query = $self->{cache}->{$instance}->{spf_mfrom_result} = |
415 | $self->{spf_server}->process($request); | |
416 | } | |
417 | ||
418 | $result = $query->code; | |
419 | $spf_header = $query->received_spf_header; | |
420 | $local_expl = $query->local_explanation; | |
421 | $auth_expl = $query->authority_explanation if $query->is_code('fail'); | |
422 | ||
423 | return ($result, $spf_header, $local_expl, $auth_expl); | |
424 | } | |
425 | ||
426 | return undef; | |
427 | } | |
428 | ||
429 | sub is_backup_mx { | |
430 | my ($self, $ip, $receiver) = @_; | |
431 | ||
432 | my ($rdomain) = $receiver =~ /([^@]+)$/; | |
433 | ||
434 | my $dkey = "BKMX:$rdomain"; | |
435 | ||
436 | if (defined ($self->{cache}->{$dkey}) && | |
437 | ($self->{cache}->{$dkey}->{status} == 1)) { | |
438 | return $self->{cache}->{$dkey}->{$ip}; | |
439 | } | |
440 | ||
441 | my $resolver = $self->{dns_resolver}; | |
442 | ||
3164123a | 443 | if (my $mx = $resolver->send($rdomain, 'MX')) { |
ddaec666 DM |
444 | $self->{cache}->{$dkey}->{status} = 1; |
445 | my @mxa = grep { $_->type eq 'MX' } $mx->answer; | |
446 | my @mxl = sort { $a->preference <=> $b->preference } @mxa; | |
447 | # shift @mxl; # optionaly skip primary MX ? | |
448 | foreach my $rr (@mxl) { | |
449 | my $a = $resolver->send ($rr->exchange, 'A'); | |
450 | if ($a) { | |
451 | foreach my $rra ($a->answer) { | |
452 | if ($rra->type eq 'A') { | |
453 | $self->{cache}->{$dkey}->{$rra->address} = 1; | |
454 | } | |
455 | } | |
456 | } | |
457 | } | |
458 | } else { | |
459 | $self->{cache}->{$dkey}->{status} = 0; | |
460 | } | |
461 | ||
462 | return $self->{cache}->{$dkey}->{$ip}; | |
463 | } | |
464 | ||
465 | sub greylist_value { | |
466 | my ($self, $ctime, $helo, $ip, $sender, $rcpt, $instance) = @_; | |
467 | ||
468 | my $rulecache = $self->{rulecache}; | |
469 | ||
470 | my $dbh = $self->{ruledb}->{dbh}; | |
471 | ||
472 | # try to reconnect if database connection is broken | |
473 | if (!$dbh->ping) { | |
3164123a | 474 | $self->log(0, 'Database connection broken - trying to reconnect'); |
ddaec666 DM |
475 | my $dbh; |
476 | eval { | |
3164123a | 477 | $dbh = PMG::DBTools::open_ruledb($database); |
ddaec666 DM |
478 | }; |
479 | my $err = $@; | |
480 | if ($err) { | |
3164123a | 481 | $self->log(0, PMG::Utils::msgquote("unable to reconnect to database server: $err")); |
ddaec666 DM |
482 | return 'dunno'; |
483 | } | |
3164123a | 484 | $self->{ruledb} = PMG::RuleDB->new($dbh); |
ddaec666 DM |
485 | } |
486 | ||
487 | # some sender substitutions | |
488 | my ($user, $domain) = split('@', $sender, 2); | |
489 | if (defined ($user) && defined ($domain)) { | |
490 | # see http://cr.yp.to/proto/verp.txt | |
491 | $user =~ s/\+.*//; # strip extensions (mailing-list VERP) | |
492 | $user =~ s/\b\d+\b/#/g; #replace nubmers in VERP address | |
493 | $sender = "$user\@$domain"; | |
494 | } | |
495 | ||
3164123a DM |
496 | if ($self->is_backup_mx($ip, $rcpt)) { |
497 | $self->log(3, "accept mails from backup MX host - $ip"); | |
ddaec666 DM |
498 | return 'dunno'; |
499 | } | |
500 | ||
501 | # greylist exclusion (sender whitelist) | |
502 | if ($rulecache->greylist_match ($sender, $ip)) { | |
3164123a | 503 | $self->log(3, "accept mails from whitelist - $ip"); |
ddaec666 DM |
504 | return 'dunno'; |
505 | } | |
506 | ||
ddaec666 DM |
507 | # greylist exclusion (receiver whitelist) |
508 | if ($rulecache->greylist_match_receiver ($rcpt)) { | |
3164123a | 509 | $self->log(3, "accept mails to whitelist - <$rcpt>"); |
ddaec666 DM |
510 | return 'dunno'; |
511 | } | |
512 | ||
513 | my ($net, $host) = $ip =~ m/(\d+\.\d+\.\d+)\.(\d+)/; | |
514 | my $spf_header; | |
515 | ||
3164123a | 516 | if ((!$opt_testmode && $self->{use_spf}) || |
ddaec666 DM |
517 | ($opt_testmode && ($rcpt =~ m/^testspf/))) { |
518 | ||
519 | # ask SPF | |
520 | my $spf_result; | |
521 | my $local_expl, | |
522 | my $auth_expl; | |
523 | ||
524 | my $previous_alarm; | |
525 | ||
526 | my ($result, $smtp_comment, $header_comment); | |
527 | ||
528 | eval { | |
3164123a | 529 | $previous_alarm = alarm(10); |
ddaec666 | 530 | local $SIG{ALRM} = sub { die "SPF timeout\n" }; |
3164123a DM |
531 | |
532 | ($result, $spf_header, $local_expl, $auth_expl) = | |
533 | $self->get_spf_result($instance, $ip, $helo, $sender); | |
534 | ||
535 | alarm(0); # avoid race condition | |
ddaec666 | 536 | }; |
ddaec666 DM |
537 | my $err = $@; |
538 | ||
3164123a | 539 | alarm($previous_alarm) if defined($previous_alarm); |
ddaec666 DM |
540 | |
541 | if ($err) { | |
542 | $err = $err->text if UNIVERSAL::isa ($err, 'Mail::SPF::Exception'); | |
3164123a | 543 | $self->log (0, PMG::Utils::msgquote($err)); |
ddaec666 DM |
544 | } else { |
545 | ||
546 | if ($result && $result eq 'pass') { | |
3164123a | 547 | $self->log(3, "SPF says $result"); |
ddaec666 DM |
548 | $spf_result = $spf_header ? "prepend $spf_header" : 'dunno'; |
549 | } | |
3164123a | 550 | |
ddaec666 | 551 | if ($result && $result eq 'fail') { |
3164123a DM |
552 | $self->log(3, "SPF says $result"); |
553 | $spf_result = "reject ${auth_expl}"; | |
554 | ||
ddaec666 DM |
555 | eval { |
556 | ||
557 | $dbh->begin_work; | |
558 | ||
559 | # try to avoid locks everywhere - we use merge instead of insert | |
560 | #$dbh->do ("LOCK TABLE CGreylist IN ROW EXCLUSIVE MODE"); | |
3164123a | 561 | |
ddaec666 | 562 | # check if there is already a record in the GL database |
3164123a DM |
563 | my $sth = $dbh->prepare( |
564 | "SELECT * FROM CGreylist " . | |
565 | "where IPNet = ? AND Sender = ? AND Receiver = ?"); | |
ddaec666 | 566 | |
3164123a | 567 | $sth->execute($net, $sender, $rcpt); |
ddaec666 DM |
568 | my $ref = $sth->fetchrow_hashref(); |
569 | $sth->finish(); | |
570 | ||
571 | # else add an entry to the GL Database with short | |
3164123a | 572 | # expiration time. run_dequeue() moves those entries into the statistic |
ddaec666 DM |
573 | # table later. We set 'blocked' to 100000 to identify those entries. |
574 | ||
3164123a | 575 | if (!defined($ref->{rctime})) { |
ddaec666 | 576 | |
3164123a DM |
577 | $dbh->do("SELECT merge_greylist(?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)", undef, |
578 | $net, $host, $sender, $rcpt, $instance, | |
579 | $ctime, $ctime + 10, 0, 100000, 0, $ctime, $self->{lcid}); | |
ddaec666 DM |
580 | } |
581 | ||
582 | $dbh->commit; | |
583 | }; | |
3164123a | 584 | if (my $err = $@) { |
ddaec666 | 585 | $dbh->rollback; |
3164123a | 586 | $self->log(0, PMG::Utils::msgquote($err)); |
ddaec666 DM |
587 | } |
588 | } | |
589 | } | |
590 | ||
591 | return $spf_result if $spf_result; | |
592 | } | |
593 | ||
594 | ||
595 | my $res = $spf_header ? "prepend $spf_header" : 'dunno'; | |
596 | ||
597 | return $res if !$self->{use_greylist}; | |
598 | ||
3164123a DM |
599 | my $defer_res = "defer_if_permit Service is unavailable (try later)"; |
600 | ||
ddaec666 DM |
601 | eval { |
602 | ||
603 | # we dont use alarm here, because it does not work with DBI | |
604 | ||
605 | $dbh->begin_work; | |
606 | ||
607 | # try to avoid locks everywhere - we use merge instead of insert | |
608 | #$dbh->do ("LOCK TABLE CGreylist IN ROW EXCLUSIVE MODE"); | |
609 | ||
3164123a DM |
610 | my $sth = $dbh->prepare( |
611 | "SELECT * FROM CGreylist " . | |
612 | "where IPNet = ? AND Sender = ? AND Receiver = ?"); | |
613 | ||
614 | $sth->execute($net, $sender, $rcpt); | |
ddaec666 | 615 | |
ddaec666 DM |
616 | my $ref = $sth->fetchrow_hashref(); |
617 | ||
618 | $sth->finish(); | |
619 | ||
3164123a | 620 | if (!defined($ref->{rctime})) { |
ddaec666 | 621 | |
3164123a | 622 | $dbh->do ("SELECT merge_greylist(?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)", undef, |
ddaec666 DM |
623 | $net, $host, $sender, $rcpt, $instance, |
624 | $ctime, $ctime + $greylist_lifetime, 0, 1, 0, $ctime, $self->{lcid}); | |
625 | ||
626 | $res = $defer_res; | |
3164123a | 627 | $self->log(3, "defer greylisted mail"); |
ddaec666 | 628 | } else { |
3164123a | 629 | my $age = $ctime - $ref->{rctime}; |
ddaec666 DM |
630 | |
631 | if ($age < $greylist_delay) { | |
632 | # defer (resent within greylist_delay window) | |
633 | $res = $defer_res; | |
3164123a DM |
634 | $self->log(3, "defer greylisted mail"); |
635 | $dbh->do("UPDATE CGreylist " . | |
636 | "SET Blocked = Blocked + 1, Host = ?, MTime = ? " . | |
637 | "WHERE IPNet = ? AND Sender = ? AND Receiver = ?", undef, | |
638 | $host, $ctime, $net, $sender, $rcpt); | |
ddaec666 DM |
639 | } else { |
640 | if ($ctime < $ref->{extime}) { | |
641 | # accept (not expired) | |
642 | my $lifetime = $sender eq "" ? 0 : $greylist_awlifetime; | |
643 | my $delay = $ref->{passed} ? "" : "Delay = $age, "; | |
3164123a DM |
644 | $dbh->do("UPDATE CGreylist " . |
645 | "SET Passed = Passed + 1, $delay Host = ?, ExTime = ?, MTime = ? " . | |
646 | "WHERE IPNet = ? AND Sender = ? AND Receiver = ?", undef, | |
647 | $host, $ctime + $lifetime, $ctime, $net, $sender, $rcpt); | |
ddaec666 DM |
648 | } else { |
649 | # defer (record is expired) | |
650 | $res = $defer_res; | |
3164123a DM |
651 | $dbh->do("UPDATE CGreylist " . |
652 | "SET Host = ?, RCTime = ?, ExTime = ?, MTime = ?, Instance = ?, " . | |
653 | "Blocked = 1, Passed = 0 " . | |
654 | "WHERE IPNet = ? AND Sender = ? AND Receiver = ?", undef, | |
655 | $host, $ctime, $ctime + $greylist_lifetime, $ctime, $instance, | |
656 | $net, $sender, $rcpt); | |
ddaec666 | 657 | } |
3164123a | 658 | } |
ddaec666 DM |
659 | } |
660 | ||
661 | $dbh->commit; | |
662 | }; | |
3164123a DM |
663 | if (my $err = $@) { |
664 | $dbh->rollback; | |
665 | $self->log (0, PMG::Utils::msgquote($err)); | |
ddaec666 DM |
666 | } |
667 | ||
668 | return $res; | |
669 | } | |
670 | ||
3164123a | 671 | # shutdown connections: we need this - else file handles are |
ddaec666 DM |
672 | # not closed and we run out of handles |
673 | sub mux_eof { | |
674 | my ($self, $mux, $fh) = @_; | |
675 | ||
676 | $mux->shutdown($fh, 1); | |
677 | } | |
678 | ||
679 | sub mux_input { | |
680 | my ($self, $mux, $fh, $dataref) = @_; | |
681 | my $prop = $self->{server}; | |
3164123a | 682 | |
ddaec666 DM |
683 | my $attribute = {}; |
684 | ||
685 | eval { | |
3164123a | 686 | $self->load_config() if $self->{reload_config}; |
ddaec666 DM |
687 | |
688 | while ($$dataref =~ s/^([^\r\n]*)\r?\n//) { | |
689 | my $line = $1; | |
690 | next if !defined ($line); | |
691 | ||
692 | if ($line =~ m/([^=]+)=(.*)/) { | |
693 | $attribute->{substr($1, 0, 255)} = substr($2, 0, 255); | |
3164123a | 694 | } elsif ($line eq '') { |
ddaec666 DM |
695 | my $res = 'dunno'; |
696 | my $ctime = time; | |
697 | ||
698 | if ($opt_testmode) { | |
699 | die "undefined test time :ERROR" if !defined $attribute->{testtime}; | |
700 | $ctime = $attribute->{testtime}; | |
701 | } | |
702 | ||
3164123a | 703 | if ($attribute->{instance} && $attribute->{recipient} && |
ddaec666 DM |
704 | $attribute->{client_address} && $attribute->{request} && |
705 | $attribute->{request} eq 'smtpd_access_policy') { | |
3164123a | 706 | |
ddaec666 | 707 | eval { |
3164123a DM |
708 | |
709 | $res = $self->greylist_value( | |
710 | $ctime, | |
711 | lc ($attribute->{helo_name}), | |
712 | lc ($attribute->{client_address}), | |
713 | lc ($attribute->{sender}), | |
714 | lc ($attribute->{recipient}), | |
715 | lc ($attribute->{instance})); | |
ddaec666 | 716 | }; |
3164123a DM |
717 | if (my $err = $@) { |
718 | $self->log(0, PMG::Utils::msgquote($err)); | |
719 | } | |
ddaec666 DM |
720 | } |
721 | ||
722 | print $fh "action=$res\n\n"; | |
723 | ||
724 | $attribute = {}; | |
725 | } else { | |
3164123a | 726 | $self->log(0, "greylist policy protocol error - got '%s'", $line); |
ddaec666 DM |
727 | } |
728 | } | |
729 | }; | |
3164123a | 730 | my $err = $@; |
ddaec666 DM |
731 | |
732 | # remove remaining data, if any | |
733 | if ($$dataref ne '') { | |
3164123a | 734 | $self->log(0, "greylist policy protocol error - unused data '%s'", $$dataref); |
ddaec666 DM |
735 | $$dataref = ''; |
736 | } | |
737 | ||
3164123a | 738 | $self->log(0, PMG::Utils::msgquote($err)) if $err; |
ddaec666 DM |
739 | } |
740 | ||
741 | sub restart_close_hook { | |
3164123a | 742 | my $self = shift; |
ddaec666 | 743 | |
3164123a DM |
744 | my $sig_set = POSIX::SigSet->new; |
745 | $sig_set->addset(&POSIX::SIGHUP); | |
746 | $sig_set->addset(&POSIX::SIGCHLD); # to avoid zombies | |
747 | my $old_sig_set = POSIX::SigSet->new(); | |
ddaec666 | 748 | |
3164123a | 749 | sigprocmask(SIG_BLOCK, $sig_set, $old_sig_set); |
ddaec666 DM |
750 | } |
751 | ||
752 | sub pre_server_close_hook { | |
3164123a DM |
753 | my $self = shift; |
754 | ||
755 | my $prop = $self->{server}; | |
ddaec666 | 756 | |
3164123a DM |
757 | if (defined $prop->{_HUP}) { |
758 | undef $prop->{pid_file_unlink}; | |
759 | } | |
ddaec666 DM |
760 | } |
761 | ||
762 | sub setup_fork_signal_mask { | |
763 | my $block = shift; | |
764 | ||
765 | my $sig_set = POSIX::SigSet->new; | |
3164123a DM |
766 | $sig_set->addset(&POSIX::SIGINT); |
767 | $sig_set->addset(&POSIX::SIGTERM); | |
768 | $sig_set->addset(&POSIX::SIGQUIT); | |
769 | $sig_set->addset(&POSIX::SIGHUP); | |
ddaec666 DM |
770 | my $old_sig_set = POSIX::SigSet->new(); |
771 | ||
772 | if ($block) { | |
773 | sigprocmask (SIG_BLOCK, $sig_set, $old_sig_set); | |
774 | } else { | |
775 | sigprocmask (SIG_UNBLOCK, $sig_set, $old_sig_set); | |
776 | } | |
777 | } | |
778 | ||
779 | # subroutine to start up a specified number of children. | |
780 | # We need to block signals until handlers are set up correctly. | |
3164123a DM |
781 | # Else its possible that HUP occurs after fork, which triggers |
782 | # singal TERM at childs and calls server_close() instead of | |
ddaec666 DM |
783 | # simply exit the child. |
784 | # Note: on server startup signals are setup to trigger | |
785 | # asynchronously for a short period of time (in PreForkSimple]::loop, | |
3164123a | 786 | # run_n_children is called before run_parent) |
ddaec666 | 787 | # Net::Server::PreFork does not have this problem, because it is using |
3164123a | 788 | # signal HUP stop children |
ddaec666 | 789 | sub run_n_children { |
3164123a DM |
790 | my ($self, $n) = @_; |
791 | ||
ddaec666 | 792 | my $prop = $self->{server}; |
ddaec666 | 793 | |
3164123a DM |
794 | setup_fork_signal_mask(1); # block signals |
795 | ||
796 | $self->SUPER::run_n_children($n); | |
ddaec666 | 797 | |
3164123a | 798 | setup_fork_signal_mask(0); # unblocking signals for parent |
ddaec666 DM |
799 | } |
800 | ||
3164123a | 801 | # test sig_hup with: for ((;;)) ;do kill -HUP `cat /var/run/pmgpolicy.pid`; done; |
ddaec666 DM |
802 | # wrapper to avoid multiple calls to sig_hup |
803 | sub sig_hup { | |
3164123a DM |
804 | my $self = shift; |
805 | ||
806 | my $prop = $self->{server}; | |
ddaec666 | 807 | |
3164123a | 808 | return if defined($prop->{_HUP}); # do not call twice |
ddaec666 | 809 | |
3164123a | 810 | $self->SUPER::sig_hup(); |
ddaec666 DM |
811 | } |
812 | ||
813 | ### child process which will accept on the port | |
814 | sub run_child { | |
3164123a | 815 | my $self = shift; |
ddaec666 | 816 | |
3164123a | 817 | my $prop = $self->{server}; |
ddaec666 | 818 | |
3164123a | 819 | $self->log(4, "Child Preforked ($$)\n"); |
ddaec666 | 820 | |
3164123a DM |
821 | # set correct signal handlers before enabling signals again |
822 | $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub { | |
823 | $self->child_finish_hook; | |
824 | exit; | |
825 | }; | |
ddaec666 | 826 | |
3164123a | 827 | delete $prop->{children}; |
ddaec666 | 828 | |
3164123a | 829 | $self->child_init_hook; |
ddaec666 | 830 | |
3164123a | 831 | # accept connections |
ddaec666 | 832 | |
3164123a | 833 | my $sock = $prop->{sock}->[0]; |
ddaec666 | 834 | |
3164123a DM |
835 | # make sure we got a good sock |
836 | if (!defined ($sock)){ | |
837 | $self->log(0, "ERROR: Received a bad socket"); | |
838 | exit (-1); | |
839 | } | |
840 | ||
841 | # sometimes the socket is not usable, don't know why | |
842 | my $flags = fcntl($sock, F_GETFL, 0); | |
843 | if (!$flags) { | |
844 | $self->log(0, PMG::Utils::msgquote("socket not ready - $!")); | |
845 | exit (-1); | |
846 | } | |
ddaec666 | 847 | |
3164123a DM |
848 | # cache is limited, because postfix does max. 100 queries |
849 | $self->{cache} = {}; | |
ddaec666 | 850 | |
3164123a DM |
851 | eval { |
852 | my $mux = $self->{mux}; | |
853 | $mux->listen ($sock); | |
854 | $mux->loop; | |
855 | }; | |
856 | if (my $err = $@) { | |
857 | $self->log(0, PMG::Utils::msgquote("ERROR: $err")); | |
858 | } | |
ddaec666 | 859 | |
3164123a | 860 | $self->child_finish_hook; |
ddaec666 | 861 | |
3164123a | 862 | exit; |
ddaec666 DM |
863 | } |
864 | ||
3164123a DM |
865 | my $syslog_map = { |
866 | 0 => 'err', | |
867 | 1 => 'warning', | |
868 | 2 => 'notice', | |
869 | 3 => 'info', | |
870 | 4 => 'debug' | |
871 | }; | |
872 | ||
ddaec666 DM |
873 | sub log { |
874 | my ($self, $level, $msg, @therest) = @_; | |
3164123a | 875 | |
ddaec666 DM |
876 | my $prop = $self->{server}; |
877 | ||
878 | return if $level =~ /^\d+$/ && $level > $prop->{log_level}; | |
879 | ||
3164123a | 880 | $level = $syslog_map->{$level} || $level; |
ddaec666 DM |
881 | if (@therest) { |
882 | syslog($level, $msg, @therest); | |
883 | } else { | |
884 | syslog ($level, $msg); | |
885 | } | |
886 | } | |
887 | ||
888 | my $server = bless { | |
889 | server => $server_attr, | |
890 | }; | |
891 | ||
892 | $server->sig_chld(); # avoid zombies after restart | |
893 | ||
894 | $server->run (); | |
895 | ||
896 | exit (0); | |
897 | ||
898 | __END__ | |
899 | ||
900 | =head1 NAME | |
3164123a DM |
901 | |
902 | pmgpolicy - The Proxmox policy daemon | |
ddaec666 DM |
903 | |
904 | =head1 SYNOPSIS | |
905 | ||
3164123a | 906 | pmgpolicy |
ddaec666 DM |
907 | |
908 | =head1 DESCRIPTION | |
909 | ||
910 | Documentation is available at www.proxmox.com |