]>
git.proxmox.com Git - pmg-api.git/blob - src/PMG/RuleDB/Spam.pm
99056a37f8a7161f2d63e289204d72a53bbe3825
1 package PMG
::RuleDB
::Spam
;
8 use Time
::HiRes qw
(gettimeofday
);
11 use Mail
::SpamAssassin
;
14 use PMG
::RuleDB
::Object
;
16 use base
qw(PMG::RuleDB::Object);
31 my ($type, $level, $ogroup) = @_;
33 my $class = ref($type) || $type;
35 my $self = $class->SUPER::new
($class->otype(), $ogroup);
37 $level = 5 if !defined ($level);
39 $self->{level
} = $level;
45 my ($type, $ruledb, $id, $ogroup, $value) = @_;
47 my $class = ref($type) || $type;
49 defined($value) || die "undefined value: ERROR";
51 my $obj = $class->new($value, $ogroup);
54 $obj->{digest
} = Digest
::SHA
::sha1_hex
($id, $value, $ogroup);
60 my ($self, $ruledb) = @_;
62 defined($self->{ogroup
}) || die "undefined ogroup: ERROR";
63 defined($self->{level
}) || die "undefined spam level: ERROR";
65 if (defined ($self->{id
})) {
69 "UPDATE Object SET Value = ? WHERE ID = ?",
70 undef, $self->{level
}, $self->{id
});
75 my $sth = $ruledb->{dbh
}->prepare(
76 "INSERT INTO Object (Objectgroup_ID, ObjectType, Value) " .
79 $sth->execute($self->ogroup, $self->otype, $self->{level
});
81 $self->{id
} = PMG
::Utils
::lastid
($ruledb->{dbh
}, 'object_id_seq');
92 foreach my $addr (split ('\s*,\s*', $list)) {
96 $regex =~ s/[\000\\\(]/_/gs; # is this really necessasry ?
97 $regex =~ s/([^\*\?_a-zA-Z0-9])/\\$1/g; # escape possible metachars
98 $regex =~ tr/?/./; # replace "?" with "."
99 $regex =~ s/\*+/\.\*/g; # replace "*" with ".*"
101 # we use a hash for extra fast testing
102 $adlist->{$addr} = "^${regex}\$";
109 my ($list, $addrlst) = @_;
111 foreach my $addr (@$addrlst) {
115 return 1 if defined ($list->{$addr});
119 foreach my $r (values %{$list}) {
120 if ($addr =~ qr/$r/i) {
130 my ($dbh, $entity, $msginfo) = @_;
132 my $target_info = {};
134 my $targets = $msginfo->{targets
};
137 foreach my $r (@$targets) {
138 my $pmail = $msginfo->{pmail
}->{$r} || lc ($r);
139 my $qr = $dbh->quote (encode
('UTF-8', $pmail));
140 $cond .= " OR " if $cond;
141 $cond .= "pmail = $qr";
145 my $query = "SELECT * FROM UserPrefs WHERE " .
146 "($cond) AND (Name = 'BL' OR Name = 'WL')";
147 my $sth = $dbh->prepare($query);
151 while (my $ref = $sth->fetchrow_hashref()) {
152 my $pmail = lc ($ref->{pmail
});
153 if ($ref->{name
} eq 'WL') {
154 $target_info->{$pmail}->{whitelist
} =
155 parse_addrlist
($ref->{data
});
156 } elsif ($ref->{name
} eq 'BL') {
157 $target_info->{$pmail}->{blacklist
} =
158 parse_addrlist
($ref->{data
});
171 sub what_match_targets
{
172 my ($self, $queue, $entity, $msginfo, $dbh) = @_;
176 if (!$queue->{spam_analyzed
}) {
177 $self->analyze_spam($queue, $entity, $msginfo);
178 $queue->{blackwhite
} = get_blackwhite
($dbh, $entity, $msginfo);
179 $queue->{spam_analyzed
} = 1;
182 if ($msginfo->{testmode
}) {
183 $queue->{sa_score
} = 100 if $queue->{sa_score
} > 100;
185 foreach my $s (@{$queue->{sa_data
}}) {
186 next if $s->{rule
} eq 'AWL';
189 $queue->{sa_data
} = $data;
192 if (defined($queue->{sa_score
}) && $queue->{sa_score
} >= $self->{level
}) {
195 sa_score
=> $queue->{sa_score
},
196 sa_max
=> $self->{level
},
197 sa_data
=> $queue->{sa_data
},
198 sa_hits
=> $queue->{sa_hits
}
201 foreach my $t (@{$msginfo->{targets
}}) {
203 my $pmail = $msginfo->{pmail
}->{$t} || $t;
204 if ($queue->{blackwhite
}->{$pmail} &&
205 ($list = $queue->{blackwhite
}->{$pmail}->{whitelist
}) &&
206 check_addrlist
($list, $queue->{all_from_addrs
})) {
207 syslog
('info', "%s: sender in user (%s) whitelist",
208 $queue->{logid
}, $pmail);
210 $target_info->{$t}->{marks
} = []; # never add additional marks here
211 $target_info->{$t}->{spaminfo
} = $info;
217 foreach my $t (@{$msginfo->{targets
}}) {
220 sa_max
=> $self->{level
},
222 rule
=> 'USER_IN_BLACKLIST',
224 desc
=> 'From: address is in the user black-list',
226 sa_hits
=> 'USER_IN_BLACKLIST',
230 my $pmail = $msginfo->{pmail
}->{$t} || $t;
231 if ($queue->{blackwhite
}->{$pmail} &&
232 ($list = $queue->{blackwhite
}->{$pmail}->{blacklist
}) &&
233 check_addrlist
($list, $queue->{all_from_addrs
})) {
234 $target_info->{$t}->{marks
} = [];
235 $target_info->{$t}->{spaminfo
} = $info;
236 syslog
('info', "%s: sender in user (%s) blacklist",
237 $queue->{logid
}, $pmail);
258 return "Level $self->{level}";
262 my ($head, $name) = @_;
264 my $result = $head->get($name);
266 return '' if !$result;
268 # copied from Mail::Spamassassin:PerMsgStatus _get()
270 $result =~ s/^[^:]+:(.*);\s*$/$1/gs; # 'undisclosed-recipients: ;'
271 $result =~ s/\s+/ /g; # reduce whitespace
272 $result =~ s/^\s+//; # leading whitespace
273 $result =~ s/\s+$//; # trailing whitespace
275 # Get the email address out of the header
276 # All of these should result in "jm@foo":
280 # display: jm@foo (Foo Blah), jm@bar ;
282 # "Foo Blah" <jm@foo>
283 # "'Foo Blah'" <jm@foo>
285 # strip out the (comments)
286 $result =~ s/\s*\(.*?\)//g;
287 # strip out the "quoted text", unless it's the only thing in the string
288 if ($result !~ /^".*"$/) {
289 $result =~ s/(?<!<)"[^"]*"(?!@)//g; #" emacs
291 # Foo Blah <jm@xxx> or <jm@xxx>
292 $result =~ s/^[^"<]*?<(.*?)>.*$/$1/;
293 # multiple addresses on one line? remove all but first
299 # implement our own all_from_addrs()
300 # because we do not call spamassassin in canes of commtouch match
301 # see Mail::Spamassassin:PerMsgStatus for details
302 sub __all_from_addrs
{
307 my $resent = $head->get('Resent-From');
308 if (defined($resent) && $resent =~ /\S/) {
309 @addrs = Mail
::SpamAssassin-
>find_all_addrs_in_line($resent);
311 @addrs = map { tr/././s; $_ } grep { $_ ne '' }
312 (__get_addr
($head, 'From'), # std
313 __get_addr
($head, 'Envelope-Sender'), # qmail: new-inject(1)
314 __get_addr
($head, 'Resent-Sender'), # procmailrc manpage
315 __get_addr
($head, 'X-Envelope-From'), # procmailrc manpage
316 __get_addr
($head, 'EnvelopeFrom')); # SMTP envelope
319 # Remove duplicate addresses
320 my %addrs = map { $_ => 1 } @addrs;
321 @addrs = keys %addrs;
327 my ($self, $queue, $entity, $msginfo) = @_;
329 my $maxspamsize = $msginfo->{maxspamsize
};
331 $maxspamsize = 200*1024 if !$maxspamsize;
333 my ($sa_score, $sa_max, $sa_scores, $sa_sumary, $list, $autolearn, $bayes, $loglist);
336 $bayes = 'undefined';
341 # do not run SA if license is not valid
342 if (!$queue->{lic_valid
}) {
343 $queue->{sa_score
} = 0;
347 my $fromhash = { $queue->{from
} => 1 };
348 foreach my $f (__all_from_addrs
($entity->head())) {
351 $queue->{all_from_addrs
} = [ keys %$fromhash ];
353 if (my $hit = $queue->{clamav_heuristic
}) {
354 my $score = $queue->{clamav_heuristic_score
};
355 my $descr = "ClamAV heuristic test: $hit";
356 my $rule = 'ClamAVHeuristics';
358 $list .= $list ?
",$rule" : $rule;
359 $loglist .= $loglist ?
",$rule($score)" : "$rule($score)";
360 push @$sa_scores, { score
=> $score, rule
=> $rule, desc
=> $descr };
363 if (my $hit = $queue->{spam_custom
}) {
364 my $score += $queue->{spam_custom
};
365 my $descr = "Custom Check Script";
366 my $rule = 'CustomCheck';
368 $list .= $list ?
",$rule" : $rule;
369 $list .= $list ?
",$rule" : $rule;
370 $loglist .= $loglist ?
",$rule($score)" : "$rule($score)";
371 push @$sa_scores, { score
=> $score, rule
=> $rule, desc
=> $descr };
374 my ($csec, $usec) = gettimeofday
();
376 my $spamtest = $queue->{sa
};
378 # only run SA in testmode or when clamav_heuristic did not confirm spam (score < 5)
379 if ($msginfo->{testmode
} || ($sa_score < 5)) {
381 # save and disable alarm (SA forgets to clear alarm in some cases)
382 my $previous_alarm = alarm (0);
387 $queue->{fh
}->seek(0, 0);
389 # Truncate message to $maxspamsize
390 # Note: similar code to read content is used inside
391 # Mail::SpamAssassin::Message->new()
394 while ($nread = sysread($queue->{fh
}, $raw_str, 16384, length($raw_str))) {
395 last if length($raw_str) >= $maxspamsize;
397 defined($nread) || die "error reading message: $!\n";
399 my $suppl_attrib = {};
400 if (length($raw_str) >= $maxspamsize &&
401 length($raw_str) < $queue->{bytes
}) {
402 $suppl_attrib->{body_size
} = $queue->{bytes
};
405 my @message = split(/^/m, $raw_str, -1);
406 undef $raw_str; # free memory early
408 my $mail = $spamtest->parse(\
@message, 0, $suppl_attrib);
410 # hack: pass envelope sender to spamassassin
411 $mail->header('X-Proxmox-Envelope-From', $queue->{from
});
413 my $status = $spamtest->check($mail);
415 #my $fromhash = { $queue->{from} => 1 };
416 #foreach my $f ($status->all_from_addrs()) {
417 #$fromhash->{$f} = 1;
419 #$queue->{all_from_addrs} = [ keys %$fromhash ];
421 $sa_score += $status->get_score();
422 $sa_max = $status->get_required_score();
423 $autolearn = $status->get_autolearn_status();
425 $bayes = defined($status->{bayes_score
}) ?
426 sprintf('%0.2f', $status->{bayes_score
}) : "undefined";
428 my $salist = $status->get_names_of_tests_hit();
430 foreach my $rule (split (/,/, $salist)) {
431 $list .= $list ?
",$rule" : $rule;
432 my $score = $status->{conf
}->{scores
}->{$rule};
433 $loglist .= $loglist ?
",$rule($score)" : "$rule($score)";
434 my $desc = $status->{conf
}->get_description_for_rule($rule);
435 if (my $hits = $status->{uridnsbl_hits
}->{$rule}) {
436 $desc .= ' [' . join(',', keys %$hits) . ']';
438 push @$sa_scores, { score
=> $score, rule
=> $rule, desc
=> $desc };
444 alarm 0; # avoid race conditions
448 alarm ($previous_alarm);
450 # just to be sure - exit if SA produces a child process
452 syslog
('err', "WARNING: detected SA produced process - exiting");
453 POSIX
::_exit
(-1); # exit immediately
458 $queue->{errors
} = 1;
462 $sa_score = int ($sa_score);
463 $sa_score = 0 if $sa_score < 0;
465 my ($csec_end, $usec_end) = gettimeofday
();
466 $queue->{ptime_spam
} =
467 int (($csec_end-$csec)*1000 + ($usec_end - $usec)/1000);
469 syslog
('info', "%s: SA score=%s/%s time=%0.3f bayes=%s autolearn=%s hits=%s",
470 $queue->{logid
}, $sa_score, $sa_max, $queue->{ptime_spam
}/1000.0,
471 $bayes, $autolearn, $loglist);
473 $queue->{sa_score
} = $sa_score;
474 $queue->{sa_max
} = $sa_max;
475 $queue->{sa_data
} = $sa_scores;
476 $queue->{sa_hits
} = $list;
478 return ($sa_score >= $sa_max);
486 description
=> "Spam Level",
496 return { spamlevel
=> $self->{level
} };
500 my ($self, $param) = @_;
502 $self->{level
} = $param->{spamlevel
};
509 =head1 PVE::RuleDB::Spam