]>
git.proxmox.com Git - pmg-api.git/blob - src/PMG/RuleDB/Spam.pm
97a80b3cd978a385cc1edf717c94694f672f0fa5
1 package PMG
::RuleDB
::Spam
;
7 use Time
::HiRes qw
(gettimeofday
);
10 use Mail
::SpamAssassin
;
13 use PMG
::RuleDB
::Object
;
15 use base
qw(PMG::RuleDB::Object);
30 my ($type, $level, $ogroup) = @_;
32 my $class = ref($type) || $type;
34 my $self = $class->SUPER::new
($class->otype(), $ogroup);
36 $level = 5 if !defined ($level);
38 $self->{level
} = $level;
44 my ($type, $ruledb, $id, $ogroup, $value) = @_;
46 my $class = ref($type) || $type;
48 defined($value) || die "undefined value: ERROR";
50 my $obj = $class->new($value, $ogroup);
53 $obj->{digest
} = Digest
::SHA
::sha1_hex
($id, $value, $ogroup);
59 my ($self, $ruledb) = @_;
61 defined($self->{ogroup
}) || die "undefined ogroup: ERROR";
62 defined($self->{level
}) || die "undefined spam level: ERROR";
64 if (defined ($self->{id
})) {
68 "UPDATE Object SET Value = ? WHERE ID = ?",
69 undef, $self->{level
}, $self->{id
});
74 my $sth = $ruledb->{dbh
}->prepare(
75 "INSERT INTO Object (Objectgroup_ID, ObjectType, Value) " .
78 $sth->execute($self->ogroup, $self->otype, $self->{level
});
80 $self->{id
} = PMG
::Utils
::lastid
($ruledb->{dbh
}, 'object_id_seq');
91 foreach my $addr (split ('\s*,\s*', $list)) {
95 $regex =~ s/[\000\\\(]/_/gs; # is this really necessasry ?
96 $regex =~ s/([^\*\?_a-zA-Z0-9])/\\$1/g; # escape possible metachars
97 $regex =~ tr/?/./; # replace "?" with "."
98 $regex =~ s/\*+/\.\*/g; # replace "*" with ".*"
100 # we use a hash for extra fast testing
101 $adlist->{$addr} = "^${regex}\$";
108 my ($list, $addrlst) = @_;
110 foreach my $addr (@$addrlst) {
114 return 1 if defined ($list->{$addr});
118 foreach my $r (values %{$list}) {
119 if ($addr =~ qr/$r/i) {
129 my ($dbh, $entity, $msginfo) = @_;
131 my $target_info = {};
133 my $targets = $msginfo->{targets
};
136 foreach my $r (@$targets) {
137 my $pmail = $msginfo->{pmail
}->{$r} || lc ($r);
138 my $qr = $dbh->quote ($pmail);
139 $cond .= " OR " if $cond;
140 $cond .= "pmail = $qr";
144 my $query = "SELECT * FROM UserPrefs WHERE " .
145 "($cond) AND (Name = 'BL' OR Name = 'WL')";
146 my $sth = $dbh->prepare($query);
150 while (my $ref = $sth->fetchrow_hashref()) {
151 my $pmail = lc ($ref->{pmail
});
152 if ($ref->{name
} eq 'WL') {
153 $target_info->{$pmail}->{whitelist
} =
154 parse_addrlist
($ref->{data
});
155 } elsif ($ref->{name
} eq 'BL') {
156 $target_info->{$pmail}->{blacklist
} =
157 parse_addrlist
($ref->{data
});
170 sub what_match_targets
{
171 my ($self, $queue, $entity, $msginfo, $dbh) = @_;
175 if (!$queue->{spam_analyzed
}) {
176 $self->analyze_spam($queue, $entity, $msginfo);
177 $queue->{blackwhite
} = get_blackwhite
($dbh, $entity, $msginfo);
178 $queue->{spam_analyzed
} = 1;
181 if ($msginfo->{testmode
}) {
182 $queue->{sa_score
} = 100 if $queue->{sa_score
} > 100;
184 foreach my $s (@{$queue->{sa_data
}}) {
185 next if $s->{rule
} eq 'AWL';
188 $queue->{sa_data
} = $data;
191 if (defined($queue->{sa_score
}) && $queue->{sa_score
} >= $self->{level
}) {
194 sa_score
=> $queue->{sa_score
},
195 sa_max
=> $self->{level
},
196 sa_data
=> $queue->{sa_data
},
197 sa_hits
=> $queue->{sa_hits
}
200 foreach my $t (@{$msginfo->{targets
}}) {
202 my $pmail = $msginfo->{pmail
}->{$t} || $t;
203 if ($queue->{blackwhite
}->{$pmail} &&
204 ($list = $queue->{blackwhite
}->{$pmail}->{whitelist
}) &&
205 check_addrlist
($list, $queue->{all_from_addrs
})) {
206 syslog
('info', "%s: sender in user (%s) whitelist",
207 $queue->{logid
}, $pmail);
209 $target_info->{$t}->{marks
} = []; # never add additional marks here
210 $target_info->{$t}->{spaminfo
} = $info;
216 foreach my $t (@{$msginfo->{targets
}}) {
219 sa_max
=> $self->{level
},
221 rule
=> 'USER_IN_BLACKLIST',
223 desc
=> 'From: address is in the user black-list',
225 sa_hits
=> 'USER_IN_BLACKLIST',
229 my $pmail = $msginfo->{pmail
}->{$t} || $t;
230 if ($queue->{blackwhite
}->{$pmail} &&
231 ($list = $queue->{blackwhite
}->{$pmail}->{blacklist
}) &&
232 check_addrlist
($list, $queue->{all_from_addrs
})) {
233 $target_info->{$t}->{marks
} = [];
234 $target_info->{$t}->{spaminfo
} = $info;
235 syslog
('info', "%s: sender in user (%s) blacklist",
236 $queue->{logid
}, $pmail);
257 return "Level $self->{level}";
261 my ($head, $name) = @_;
263 my $result = $head->get($name);
265 return '' if !$result;
267 # copied from Mail::Spamassassin:PerMsgStatus _get()
269 $result =~ s/^[^:]+:(.*);\s*$/$1/gs; # 'undisclosed-recipients: ;'
270 $result =~ s/\s+/ /g; # reduce whitespace
271 $result =~ s/^\s+//; # leading whitespace
272 $result =~ s/\s+$//; # trailing whitespace
274 # Get the email address out of the header
275 # All of these should result in "jm@foo":
279 # display: jm@foo (Foo Blah), jm@bar ;
281 # "Foo Blah" <jm@foo>
282 # "'Foo Blah'" <jm@foo>
284 # strip out the (comments)
285 $result =~ s/\s*\(.*?\)//g;
286 # strip out the "quoted text", unless it's the only thing in the string
287 if ($result !~ /^".*"$/) {
288 $result =~ s/(?<!<)"[^"]*"(?!@)//g; #" emacs
290 # Foo Blah <jm@xxx> or <jm@xxx>
291 $result =~ s/^[^"<]*?<(.*?)>.*$/$1/;
292 # multiple addresses on one line? remove all but first
298 # implement our own all_from_addrs()
299 # because we do not call spamassassin in canes of commtouch match
300 # see Mail::Spamassassin:PerMsgStatus for details
301 sub __all_from_addrs
{
306 my $resent = $head->get('Resent-From');
307 if (defined($resent) && $resent =~ /\S/) {
308 @addrs = Mail
::SpamAssassin-
>find_all_addrs_in_line($resent);
310 @addrs = map { tr/././s; $_ } grep { $_ ne '' }
311 (__get_addr
($head, 'From'), # std
312 __get_addr
($head, 'Envelope-Sender'), # qmail: new-inject(1)
313 __get_addr
($head, 'Resent-Sender'), # procmailrc manpage
314 __get_addr
($head, 'X-Envelope-From'), # procmailrc manpage
315 __get_addr
($head, 'EnvelopeFrom')); # SMTP envelope
318 # Remove duplicate addresses
319 my %addrs = map { $_ => 1 } @addrs;
320 @addrs = keys %addrs;
326 my ($self, $queue, $entity, $msginfo) = @_;
328 my $maxspamsize = $msginfo->{maxspamsize
};
330 $maxspamsize = 200*1024 if !$maxspamsize;
332 my ($sa_score, $sa_max, $sa_scores, $sa_sumary, $list, $autolearn, $bayes, $loglist);
335 $bayes = 'undefined';
340 # do not run SA if license is not valid
341 if (!$queue->{lic_valid
}) {
342 $queue->{sa_score
} = 0;
346 my $fromhash = { $queue->{from
} => 1 };
347 foreach my $f (__all_from_addrs
($entity->head())) {
350 $queue->{all_from_addrs
} = [ keys %$fromhash ];
352 if (my $hit = $queue->{clamav_heuristic
}) {
353 my $score = $queue->{clamav_heuristic_score
};
354 my $descr = "ClamAV heuristic test: $hit";
355 my $rule = 'ClamAVHeuristics';
357 $list .= $list ?
",$rule" : $rule;
358 $loglist .= $loglist ?
",$rule($score)" : "$rule($score)";
359 push @$sa_scores, { score
=> $score, rule
=> $rule, desc
=> $descr };
362 if (my $hit = $queue->{spam_custom
}) {
363 my $score += $queue->{spam_custom
};
364 my $descr = "Custom Check Script";
365 my $rule = 'CustomCheck';
367 $list .= $list ?
",$rule" : $rule;
368 $list .= $list ?
",$rule" : $rule;
369 $loglist .= $loglist ?
",$rule($score)" : "$rule($score)";
370 push @$sa_scores, { score
=> $score, rule
=> $rule, desc
=> $descr };
373 my ($csec, $usec) = gettimeofday
();
375 my $spamtest = $queue->{sa
};
377 # only run SA in testmode or when clamav_heuristic did not confirm spam (score < 5)
378 if ($msginfo->{testmode
} || ($sa_score < 5)) {
380 # save and disable alarm (SA forgets to clear alarm in some cases)
381 my $previous_alarm = alarm (0);
386 $queue->{fh
}->seek(0, 0);
388 # Truncate message to $maxspamsize
389 # Note: similar code to read content is used inside
390 # Mail::SpamAssassin::Message->new()
393 while ($nread = sysread($queue->{fh
}, $raw_str, 16384, length($raw_str))) {
394 last if length($raw_str) >= $maxspamsize;
396 defined($nread) || die "error reading message: $!\n";
398 my $suppl_attrib = {};
399 if (length($raw_str) >= $maxspamsize &&
400 length($raw_str) < $queue->{bytes
}) {
401 $suppl_attrib->{body_size
} = $queue->{bytes
};
404 my @message = split(/^/m, $raw_str, -1);
405 undef $raw_str; # free memory early
407 my $mail = $spamtest->parse(\
@message, 0, $suppl_attrib);
409 # hack: pass envelope sender to spamassassin
410 $mail->header('X-Proxmox-Envelope-From', $queue->{from
});
412 my $status = $spamtest->check($mail);
414 #my $fromhash = { $queue->{from} => 1 };
415 #foreach my $f ($status->all_from_addrs()) {
416 #$fromhash->{$f} = 1;
418 #$queue->{all_from_addrs} = [ keys %$fromhash ];
420 $sa_score += $status->get_score();
421 $sa_max = $status->get_required_score();
422 $autolearn = $status->get_autolearn_status();
424 $bayes = defined($status->{bayes_score
}) ?
425 sprintf('%0.2f', $status->{bayes_score
}) : "undefined";
427 my $salist = $status->get_names_of_tests_hit();
429 foreach my $rule (split (/,/, $salist)) {
430 $list .= $list ?
",$rule" : $rule;
431 my $score = $status->{conf
}->{scores
}->{$rule};
432 $loglist .= $loglist ?
",$rule($score)" : "$rule($score)";
433 my $desc = $status->{conf
}->get_description_for_rule($rule);
434 push @$sa_scores, { score
=> $score, rule
=> $rule, desc
=> $desc };
440 alarm 0; # avoid race conditions
444 alarm ($previous_alarm);
446 # just to be sure - exit if SA produces a child process
448 syslog
('err', "WARNING: detected SA produced process - exiting");
449 POSIX
::_exit
(-1); # exit immediately
454 $queue->{errors
} = 1;
458 $sa_score = int ($sa_score);
459 $sa_score = 0 if $sa_score < 0;
461 my ($csec_end, $usec_end) = gettimeofday
();
462 $queue->{ptime_spam
} =
463 int (($csec_end-$csec)*1000 + ($usec_end - $usec)/1000);
465 syslog
('info', "%s: SA score=%s/%s time=%0.3f bayes=%s autolearn=%s hits=%s",
466 $queue->{logid
}, $sa_score, $sa_max, $queue->{ptime_spam
}/1000.0,
467 $bayes, $autolearn, $loglist);
469 $queue->{sa_score
} = $sa_score;
470 $queue->{sa_max
} = $sa_max;
471 $queue->{sa_data
} = $sa_scores;
472 $queue->{sa_hits
} = $list;
474 return ($sa_score >= $sa_max);
482 description
=> "Spam Level",
492 return { spamlevel
=> $self->{level
} };
496 my ($self, $param) = @_;
498 $self->{level
} = $param->{spamlevel
};
505 =head1 PVE::RuleDB::Spam