239
248
If set to 1, no tests that require internet access will be performed. (default:
253
The option provides a way to avoid more expensive processing when it is known
254
in advance that some information will not be needed by a caller.
256
A value of the option can either be a string (a comma-delimited list of tag
257
names), or a reference to a list of individual tag names. A caller may provide
258
the list in advance, specifying his intention to later collect the information
259
through $pms->get_tag() calls. If a name of a tag starts with a 'NO' (case
260
insensitive), it shows that a caller will not be interested in such tag,
261
although there is no guarantee it would save any resources, nor that a tag
262
value will be empty. Currently no built-in tags start with 'NO'. A later
263
entry overrides previous one, e.g. ASN,NOASN,ASN,TIMING,NOASN is equivalent
266
For backwards compatibility, all tags available as of version 3.2.4 will
267
be available by default (unless disabled by NOtag), even if not requested
268
through need_tags option. Future versions may provide new tags conditionally
271
Currently the only tag that needs to be explicitly requested is 'TIMING'.
272
Not requesting it can save a millisecond or two - it mostly serves to
273
illustrate the usage of need_tags.
276
need_tags => 'TIMING,noLANGUAGES,RELAYCOUNTRY,ASN,noASNCIDR',
278
need_tags => [qw(TIMING noLANGUAGES RELAYCOUNTRY ASN noASNCIDR)],
242
280
=item ignore_site_cf_files
244
282
If set to 1, any rule files found in the C<site_rules_filename> directory will
337
375
$self->{DEF_RULES_DIR} ||= '@@DEF_RULES_DIR@@';
338
376
$self->{LOCAL_RULES_DIR} ||= '@@LOCAL_RULES_DIR@@';
339
377
$self->{LOCAL_STATE_DIR} ||= '@@LOCAL_STATE_DIR@@';
378
dbg("generic: Perl %s, %s", $], join(", ", map { $_ . '=' . $self->{$_} }
379
qw(PREFIX DEF_RULES_DIR LOCAL_RULES_DIR LOCAL_STATE_DIR)));
381
$self->{needed_tags} = {};
382
{ my $ntags = $self->{need_tags};
383
if (defined $ntags) {
384
for my $t (ref $ntags ? @$ntags : split(/[, \s]+/,$ntags)) {
385
$self->{needed_tags}->{$2} = !defined($1) if $t =~ /^(NO)?(.+)\z/si;
389
if (would_log('dbg','timing') || $self->{needed_tags}->{TIMING}) {
390
$self->timer_enable();
341
393
$self->{conf} ||= new Mail::SpamAssassin::Conf ($self);
342
394
$self->{plugins} = Mail::SpamAssassin::PluginHandler->new ($self);
406
462
needs the pristine header and body which is always parsed and stored
407
463
by this function.
465
The optional last argument I<$suppl_attrib> provides a way for a caller
466
to pass additional information about a message to SpamAssassin. It is
467
either undef, or a ref to a hash where each key/value pair provides some
468
supplementary attribute of the message, typically information that cannot
469
be deduced from the message itself, or is hard to do so reliably, or would
470
represent unnecessary work for SpamAssassin to obtain it. The argument will
471
be stored to a Mail::SpamAssassin::Message object as 'suppl_attrib', thus
472
made available to the rest of the code as well as to plugins. The exact list
473
of attributes will evolve through time, any unknown attribute should be
474
ignored. Possible examples are: SMTP envelope information, a flag indicating
475
that a message as supplied by a caller was truncated due to size limit, an
476
already verified list of DKIM signature objects, or perhaps a list of rule
477
hits predetermined by a caller, which makes another possible way for a
478
caller to provide meta information (instead of having to insert made-up
479
header fields in order to pass information), or maybe just plain rule hits.
409
481
For more information, please see the C<Mail::SpamAssassin::Message>
410
482
and C<Mail::SpamAssassin::Message::Node> POD.
415
my($self, $message, $parsenow) = @_;
487
my($self, $message, $parsenow, $suppl_attrib) = @_;
489
my $start_time = time;
417
my $msg = Mail::SpamAssassin::Message->new({message=>$message, parsenow=>$parsenow, normalize=>$self->{conf}->{normalize_charset}});
491
my $timer = $self->time_method("parse");
493
my $msg = Mail::SpamAssassin::Message->new({
494
message=>$message, parsenow=>$parsenow,
495
normalize=>$self->{conf}->{normalize_charset},
496
suppl_attrib=>$suppl_attrib });
498
if (ref $suppl_attrib && exists $suppl_attrib->{master_deadline}) {
499
$msg->{master_deadline} = $suppl_attrib->{master_deadline}; # may be undef
500
} elsif ($self->{conf}->{time_limit}) { # defined and nonzero
501
$msg->{master_deadline} = $start_time + $self->{conf}->{time_limit};
503
if (defined $msg->{master_deadline}) {
504
dbg("config: time limit %.1f s", $msg->{master_deadline} - $start_time);
419
507
# bug 5069: The goal here is to get rendering plugins to do things
420
508
# like OCR, convert doc and pdf to text, etc, though it could be anything
811
903
###########################################################################
813
=item $f->add_address_to_whitelist ($addr)
905
=item $f->add_address_to_whitelist ($addr, $cli_p)
815
907
Given a string containing an email address, add it to the automatic
816
908
whitelist database.
910
If $cli_p is set then underlying plugin may give visual feedback on additions/failures.
820
914
sub add_address_to_whitelist {
821
my ($self, $addr) = @_;
915
my ($self, $addr, $cli_p) = @_;
823
$self->call_plugins("whitelist_address", { address => $addr });
917
$self->call_plugins("whitelist_address", { address => $addr,
826
921
###########################################################################
828
=item $f->add_all_addresses_to_whitelist ($mail)
923
=item $f->add_all_addresses_to_whitelist ($mail, $cli_p)
830
925
Given a mail message, find as many addresses in the usual headers (To, Cc, From
831
926
etc.), and the message body, and add them to the automatic whitelist database.
928
If $cli_p is set then underlying plugin may give visual feedback on additions/failures.
835
932
sub add_all_addresses_to_whitelist {
836
my ($self, $mail_obj) = @_;
933
my ($self, $mail_obj, $cli_p) = @_;
838
935
foreach my $addr ($self->find_all_addrs_in_mail ($mail_obj)) {
839
$self->call_plugins("whitelist_address", { address => $addr });
936
$self->call_plugins("whitelist_address", { address => $addr,
843
941
###########################################################################
845
=item $f->remove_address_from_whitelist ($addr)
943
=item $f->remove_address_from_whitelist ($addr, $cli_p)
847
945
Given a string containing an email address, remove it from the automatic
848
946
whitelist database.
948
If $cli_p is set then underlying plugin may give visual feedback on additions/failures.
852
952
sub remove_address_from_whitelist {
853
my ($self, $addr) = @_;
953
my ($self, $addr, $cli_p) = @_;
855
$self->call_plugins("remove_address", { address => $addr });
955
$self->call_plugins("remove_address", { address => $addr,
858
959
###########################################################################
860
=item $f->remove_all_addresses_from_whitelist ($mail)
961
=item $f->remove_all_addresses_from_whitelist ($mail, $cli_p)
862
963
Given a mail message, find as many addresses in the usual headers (To, Cc, From
863
964
etc.), and the message body, and remove them from the automatic whitelist
967
If $cli_p is set then underlying plugin may give visual feedback on additions/failures.
868
971
sub remove_all_addresses_from_whitelist {
869
my ($self, $mail_obj) = @_;
972
my ($self, $mail_obj, $cli_p) = @_;
871
974
foreach my $addr ($self->find_all_addrs_in_mail ($mail_obj)) {
872
$self->call_plugins("remove_address", { address => $addr });
975
$self->call_plugins("remove_address", { address => $addr,
876
980
###########################################################################
878
=item $f->add_address_to_blacklist ($addr)
982
=item $f->add_address_to_blacklist ($addr, $cli_p)
880
984
Given a string containing an email address, add it to the automatic
881
985
whitelist database with a high score, effectively blacklisting them.
987
If $cli_p is set then underlying plugin may give visual feedback on additions/failures.
885
991
sub add_address_to_blacklist {
886
my ($self, $addr) = @_;
887
$self->call_plugins("blacklist_address", { address => $addr });
992
my ($self, $addr, $cli_p) = @_;
993
$self->call_plugins("blacklist_address", { address => $addr,
890
997
###########################################################################
892
=item $f->add_all_addresses_to_blacklist ($mail)
999
=item $f->add_all_addresses_to_blacklist ($mail, $cli_p)
894
1001
Given a mail message, find addresses in the From headers and add them to the
895
1002
automatic whitelist database with a high score, effectively blacklisting them.
897
1004
Note that To and Cc addresses are not used.
1006
If $cli_p is set then underlying plugin may give visual feedback on additions/failures.
901
1010
sub add_all_addresses_to_blacklist {
902
my ($self, $mail_obj) = @_;
1011
my ($self, $mail_obj, $cli_p) = @_;
907
my @hdrs = $mail_obj->get_header ('From');
1016
my @hdrs = $mail_obj->get_header('From');
908
1017
if ($#hdrs >= 0) {
909
1018
push (@addrlist, $self->find_all_addrs_in_line (join (" ", @hdrs)));
912
1021
foreach my $addr (@addrlist) {
913
$self->call_plugins("blacklist_address", { address => $addr });
1022
$self->call_plugins("blacklist_address", { address => $addr,
1087
1198
sub read_scoreonly_config {
1088
1199
my ($self, $filename) = @_;
1201
my $timer = $self->time_method("read_scoreonly_config");
1090
1203
if (!open(IN,"<$filename")) {
1091
1204
# the file may not exist; this should not be verbose
1092
1205
dbg("config: read_scoreonly_config: cannot open \"$filename\": $!");
1096
my $text = "file start $filename\n"
1098
# add an extra \n in case file did not end in one.
1099
. "\nfile end $filename\n";
1209
my($inbuf,$nread,$text); $text = '';
1210
while ( $nread=read(IN,$inbuf,16384) ) { $text .= $inbuf }
1211
defined $nread or die "error reading $filename: $!";
1212
close IN or die "error closing $filename: $!";
1215
$text = "file start $filename\n" . $text;
1216
# add an extra \n in case file did not end in one.
1217
$text .= "\nfile end $filename\n";
1103
1219
$self->{conf}->{main} = $self;
1104
1220
$self->{conf}->parse_scores_only ($text);
1202
1320
sub compile_now {
1203
1321
my ($self, $use_user_prefs, $deal_with_userstate) = @_;
1205
# tell plugins we are here
1206
$self->call_plugins("compile_now_start",
1207
{ use_user_prefs => $use_user_prefs,
1208
keep_userstate => $deal_with_userstate});
1210
# note: this may incur network access. Good. We want to make sure
1211
# as much as possible is preloaded!
1212
my @testmsg = ("From: ignore\@compiling.spamassassin.taint.org\n",
1213
"Message-Id: <".time."\@spamassassin_spamd_init>\n", "\n",
1214
"I need to make this message body somewhat long so TextCat preloads\n"x20);
1216
dbg("ignore: test message to precompile patterns and load modules");
1323
my $timer = $self->time_method("compile_now");
1218
1325
# Backup default values which deal with userstate.
1219
1326
# This is done so we can create any new files in, presumably, a temp dir.
1220
1327
# see bug 2762 for more details.
1222
1329
if (defined $deal_with_userstate && $deal_with_userstate) {
1223
1330
while(my($k,$v) = each %{$self->{conf}}) {
1224
1331
$backup{$k} = $v if (defined $v && !ref($v) && $v =~/__userstate__/);
1243
my $mail = $self->parse(\@testmsg, 1);
1350
dbg("ignore: test message to precompile patterns and load modules");
1352
# tell plugins we are about to send a message for compiling purposes
1353
$self->call_plugins("compile_now_start",
1354
{ use_user_prefs => $use_user_prefs,
1355
keep_userstate => $deal_with_userstate});
1357
# note: this may incur network access. Good. We want to make sure
1358
# as much as possible is preloaded!
1359
my @testmsg = ("From: ignore\@compiling.spamassassin.taint.org\n",
1360
"Message-Id: <".time."\@spamassassin_spamd_init>\n", "\n",
1361
"I need to make this message body somewhat long so TextCat preloads\n"x20);
1363
my $mail = $self->parse(\@testmsg, 1, { master_deadline => undef });
1244
1364
my $status = Mail::SpamAssassin::PerMsgStatus->new($self, $mail,
1245
1365
{ disable_auto_learning => 1 } );
1374
1495
$self->{resolver}->finish();
1497
$self->timer_end("finish");
1379
1501
###########################################################################
1506
dbg("config: timing enabled") if !$self->{timer_enabled};
1507
$self->{timer_enabled} = 1;
1512
dbg("config: timing disabled") if $self->{timer_enabled};
1513
$self->{timer_enabled} = 0;
1516
# discard all timers, start afresh
1519
delete $self->{timers};
1520
delete $self->{timers_order};
1524
my ($self, $name) = @_;
1526
return unless $self->{timer_enabled};
1527
# dbg("timing: '$name' starting");
1529
if (!exists $self->{timers}->{$name}) {
1530
push @{$self->{timers_order}}, $name;
1533
$self->{timers}->{$name}->{start} = Time::HiRes::time();
1534
# note that this will reset any existing, unstopped timer of that name;
1539
my ($self, $name) = @_;
1540
return unless $self->{timer_enabled};
1542
my $t = $self->{timers}->{$name};
1546
warn "timer_end('$name') with no timer_start";
1550
# add to any existing elapsed time for this event, since
1551
# we may call the same timer name multiple times -- this is ok,
1552
# as long as they are not nested
1553
my $dt = $t->{end} - $t->{start};
1554
$dt = 0 if $dt < 0; # tolerate clock jumps, just in case
1555
if (defined $t->{elapsed}) { $t->{elapsed} += $dt }
1556
else { $t->{elapsed} = $dt }
1560
my ($self, $name) = @_;
1561
return unless $self->{timer_enabled};
1562
return Mail::SpamAssassin::Util::ScopedTimer->new($self, $name);
1571
while (my($name,$h) = each(%{$self->{timers}})) {
1572
# dbg("timing: %s - %s", $name, join(", ",
1573
# map { sprintf("%s => %s", $_, $h->{$_}) } keys(%$h)));
1574
my $start = $h->{start};
1575
if (defined $start && (!defined $earliest || $earliest > $start)) {
1578
my $end = $h->{end};
1579
if (defined $end && (!defined $latest || $latest < $end)) {
1582
dbg("timing: start but no end: $name") if defined $start && !defined $end;
1585
(!defined $latest || !defined $earliest) ? 0 : $latest - $earliest;
1587
foreach my $name (@{$self->{timers_order}}) {
1588
my $elapsed = $self->{timers}->{$name}->{elapsed} || 0;
1589
my $pc = $total <= 0 || $elapsed >= $total ? 100 : ($elapsed/$total)*100;
1590
my $fmt = $elapsed >= 0.002 ? "%.0f" : "%.2f";
1591
push @str, sprintf("%s: $fmt (%.1f%%)", $name, $elapsed*1000, $pc);
1594
return sprintf("total %.0f ms - %s", $total*1000, join(", ", @str));
1597
###########################################################################
1380
1598
# non-public methods.
1462
$self->{config_text} .= $self->{post_config_text} if ($self->{post_config_text});
1692
if ($self->{pre_config_text}) {
1693
$self->{config_text} = $self->{pre_config_text} . $self->{config_text};
1695
if ($self->{post_config_text}) {
1696
$self->{config_text} .= $self->{post_config_text};
1464
1699
if ($self->{config_text} !~ /\S/) {
1465
warn "config: no configuration text or files found! please check your setup\n";
1700
my $m = "config: no configuration text or files found! do you need to run 'sa-update'?\n";
1701
if ($self->{require_rules}) {
1468
1708
# Go and parse the config!
1469
1709
$self->{conf}->{main} = $self;
1710
if (would_log('dbg', 'config_text') > 1) {
1711
dbg('config_text: '.$self->{config_text});
1470
1713
$self->{conf}->parse_rules ($self->{config_text});
1471
1714
$self->{conf}->finish_parsing(0);
1472
1715
delete $self->{conf}->{main}; # to allow future GC'ing
1574
1840
dbg("config: using \"$fname\" for user state dir");
1578
# not being able to create the *dir* is not worth a warning at all times
1579
eval { mkpath($fname, 0, 0700) } or dbg("config: mkdir $fname failed: $@ $!\n");
1843
# if this is not a dir, not readable, or we are unable to create the dir,
1844
# this is not (yet) a serious error; in fact, it's not even worth
1845
# a warning at all times, so use dbg(). see bug 6268
1846
my $stat_errn = stat($fname) ? 0 : 0+$!;
1847
if ($stat_errn == 0 && !-d _) {
1848
dbg("config: $fname exists but is not a directory");
1849
} elsif ($stat_errn != 0 && $stat_errn != ENOENT) {
1850
dbg("config: error accessing $fname: $!");
1851
} else { # does not exist, create it
1853
mkpath($fname, 0, 0700); 1;
1855
my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
1856
dbg("config: mkdir $fname failed: $eval_stat");
1625
1899
# warn "config: hooray! user_dirs don't match! '$userdir' vs '$self->{user_dir}'\n";
1902
my $stat_errn = stat($fname) ? 0 : 0+$!;
1903
if ($stat_errn == 0) {
1904
# fine, it already exists
1905
} elsif ($stat_errn != ENOENT) {
1906
dbg("config: cannot access user preferences file $fname: $!");
1630
1908
# Pass on the value of $userdir for virtual users in vpopmail
1631
1909
# otherwise it is empty and the user's normal homedir is used
1632
1910
$self->get_and_create_userstate_dir($userdir);
1634
1912
# copy in the default one for later editing
1635
my $defprefs = $self->first_existing_path (@Mail::SpamAssassin::default_prefs_path);
1637
if (defined $defprefs && open (IN, "<$defprefs")) {
1638
$fname = Mail::SpamAssassin::Util::untaint_file_path($fname);
1639
if (open (OUT, ">$fname")) {
1647
if (($< == 0) && ($> == 0) && defined($user)) { # chown it
1648
my ($uid,$gid) = (getpwnam($user))[2,3];
1649
unless (chown($uid, $gid, $fname)) {
1650
warn "config: couldn't chown $fname to $uid:$gid for $user: $!\n";
1653
warn "config: created user preferences file: $fname\n";
1657
warn "config: cannot write to $fname: $!\n";
1660
elsif (defined $defprefs) {
1914
$self->first_existing_path(@Mail::SpamAssassin::default_prefs_path);
1917
$fname = Mail::SpamAssassin::Util::untaint_file_path($fname);
1918
if (!defined $defprefs) {
1919
warn "config: can not determine default prefs path\n";
1920
} elsif (!open(IN, "<$defprefs")) {
1661
1921
warn "config: cannot open $defprefs: $!\n";
1664
warn "config: can not determine default prefs path\n";
1922
} elsif (!open(OUT, ">$fname")) {
1923
warn "config: cannot create user preferences file $fname: $!\n";
1925
# former code skipped lines beginning with '#* ', the following copy
1926
# procedure no longer does so, as it avoids reading line-by-line
1928
while ( $nread=read(IN,$inbuf,16384) ) {
1929
print OUT $inbuf or die "cannot write to $fname: $!";
1931
defined $nread or die "error reading $defprefs: $!";
1933
close OUT or die "error closing $fname: $!";
1934
close IN or die "error closing $defprefs: $!";
1936
if (($< == 0) && ($> == 0) && defined($user)) { # chown it
1937
my ($uid,$gid) = (getpwnam($user))[2,3];
1938
unless (chown($uid, $gid, $fname)) {
1939
warn "config: couldn't chown $fname to $uid:$gid for $user: $!\n";
1942
warn "config: created user preferences file: $fname\n";
added
removed
lib/Mail/SpamAssassin.pm
