=head1 NAME
Mail::SpamAssassin::Logger - SpamAssassin logging module
=head1 SYNOPSIS
use Mail::SpamAssassin::Logger;
$SIG{__WARN__} = sub {
log_message("warn", $_[0]);
};
$SIG{__DIE__} = sub {
log_message("error", $_[0]) if $_[0] !~ /\bin eval\b/;
};
=cut
package Mail::SpamAssassin::Logger;
use vars qw(@ISA @EXPORT @EXPORT_OK);
require Exporter;
use strict;
use warnings;
use bytes;
@ISA = qw(Exporter);
@EXPORT = qw(dbg info would_log);
@EXPORT_OK = qw(log_message);
use constant ERROR => 0;
use constant WARNING => 1;
use constant INFO => 2;
use constant DBG => 3;
my %log_level = (
0 => 'ERROR',
1 => 'WARNING',
2 => 'INFO',
3 => 'DBG',
);
our %LOG_SA;
$LOG_SA{level} = WARNING; $LOG_SA{facility} = {};
use Mail::SpamAssassin::Logger::Stderr;
$LOG_SA{method}->{stderr} = Mail::SpamAssassin::Logger::Stderr->new();
=head1 METHODS
=over 4
=item add_facilities(facilities)
Enable debug logging for specific facilities. Each facility is the area
of code to debug. Facilities can be specified as a hash reference (the
key names are used), an array reference, an array, or a comma-separated
scalar string.
If "all" is listed, then all debug facilities are enabled. Higher
priority informational messages that are suitable for logging in normal
circumstances are available with an area of "info". Some very verbose
messages require the facility to be specifically enabled (see
C<would_log> below).
=cut
sub add_facilities {
my ($facilities) = @_;
my @facilities = ();
if (ref ($facilities) eq '') {
if (defined $facilities && $facilities ne '0') {
@facilities = split(/,/, $facilities);
}
}
elsif (ref ($facilities) eq 'ARRAY') {
@facilities = @{ $facilities };
}
elsif (ref ($facilities) eq 'HASH') {
@facilities = keys %{ $facilities };
}
@facilities = grep(/^\S+$/, @facilities);
if (@facilities) {
$LOG_SA{facility}->{$_} = 1 for @facilities;
if (keys %{ $LOG_SA{facility} } > 1 || !$LOG_SA{facility}->{info}) {
$LOG_SA{level} = DBG if $LOG_SA{level} < DBG;
}
else {
$LOG_SA{level} = INFO if $LOG_SA{level} < INFO;
}
dbg("logger: adding facilities: " . join(", ", @facilities));
dbg("logger: logging level is " . $log_level{$LOG_SA{level}});
}
}
=item log_message($level, $message)
=item log_message($level, @message)
Log a message at a specific level. Levels are specified as strings:
"warn", "error", "info", and "dbg". The first element of the message
must be prefixed with a facility name followed directly by a colon.
=cut
sub log_message {
my ($level, @message) = @_;
if ($level eq "error") {
return if ($message[0] =~ /__ignore__/);
my @caller = caller 2;
return if (defined $caller[3] && defined $caller[0] &&
$caller[3] =~ /^\(eval\)$/ &&
$caller[0] =~ m }
my $message = join(" ", @message);
$message =~ s/[\r\n]+$//; # remove any trailing newlines
foreach my $line (split(/\n/, $message)) {
$line =~ tr/\x09\x20\x00-\x1f/ _/s;
while (my ($name, $object) = each %{ $LOG_SA{method} }) {
$object->log_message($level, $line);
}
}
}
=item dbg("facility: message")
This is used for all low priority debugging messages.
=cut
sub dbg {
return unless $LOG_SA{level} >= DBG;
_log("dbg", @_);
}
=item info("facility: message")
This is used for informational messages indicating a normal, but
significant, condition. This should be infrequently called. These
messages are typically logged when SpamAssassin is run as a daemon.
=cut
sub info {
return unless $LOG_SA{level} >= INFO;
_log("info", @_);
}
sub _log {
my ($level, $message) = @_;
my $facility = "generic";
if ($message =~ /^(\S+?): (.*)/s) {
$facility = $1;
$message = $2;
}
if ($level eq "dbg") {
return unless ($LOG_SA{facility}->{all} ||
$LOG_SA{facility}->{$facility});
}
$message =~ s/\n+$//s;
$message =~ s/^/${facility}: /mg;
log_message($level, $message);
}
=item add(method => 'syslog', socket => $socket, facility => $facility)
C<socket> is the type the syslog ("unix" or "inet"). C<facility> is the
syslog facility (typically "mail").
=item add(method => 'file', filename => $file)
C<filename> is the name of the log file.
=item add(method => 'stderr')
No options are needed for stderr logging, just don't close stderr first.
=cut
sub add {
my %params = @_;
my $name = lc($params{method});
my $class = ucfirst($name);
eval 'use Mail::SpamAssassin::Logger::'.$class.';';
($@) and die "logger: add $class failed: $@";
if (!exists $LOG_SA{method}->{$name}) {
my $object = eval 'Mail::SpamAssassin::Logger::'.$class.'->new(%params);';
if (!$@ && $object) {
$LOG_SA{method}->{$name} = $object;
dbg("logger: successfully added $name method\n");
return 1;
}
warn("logger: failed to add $name method ($@)\n");
return 0;
}
warn("logger: $name method already added\n");
return 1;
}
=item remove(method)
Remove a logging method. Only the method name needs to be passed as a
scalar.
=cut
sub remove {
my ($method) = @_;
my $name = lc($method);
if (exists $LOG_SA{method}->{$name}) {
delete $LOG_SA{method}->{$name};
info("logger: removing $name method");
return 1;
}
warn("logger: unable to remove $name method, not present to be removed");
return 1;
}
=item would_log($level, $facility)
Returns 0 if a message at the given level and with the given facility
would be logged. Returns 1 if a message at a given level and facility
would be logged normally. Returns 2 if the facility was specifically
enabled.
The facility argument is optional.
=cut
sub would_log {
my ($level, $facility) = @_;
if ($level eq "info") {
return $LOG_SA{level} >= INFO;
}
if ($level eq "dbg") {
return 0 if $LOG_SA{level} < DBG;
return 1 if !$facility;
return 2 if $LOG_SA{facility}->{$facility};
return 1 if $LOG_SA{facility}->{all};
return 0;
}
warn "logger: would_log called with unknown level: $level\n";
return 0;
}
=item close_log()
Close all logs.
=cut
sub close_log {
while (my ($name, $object) = each %{ $LOG_SA{method} }) {
$object->close_log();
}
}
END {
close_log();
}
1;
=back
=cut