Mail-SpamAssassin
view release on metacpan or search on metacpan
lib/Mail/SpamAssassin.pm view on Meta::CPAN
# Used during the prerelease/release-candidate part of the official release
# process. If you hacked up your SA, you should add a version_tag to your .cf
# files; this variable should not be modified.
our @EXTRA_VERSION = qw();
our @ISA = qw();
# SUB_VERSION is now just <yyyy>-<mm>-<dd>
our $SUB_VERSION = 'svnunknown';
if ('$LastChangedDate: 2025-08-27 15:15:53 +0200 (Wed, 27 Aug 2025) $' =~ ':') {
# Subversion keyword "$LastChangedDate: 2025-08-27 15:15:53 +0200 (Wed, 27 Aug 2025) $" has been successfully expanded.
# Doesn't happen with automated launchpad builds:
# https://bugs.launchpad.net/launchpad/+bug/780916
$SUB_VERSION = (split(/\s+/,'$LastChangedDate: 2025-08-27 15:15:53 +0200 (Wed, 27 Aug 2025) $ updated by SVN'))[1];
}
if (defined $IS_DEVEL_BUILD && $IS_DEVEL_BUILD) {
if ('$LastChangedRevision: 1928046 $' =~ ':') {
# Subversion keyword "$LastChangedRevision: 1928046 $" has been successfully expanded.
push(@EXTRA_VERSION, ('r' . qw{$LastChangedRevision: 1928046 $ updated by SVN}[1]));
} else {
push(@EXTRA_VERSION, ('r' . 'svnunknown'));
}
}
sub Version {
$VERSION =~ /^(\d+)\.(\d\d\d)(\d\d\d)$/;
return join('-', sprintf("%d.%d.%d", $1, $2, $3), @EXTRA_VERSION);
}
our $HOME_URL = "https://spamassassin.apache.org/";
# note that the CWD takes priority. This is required in case a user
# is testing a new version of SpamAssassin on a machine with an older
# version installed. Unless you can come up with a fix for this that
# allows "make test" to work, don't change this.
our @default_rules_path = (
'./rules', # REMOVEFORINST
'../rules', # REMOVEFORINST
'__local_state_dir__/__version__',
'__def_rules_dir__',
'__prefix__/share/spamassassin',
'/usr/local/share/spamassassin',
'/usr/share/spamassassin',
);
# first 3 are BSDish, latter 2 Linuxish
our @site_rules_path = (
'__local_rules_dir__',
'__prefix__/etc/mail/spamassassin',
'__prefix__/etc/spamassassin',
'/usr/local/etc/spamassassin',
'/usr/pkg/etc/spamassassin',
'/usr/etc/spamassassin',
'/etc/mail/spamassassin',
'/etc/spamassassin',
);
our @default_prefs_path = (
'__local_rules_dir__/user_prefs.template',
'__prefix__/etc/mail/spamassassin/user_prefs.template',
'__prefix__/share/spamassassin/user_prefs.template',
'__local_state_dir__/__version__/updates_spamassassin_org/user_prefs.template',
'__def_rules_dir__/user_prefs.template',
'/etc/spamassassin/user_prefs.template',
'/etc/mail/spamassassin/user_prefs.template',
'/usr/local/share/spamassassin/user_prefs.template',
'/usr/share/spamassassin/user_prefs.template',
);
our @default_userprefs_path = (
'~/.spamassassin/user_prefs',
);
our @default_userstate_dir = (
'~/.spamassassin',
);
###########################################################################
=item $t = Mail::SpamAssassin-E<gt>new( { opt =E<gt> val, ... } )
Constructs a new C<Mail::SpamAssassin> object. You may pass a hash
reference to the constructor which may contain the following attribute-
value pairs.
=over 4
=item debug
This is the debug options used to determine logging level. It exists to
allow sections of debug messages (called "facilities") to be enabled or
disabled. If this is a string, it is treated as a comma-delimited list
of the debug facilities. If it's a hash reference, then the keys are
treated as the list of debug facilities and if it's a array reference,
then the elements are treated as the list of debug facilities.
There are also two special cases: (1) if the special case of "info" is
passed as a debug facility, then all informational messages are enabled;
(2) if the special case of "all" is passed as a debug facility, then all
debugging facilities are enabled.
=item rules_filename
The filename/directory to load spam-identifying rules from. (optional)
=item site_rules_filename
The filename/directory to load site-specific spam-identifying rules from.
(optional)
=item userprefs_filename
The filename to load preferences from. (optional)
=item userstate_dir
The directory user state is stored in. (optional)
=item config_tree_recurse
Set to C<1> to recurse through directories when reading configuration
files, instead of just reading a single level. (optional, default 0)
=item config_text
The text of all rules and preferences. If you prefer not to load the rules
from files, read them in yourself and set this instead. As a result, this will
override the settings for C<rules_filename>, C<site_rules_filename>,
and C<userprefs_filename>.
=item pre_config_text
Similar to C<config_text>, this text is placed before config_text to allow an
override of config files.
=item post_config_text
Similar to C<config_text>, this text is placed after config_text to allow an
override of config files.
=item force_ipv4
If set to 1, DNS or other network tests will prefer IPv4 and not attempt
to use IPv6. Use if the existing tests for IPv6 availability produce
incorrect results or crashes.
=item force_ipv6
For symmetry with force_ipv4: if set to 1, DNS or other network tests
will prefer IPv6 and not attempt to use IPv4. Some plugins may disregard
this setting and use whatever protocol family they are comfortable with.
=item require_rules
If set to 1, init() will die if no valid rules could be loaded. This is the
default behaviour when called by C<spamassassin> or C<spamd>.
=item languages_filename
If you want to be able to use the language-guessing rule
C<UNWANTED_LANGUAGE_BODY>, and are using C<config_text> instead of
C<rules_filename>, C<site_rules_filename>, and C<userprefs_filename>, you will
need to set this. It should be the path to the B<languages> file normally
found in the SpamAssassin B<rules> directory.
=item local_tests_only
If set to 1, no tests that require internet access will be performed. (default:
0)
=item need_tags
The option provides a way to avoid more expensive processing when it is known
in advance that some information will not be needed by a caller.
A value of the option can either be a string (a comma-delimited list of tag
names), or a reference to a list of individual tag names. A caller may provide
the list in advance, specifying his intention to later collect the information
through $pms-E<gt>get_tag() calls. If a name of a tag starts with a 'NO' (case
insensitive), it shows that a caller will not be interested in such tag,
although there is no guarantee it would save any resources, nor that a tag
value will be empty. Currently no built-in tags start with 'NO'. A later
entry overrides previous one, e.g. ASN,NOASN,ASN,TIMING,NOASN is equivalent
to TIMING,NOASN.
For backward compatibility, all tags available as of version 3.2.4 will
be available by default (unless disabled by NOtag), even if not requested
through need_tags option. Future versions may provide new tags conditionally
available.
Currently the only tag that needs to be explicitly requested is 'TIMING'.
Not requesting it can save a millisecond or two - it mostly serves to
illustrate the usage of need_tags.
Example:
need_tags =E<gt> 'TIMING,noLANGUAGES,RELAYCOUNTRY,ASN,noASNCIDR',
or:
need_tags =E<gt> [qw(TIMING noLANGUAGES RELAYCOUNTRY ASN noASNCIDR)],
=item ignore_site_cf_files
If set to 1, any rule files found in the C<site_rules_filename> directory will
be ignored. *.pre files (used for loading plugins) found in the
C<site_rules_filename> directory will still be used. (default: 0)
=item dont_copy_prefs
If set to 1, the user preferences file will not be created if it doesn't
already exist. (default: 0)
=item save_pattern_hits
If set to 1, the patterns hit can be retrieved from the
C<Mail::SpamAssassin::PerMsgStatus> object. Used for debugging.
=item home_dir_for_helpers
If set, the B<HOME> environment variable will be set to this value
when using test applications that require their configuration data,
such as Razor, Pyzor and DCC.
=item username
If set, the C<username> attribute will use this as the current user's name.
Otherwise, the default is taken from the runtime environment (ie. this process'
effective UID under UNIX).
=item skip_prng_reseeding
If skip_prng_reseeding is set to true, the SpamAssassin library will B<not>
call srand() to reseed a pseudo-random number generator (PRNG). The srand()
Perl function should be called during initialization of each child process,
soon after forking.
Prior to version 3.4.0, calling srand() was handled by the SpamAssassin
library.
This setting requires the caller to decide when to call srand().
This choice may be desired to preserve the entropy of a PRNG. The default
value of skip_prng_reseeding is false to maintain backward compatibility.
This option should only be set by a caller if it calls srand() upon spawning
child processes. Unless you are certain you need it, leave this setting as
false.
NOTE: The skip_prng_reseeding feature is implemented in spamd as of 3.4.0
which allows spamd to call srand() right after forking a child process.
=back
If none of C<rules_filename>, C<site_rules_filename>, C<userprefs_filename>, or
C<config_text> is set, the C<Mail::SpamAssassin> module will search for the
configuration files in the usual installed locations using the below variable
definitions which can be passed in.
=over 4
=item PREFIX
Used as the root for certain directory paths such as:
'__prefix__/etc/mail/spamassassin'
'__prefix__/etc/spamassassin'
Defaults to "@@PREFIX@@".
=item DEF_RULES_DIR
Location where the default rules are installed. Defaults to
"@@DEF_RULES_DIR@@".
=item LOCAL_RULES_DIR
Location where the local site rules are installed. Defaults to
"@@LOCAL_RULES_DIR@@".
=item LOCAL_STATE_DIR
Location of the local state directory, mainly used for installing updates via
C<sa-update> and compiling rulesets to native code. Defaults to
"@@LOCAL_STATE_DIR@@".
=back
=cut
# undocumented ctor settings:
#
# - keep_config_parsing_metadata: used by build/listpromotable, default 0
sub new {
my $class = shift;
$class = ref($class) || $class;
my $self = shift;
if (!defined $self) { $self = { }; }
bless ($self, $class);
# basic backward compatibility; debug used to be a boolean.
# translate that into 'all', which is what it meant before 3.1.0.
if ($self->{debug} && $self->{debug} eq '1') {
$self->{debug} = 'all';
}
# enable or disable debugging
Mail::SpamAssassin::Logger::add_facilities($self->{debug});
# first debugging information possibly printed should be the version
dbg("generic: SpamAssassin version " . Version());
lib/Mail/SpamAssassin.pm view on Meta::CPAN
The username in C<$username> will also be used for the C<username> attribute of
the Mail::SpamAssassin object.
=cut
sub load_scoreonly_sql {
my ($self, $username) = @_;
my $timer = $self->time_method("load_scoreonly_sql");
my $src = Mail::SpamAssassin::Conf::SQL->new ($self);
$self->{username} = $username;
unless ($src->load($username)) {
return 0;
}
return 1;
}
###########################################################################
=item $f-E<gt>load_scoreonly_ldap ($username)
Read configuration parameters from an LDAP server and parse scores from it.
This will only take effect if the perl C<Net::LDAP> and C<URI> modules are
installed, and the configuration parameters C<user_scores_dsn>,
C<user_scores_ldap_username>, and C<user_scores_ldap_password> are set
correctly.
The username in C<$username> will also be used for the C<username> attribute of
the Mail::SpamAssassin object.
=cut
sub load_scoreonly_ldap {
my ($self, $username) = @_;
dbg("config: load_scoreonly_ldap($username)");
my $timer = $self->time_method("load_scoreonly_ldap");
my $src = Mail::SpamAssassin::Conf::LDAP->new ($self);
$self->{username} = $username;
$src->load($username);
}
###########################################################################
=item $f-E<gt>set_persistent_address_list_factory ($factoryobj)
Set the persistent address list factory, used to create objects for the
automatic welcomelist algorithm's persistent-storage back-end. See
C<Mail::SpamAssassin::PersistentAddrList> for the API these factory objects
must implement, and the API the objects they produce must implement.
=cut
sub set_persistent_address_list_factory {
my ($self, $fac) = @_;
$self->{pers_addr_list_factory} = $fac;
}
###########################################################################
=item $f-E<gt>compile_now ($use_user_prefs, $keep_userstate)
Compile all patterns, load all configuration files, and load all
possibly-required Perl modules.
Normally, Mail::SpamAssassin uses lazy evaluation where possible, but if you
plan to fork() or start a new perl interpreter thread to process a message,
this is suboptimal, as each process/thread will have to perform these actions.
Call this function in the master thread or process to perform the actions
straight away, so that the sub-processes will not have to.
If C<$use_user_prefs> is 0, this will initialise the SpamAssassin
configuration without reading the per-user configuration file and it will
assume that you will call C<read_scoreonly_config> at a later point.
If C<$keep_userstate> is true, compile_now() will revert any configuration
options which have a default with I<__userstate__> in it post-init(),
and then re-change the option before returning. This lets you change
I<$ENV{'HOME'}> to a temp directory, have compile_now() and create any
files there as necessary without disturbing the actual files as changed
by a configuration option. By default, this is disabled.
=cut
sub compile_now {
my ($self, $use_user_prefs, $deal_with_userstate) = @_;
my $timer = $self->time_method("compile_now");
# Backup default values which deal with userstate.
# This is done so we can create any new files in, presumably, a temp dir.
# see bug 2762 for more details.
my %backup;
if (defined $deal_with_userstate && $deal_with_userstate) {
while(my($k,$v) = each %{$self->{conf}}) {
$backup{$k} = $v if (defined $v && !ref($v) && $v =~/__userstate__/);
}
}
$self->init($use_user_prefs);
# if init() didn't change the value from default, forget about it.
# if the value is different, remember the new version, and reset the default.
while(my($k,$v) = each %backup) {
if ($self->{conf}->{$k} eq $v) {
delete $backup{$k};
}
else {
my $backup = $backup{$k};
$backup{$k} = $self->{conf}->{$k};
$self->{conf}->{$k} = $backup;
}
}
dbg("ignore: test message to precompile patterns and load modules");
# tell plugins we are about to send a message for compiling purposes
$self->call_plugins("compile_now_start",
{ use_user_prefs => $use_user_prefs,
keep_userstate => $deal_with_userstate});
# note: this may incur network access. Good. We want to make sure
# as much as possible is preloaded!
my @testmsg = ("From: ignore\@compiling.spamassassin.taint.org\n",
"Message-Id: <".time."\@spamassassin_spamd_init>\n", "\n",
"I need to make this message body somewhat long so TextCat preloads\n"x20);
my $mail = $self->parse(\@testmsg, 1, { master_deadline => undef });
my $status = Mail::SpamAssassin::PerMsgStatus->new($self, $mail,
{ disable_auto_learning => 1 } );
# We want to turn off the bayes rules for this test msg
my $use_bayes_rules_value = $self->{conf}->{use_bayes_rules};
$self->{conf}->{use_bayes_rules} = 0;
$status->check();
$self->{conf}->{use_bayes_rules} = $use_bayes_rules_value;
$status->finish();
$mail->finish();
$self->finish_learner();
$self->{conf}->free_uncompiled_rule_source();
# load SQL modules now as well
my $dsn = $self->{conf}->{user_scores_dsn};
if ($dsn ne '') {
if ($dsn =~ /^ldap:/i) {
Mail::SpamAssassin::Conf::LDAP::load_modules();
} else {
Mail::SpamAssassin::Conf::SQL::load_modules();
}
}
# make sure things are ready for scanning
$self->{bayes_scanner}->force_close() if $self->{bayes_scanner};
$self->call_plugins("compile_now_finish",
{ use_user_prefs => $use_user_prefs,
keep_userstate => $deal_with_userstate});
# Reset any non-default values to the post-init() version.
while(my($k,$v) = each %backup) {
$self->{conf}->{$k} = $v;
}
# clear sed_path_cache
delete $self->{conf}->{sed_path_cache};
1;
}
###########################################################################
=item $f-E<gt>debug_diagnostics ()
Output some diagnostic information, useful for debugging SpamAssassin
problems.
=cut
sub debug_diagnostics {
my ($self) = @_;
# load this class lazily, to avoid overhead when this method isn't
# called.
eval {
require Mail::SpamAssassin::Util::DependencyInfo;
dbg(Mail::SpamAssassin::Util::DependencyInfo::debug_diagnostics($self));
};
}
###########################################################################
=item $failed = $f-E<gt>lint_rules ()
Syntax-check the current set of rules. Returns the number of
syntax errors discovered, or 0 if the configuration is valid.
=cut
sub lint_rules {
my ($self) = @_;
dbg("ignore: using a test message to lint rules");
my @testmsg = ("From: ignore\@compiling.spamassassin.taint.org\n",
"Subject: \n",
"Message-Id: <".CORE::time()."\@lint_rules>\n", "\n",
"I need to make this message body somewhat long so TextCat preloads\n"x20);
$self->{lint_rules} = $self->{conf}->{lint_rules} = 1;
$self->{syntax_errors} = 0;
my $olddcp = $self->{dont_copy_prefs};
$self->{dont_copy_prefs} = 1;
$self->init(1);
$self->{syntax_errors} += $self->{conf}->{errors};
$self->{dont_copy_prefs} = $olddcp; # revert back to previous
# bug 5048: override settings to ensure a faster lint
$self->{'conf'}->{'use_auto_welcomelist'} = 0;
$self->{'conf'}->{'bayes_auto_learn'} = 0;
my $mail = $self->parse(\@testmsg, 1, { master_deadline => undef });
my $status = Mail::SpamAssassin::PerMsgStatus->new($self, $mail,
{ disable_auto_learning => 1 } );
$status->check();
$self->{syntax_errors} += $status->{rule_errors};
$status->finish();
$mail->finish();
dbg("timing: " . $self->timer_report()) if $self->{timer_enabled};
return ($self->{syntax_errors});
}
###########################################################################
=item $f-E<gt>finish()
Destroy this object, so that it will be garbage-collected once it
goes out of scope. The object will no longer be usable after this
method is called.
=cut
sub finish {
my ($self) = @_;
$self->timer_start("finish");
$self->call_plugins("finish_tests", { conf => $self->{conf},
main => $self });
$self->{plugins}->finish(); delete $self->{plugins};
if ($self->{bayes_scanner}) {
$self->{bayes_scanner}->finish();
delete $self->{bayes_scanner};
}
$self->{resolver}->finish() if $self->{resolver};
$self->{conf}->finish(); delete $self->{conf};
$self->timer_end("finish");
%{$self} = ();
}
###########################################################################
# timers: bug 5356
sub timer_enable {
my ($self) = @_;
dbg("config: timing enabled") if !$self->{timer_enabled};
$self->{timer_enabled} = 1;
}
sub timer_disable {
my ($self) = @_;
lib/Mail/SpamAssassin.pm view on Meta::CPAN
}
sub timer_report {
my ($self) = @_;
my $earliest;
my $latest;
while (my($name,$h) = each(%{$self->{timers}})) {
# dbg("timing: %s - %s", $name, join(", ",
# map { sprintf("%s => %s", $_, $h->{$_}) } keys(%$h)));
my $start = $h->{start};
if (defined $start && (!defined $earliest || $earliest > $start)) {
$earliest = $start;
}
my $end = $h->{end};
if (defined $end && (!defined $latest || $latest < $end)) {
$latest = $end;
}
dbg("timing: start but no end: $name") if defined $start && !defined $end;
}
my $total =
(!defined $latest || !defined $earliest) ? 0 : $latest - $earliest;
my @str;
foreach my $name (@{$self->{timers_order}}) {
my $elapsed = $self->{timers}->{$name}->{elapsed} || 0;
my $pc = $total <= 0 || $elapsed >= $total ? 100 : ($elapsed/$total)*100;
my $fmt = $elapsed >= 0.005 ? "%.0f" : $elapsed >= 0.002 ? "%.1f" : "%.2f";
push @str, sprintf("%s: $fmt (%.1f%%)", $name, $elapsed*1000, $pc);
}
return sprintf("total %.0f ms - %s", $total*1000, join(", ", @str));
}
###########################################################################
# non-public methods.
sub init {
my ($self, $use_user_pref) = @_;
# Allow init() to be called multiple times, but only run once.
if (defined $self->{_initted}) {
# If the PID changes, reseed the PRNG (if permitted) and the DNS ID counter
if ($self->{_initted} != $$) {
$self->{_initted} = $$;
srand if !$self->{skip_prng_reseeding};
$self->{resolver}->reinit_post_fork();
}
return;
}
my $timer = $self->time_method("init");
# Note that this PID has run init()
$self->{_initted} = $$;
# if spamd or other forking, wait for spamd_child_init
if (!$self->{skip_prng_reseeding}) {
$self->set_global_state_dir();
}
#fix spamd reading root prefs file
if (!defined $use_user_pref) {
$use_user_pref = 1;
}
if (!defined $self->{config_text}) {
$self->{config_text} = '';
# read a file called "init.pre" in site rules dir *before* all others;
# even the system config.
my $siterules = $self->{site_rules_filename};
$siterules ||= $self->first_existing_path (@site_rules_path);
my $sysrules = $self->{rules_filename};
$sysrules ||= $self->first_existing_path (@default_rules_path);
if ($siterules) {
$self->{config_text} .= $self->read_pre($siterules, 'site rules pre files');
}
else {
warn "config: could not find site rules directory\n";
}
if ($sysrules) {
$self->{config_text} .= $self->read_pre($sysrules, 'sys rules pre files');
}
else {
warn "config: could not find sys rules directory\n";
}
if ($sysrules) {
my $cftext = $self->read_cf($sysrules, 'default rules dir');
if ($self->{require_rules} && $cftext !~ /\S/) {
die "config: no rules were found! Do you need to run 'sa-update'?\n";
}
$self->{config_text} .= $cftext;
}
if (!$self->{languages_filename}) {
$self->{languages_filename} = $self->find_rule_support_file("languages");
}
if ($siterules && !$self->{ignore_site_cf_files}) {
$self->{config_text} .= $self->read_cf($siterules, 'site rules dir');
}
if ( $use_user_pref != 0 ) {
$self->get_and_create_userstate_dir();
# user prefs file
my $fname = $self->{userprefs_filename};
$fname ||= $self->first_existing_path (@default_userprefs_path);
if (!$self->{dont_copy_prefs}) {
# bug 4932: if the userprefs path doesn't exist, we need to make it, so
# just use the last entry in the array as the default path.
$fname ||= $self->sed_path($default_userprefs_path[-1]);
my $stat_errn = stat($fname) ? 0 : 0+$!;
if ($stat_errn == 0 && -f _) {
# exists and is a regular file, nothing to do
} elsif ($stat_errn == 0) {
warn "config: default user preference file $fname is not a regular file\n";
} elsif ($stat_errn != ENOENT) {
warn "config: default user preference file $fname not accessible: $!\n";
} elsif (!$self->create_default_prefs($fname)) {
warn "config: failed to create default user preference file $fname\n";
}
}
$self->{config_text} .= $self->read_cf($fname, 'user prefs file');
}
}
if ($self->{pre_config_text}) {
$self->{pre_config_text} .= "\n" unless $self->{pre_config_text} =~ /\n\z/;
$self->{config_text} = "file start (pre_config_text)\n".
$self->{pre_config_text}.
"file end (pre_config_text)\n".
$self->{config_text};
}
if ($self->{post_config_text}) {
$self->{post_config_text} .= "\n" unless $self->{post_config_text} =~ /\n\z/;
$self->{config_text} .= "\n" unless $self->{config_text} =~ /\n\z/;
$self->{config_text} .= "file start (post_config_text)\n".
$self->{post_config_text}.
"file end (post_config_text)\n";
}
if ($self->{config_text} !~ /\S/) {
my $m = "config: no configuration text or files found! do you need to run 'sa-update'?\n";
if ($self->{require_rules}) {
die $m;
} else {
warn $m;
}
}
# Go and parse the config!
$self->{conf}->{main} = $self;
if (would_log('dbg', 'config_text') > 1) {
dbg('config_text: '.$self->{config_text});
}
$self->{conf}->parse_rules ($self->{config_text});
$self->{conf}->finish_parsing(0);
delete $self->{conf}->{main}; # to allow future GC'ing
undef $self->{config_text}; # ensure it's actually freed
delete $self->{config_text};
if ($self->{require_rules} && !$self->{conf}->found_any_rules()) {
die "config: no rules were found! Do you need to run 'sa-update'?\n";
}
# Initialize the Bayes subsystem
if ($self->{conf}->{use_bayes}) {
require Mail::SpamAssassin::Bayes;
$self->{bayes_scanner} = Mail::SpamAssassin::Bayes->new($self);
}
$self->{'learn_to_journal'} = $self->{conf}->{bayes_learn_to_journal};
# Figure out/set our initial scoreset
my $set = 0;
$set |= 1 unless $self->{local_tests_only};
$set |= 2 if $self->{bayes_scanner} && $self->{bayes_scanner}->is_scan_available() && $self->{conf}->{use_bayes_rules};
$self->{conf}->set_score_set ($set);
if ($self->{only_these_rules}) {
$self->{conf}->trim_rules($self->{only_these_rules});
}
lib/Mail/SpamAssassin.pm view on Meta::CPAN
return $txt;
}
sub read_cf_file {
my($self, $path) = @_;
my $txt = '';
if ($self->{cf_files_read}->{$path}++) {
dbg("config: skipping already read file: $path");
return $txt;
}
local *IN;
if (open (IN, "<".$path)) {
my($inbuf,$nread); $txt = '';
while ( $nread=read(IN,$inbuf,16384) ) { $txt .= $inbuf }
defined $nread or die "error reading $path: $!";
close IN or die "error closing $path: $!";
undef $inbuf;
$txt = "file start $path\n" . $txt;
# add an extra \n in case file did not end in one.
$txt .= "\n" unless $txt =~ /\n\z/;
$txt .= "file end $path\n";
dbg("config: read file $path");
}
else {
warn "config: cannot open \"$path\": $!\n";
}
return $txt;
}
sub get_and_create_userstate_dir {
my ($self, $dir) = @_;
my $fname;
# If vpopmail is enabled then set fname to virtual homedir
# precedence: dir, userstate_dir, derive from user_dir, system default
if (defined $dir) {
$fname = File::Spec->catdir ($dir, ".spamassassin");
}
elsif (defined $self->{userstate_dir}) {
$fname = $self->{userstate_dir};
}
elsif (defined $self->{user_dir}) {
$fname = File::Spec->catdir ($self->{user_dir}, ".spamassassin");
}
$fname ||= $self->first_existing_path (@default_userstate_dir);
# bug 4932: use the last default_userstate_dir entry if none of the others
# already exist
$fname ||= $self->sed_path($default_userstate_dir[-1]);
if (!$self->{dont_copy_prefs}) {
dbg("config: using \"$fname\" for user state dir");
}
# if this is not a dir, not readable, or we are unable to create the dir,
# this is not (yet) a serious error; in fact, it's not even worth
# a warning at all times, so use dbg(). see bug 6268
my $stat_errn = stat($fname) ? 0 : 0+$!;
if ($stat_errn == 0 && !-d _) {
dbg("config: $fname exists but is not a directory");
} elsif ($stat_errn != 0 && $stat_errn != ENOENT) {
dbg("config: error accessing $fname: $!");
} else { # does not exist, create it
eval {
mkpath(Mail::SpamAssassin::Util::untaint_file_path($fname), 0, 0700); 1;
} or do {
my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
dbg("config: mkdir $fname failed: $eval_stat");
};
}
$fname;
}
# find the most global writable state dir
# used by dns_block_rule state files etc
sub set_global_state_dir {
my ($self) = @_;
# try home_dir_for_helpers
my $helper_dir = $self->{home_dir_for_helpers} || '';
if ($helper_dir) {
my $dir = File::Spec->catdir($helper_dir, ".spamassassin");
return if $self->test_global_state_dir($dir);
}
# try user home (if different from helper home)
my $home;
if (am_running_on_windows()) {
# Windows has a special folder for common appdata (Bug 8050)
$home = Mail::SpamAssassin::Util::common_application_data_directory();
} else {
$home = (Mail::SpamAssassin::Util::portable_getpwuid ($>))[7];
}
if ($home && $home ne $helper_dir) {
my $dir = File::Spec->catdir($home, ".spamassassin");
return if $self->test_global_state_dir($dir);
}
# try LOCAL_STATE_DIR
return if $self->test_global_state_dir($self->{LOCAL_STATE_DIR});
# fallback to userstate
$self->{global_state_dir} = $self->get_and_create_userstate_dir();
dbg("config: global_state_dir set to userstate_dir: $self->{global_state_dir}");
}
sub test_global_state_dir {
my ($self, $dir) = @_;
eval { mkpath($dir, 0, 0700); }; # just a single stat if exists already
# Purge stale test files (enough to do only some times randomly)
if (rand() < 0.2 && opendir(WT_DIR, $dir)) {
foreach (grep {index($_, '.sawritetest') == 0 &&
(-M File::Spec->catfile($dir, $_)||0) > 0.0001} readdir(WT_DIR)) {
unlink(Mail::SpamAssassin::Util::untaint_file_path(File::Spec->catfile($dir, $_)));
}
closedir WT_DIR;
}
my $n = ".sawritetest$$".Mail::SpamAssassin::Util::pseudo_random_string(6);
my $file = File::Spec->catfile($dir, $n);
if (Mail::SpamAssassin::Util::touch_file($file, { create_exclusive => 1 })) {
dbg("config: global_state_dir set to $dir");
$self->{global_state_dir} = $dir;
unlink($file);
return 1;
}
unlink($file); # just in case?
return 0;
}
=item $fullpath = $f-E<gt>find_rule_support_file ($filename)
Find a rule-support file, such as C<languages> or C<triplets.txt>,
in the system-wide rules directory, and return its full path if
it exists, or undef if it doesn't exist.
(This API was added in SpamAssassin 3.1.1.)
=cut
sub find_rule_support_file {
my ($self, $filename) = @_;
my @paths;
# search custom directories first
if ($self->{site_rules_filename}) {
foreach my $path (split("\000", $self->{site_rules_filename})) {
push @paths, $path if -d $path;
}
}
if ($self->{rules_filename} && -d $self->{rules_filename}) {
push @paths, $self->{rules_filename}
}
# updates sub-directory missing from @default_rules_path
push @paths, '__local_state_dir__/__version__/updates_spamassassin_org';
push @paths, @default_rules_path;
return $self->first_existing_path(
map { my $p = $_; $p =~ s{$}{/$filename}; $p } @paths );
}
=item $f-E<gt>create_default_prefs ($filename, $username [ , $userdir ] )
Copy default preferences file into home directory for later use and
modification, if it does not already exist and C<dont_copy_prefs> is
not set.
=cut
sub create_default_prefs {
# $userdir will only exist if vpopmail config is enabled thru spamd
# Its value will be the virtual user's maildir
#
my ($self, $fname, $user, $userdir) = @_;
if ($self->{dont_copy_prefs}) {
return(0);
}
# if ($userdir && $userdir ne $self->{user_dir}) {
# warn "config: hooray! user_dirs don't match! '$userdir' vs '$self->{user_dir}'\n";
# }
my $stat_errn = stat($fname) ? 0 : 0+$!;
if ($stat_errn == 0) {
# fine, it already exists
} elsif ($stat_errn != ENOENT) {
dbg("config: cannot access user preferences file $fname: $!");
} else {
# Pass on the value of $userdir for virtual users in vpopmail
# otherwise it is empty and the user's normal homedir is used
$self->get_and_create_userstate_dir($userdir);
# copy in the default one for later editing
my $defprefs =
$self->first_existing_path(@Mail::SpamAssassin::default_prefs_path);
local(*IN,*OUT);
$fname = Mail::SpamAssassin::Util::untaint_file_path($fname);
if (!defined $defprefs) {
warn "config: can not determine default prefs path\n";
} elsif (!open(IN, "<$defprefs")) {
warn "config: cannot open $defprefs: $!\n";
} elsif (!open(OUT, ">$fname")) {
warn "config: cannot create user preferences file $fname: $!\n";
} else {
# former code skipped lines beginning with '#* ', the following copy
# procedure no longer does so, as it avoids reading line-by-line
my($inbuf,$nread);
while ( $nread=read(IN,$inbuf,16384) ) {
print OUT $inbuf or die "cannot write to $fname: $!";
}
defined $nread or die "error reading $defprefs: $!";
undef $inbuf;
close OUT or die "error closing $fname: $!";
close IN or die "error closing $defprefs: $!";
if (($< == 0) && ($> == 0) && defined($user)) { # chown it
my ($uid,$gid) = (getpwnam(untaint_var($user)))[2,3];
unless (chown($uid, $gid, $fname)) {
warn "config: couldn't chown $fname to $uid:$gid for $user: $!\n";
}
}
warn "config: created user preferences file: $fname\n";
return(1);
}
}
return(0);
}
###########################################################################
sub expand_name {
my ($self, $name) = @_;
my $home = $self->{user_dir} || $ENV{HOME} || '';
if (am_running_on_windows()) {
my $userprofile = $ENV{USERPROFILE} || '';
return $userprofile if ($userprofile && $userprofile =~ m/^[a-z]\:[\/\\]/i);
return $userprofile if ($userprofile =~ m/^\\\\/);
return $home if ($home && $home =~ m/^[a-z]\:[\/\\]/i);
return $home if ($home =~ m/^\\\\/);
return '';
} else {
return $home if ($home && index($home, '/') != -1);
return (getpwnam($name))[7] if ($name ne '');
return (getpwuid($>))[7];
}
}
sub sed_path {
my ($self, $path) = @_;
return if !defined $path;
if (exists($self->{conf}->{sed_path_cache}->{$path})) {
return $self->{conf}->{sed_path_cache}->{$path};
}
# <4.0 compatibility check, to be removed in 4.1
my $check_compat = $path eq '__userstate__/auto-welcomelist';
my $orig_path = $path;
$path =~ s/__local_rules_dir__/$self->{LOCAL_RULES_DIR} || ''/ges;
$path =~ s/__local_state_dir__/$self->{LOCAL_STATE_DIR} || ''/ges;
$path =~ s/__def_rules_dir__/$self->{DEF_RULES_DIR} || ''/ges;
$path =~ s{__prefix__}{$self->{PREFIX} || $Config{prefix} || '/usr'}ges;
$path =~ s{__userstate__}{$self->get_and_create_userstate_dir() || ''}ges;
$path =~ s/__global_state_dir__/$self->{global_state_dir} || ''/ges;
$path =~ s{__perl_major_ver__}{$self->get_perl_major_version()}ges;
$path =~ s/__version__/${VERSION}/gs;
$path =~ s/^\~([^\/]*)/$self->expand_name($1)/es;
( run in 2.703 seconds using v1.01-cache-2.11-cpan-0bb4e1dffa6 )