| Current File : //usr/share/perl5/vendor_perl/Amavis/Log.pm |
package Amavis::Log;
use strict;
use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.412';
@ISA = qw(Exporter);
@EXPORT_OK = qw(&init &amavis_log_id &collect_log_stats
&log_to_stderr &log_fd &open_log &close_log &write_log);
}
use subs @EXPORT_OK;
use POSIX qw(locale_h strftime);
use Fcntl qw(:flock F_GETFL F_SETFL FD_CLOEXEC);
use IO::File qw(O_RDONLY O_WRONLY O_RDWR O_APPEND O_CREAT O_EXCL);
use Unix::Syslog qw(:macros :subs);
use Time::HiRes ();
use Amavis::Util;
# since IO::File 1.10 (comes with perl 5.8.1):
# If "IO::File::open" is given a mode that includes the ":" character,
# it passes all the three arguments to a three-argument "open" operator.
use Amavis::Conf qw(:platform $DEBUG $TEMPBASE c cr ca
$myversion $logline_maxlen $daemon_user);
use vars qw($loghandle); # log file handle when logging to a file
use vars qw($log_to_stderr $log_to_syslog $logfile_name $within_write_log);
use vars qw($current_amavis_log_id); # tracks am_id() / $msginfo->log_id
use vars qw($current_actual_syslog_ident $current_actual_syslog_facility);
use vars qw($log_lines $log_retries %log_entries_by_level %log_status_counts);
use vars qw($log_prio_debug $log_prio_info $log_prio_notice
$log_prio_warning $log_prio_err $log_prio_crit);
BEGIN { # saves a few ms by avoiding a subroutine call later
$log_prio_debug = LOG_DEBUG;
$log_prio_info = LOG_INFO;
$log_prio_notice = LOG_NOTICE;
$log_prio_warning = LOG_WARNING;
$log_prio_err = LOG_ERR;
$log_prio_crit = LOG_CRIT;
$log_to_stderr = 1; # default until config files have been read
}
sub init($$) {
($log_to_syslog, $logfile_name) = @_;
$log_lines = 0; %log_entries_by_level = ();
$log_retries = 0; %log_status_counts = ();
$log_to_stderr =
$log_to_syslog || (defined $logfile_name && $logfile_name ne '') ? 0 : 1;
open_log();
}
sub collect_log_stats() {
my(@result) = ($log_lines, {%log_entries_by_level},
$log_retries, {%log_status_counts});
$log_lines = 0; %log_entries_by_level = ();
$log_retries = 0; %log_status_counts = ();
@result;
}
# task id as shown in the log, also known as am_id, tracks $msginfo->log_id
#
sub amavis_log_id(;$) {
$current_amavis_log_id = $_[0] if @_;
$current_amavis_log_id;
}
# turn debug logging to STDERR on or off
#
sub log_to_stderr(;$) {
$log_to_stderr = $_[0] if @_;
$log_to_stderr;
}
# try to obtain file descriptor used by write_log, undef if unknown
#
sub log_fd() {
$log_to_stderr ? fileno(STDERR)
: $log_to_syslog ? undef # no fd for syslog
: defined $loghandle ? $loghandle->fileno : fileno(STDERR);
}
sub open_log() {
if ($log_to_syslog && !$log_to_stderr) {
my $id = c('syslog_ident'); my $fac = c('syslog_facility');
$fac =~ /^[A-Za-z0-9_]+\z/
or die "Suspicious syslog facility name: $fac";
my $syslog_facility_num = eval("LOG_\U$fac");
$syslog_facility_num =~ /^\d+\z/
or die "Unknown syslog facility name: $fac";
# man syslog(3) on Linux: The argument 'ident' in the call of openlog()
# is probably stored as-is. Thus, if the string it points to is changed,
# syslog() may start prepending the changed string, and if the string
# it points to ceases to exist, the results are undefined. Most portable
# is to use a string constant. (we use a static variable here)
$current_actual_syslog_ident = $id; $current_actual_syslog_facility = $fac;
openlog($id, LOG_PID | LOG_NDELAY, $syslog_facility_num);
} elsif ($log_to_stderr || $logfile_name eq '') { # logging to STDERR
STDERR->autoflush(1); # just in case (should already be on by default)
STDERR->fcntl(F_SETFL, O_APPEND)
or warn "Error setting O_APPEND on STDERR: $!";
} elsif ($logfile_name ne '') {
$loghandle = IO::File->new;
# O_WRONLY etc. can become tainted in Perl5.8.9 [perlbug #62502]
$loghandle->open($logfile_name,
Amavis::Util::untaint(O_CREAT|O_APPEND|O_WRONLY), 0640)
or die "Failed to open log file $logfile_name: $!";
binmode($loghandle,':bytes') or die "Can't cancel :utf8 mode: $!";
$loghandle->autoflush(1);
if (defined $daemon_user && $daemon_user ne '' && $> == 0) {
local($1);
my $uid = $daemon_user=~/^(\d+)$/ ? $1 : (getpwnam($daemon_user))[2];
if ($uid) {
chown($uid,-1,$logfile_name)
or die "Can't chown logfile $logfile_name to $uid: $!";
}
}
}
}
sub close_log() {
if ($log_to_syslog) {
closelog();
$current_actual_syslog_ident = $current_actual_syslog_facility = undef;
} elsif (defined($loghandle) && $logfile_name ne '') {
$loghandle->close or die "Error closing log file $logfile_name: $!";
undef $loghandle;
}
}
# Log either to syslog or to a file
#
sub write_log($$) {
my($level,$errmsg) = @_;
return if $within_write_log;
$within_write_log++;
my $am_id = !defined $current_amavis_log_id ? ''
: "($current_amavis_log_id) ";
# my $old_locale = POSIX::setlocale(LC_TIME,'C'); # English dates required!
my $alert_mark = $level >= 0 ? '' : $level >= -1 ? '(!)' : '(!!)';
# $alert_mark .= '*' if $> == 0;
$log_entries_by_level{"$level"}++;
my $prio = $level >= 3 ? $log_prio_debug # most frequent first
# : $level >= 2 ? $log_prio_info
: $level >= 1 ? $log_prio_info
: $level >= 0 ? $log_prio_notice
: $level >= -1 ? $log_prio_warning
: $level >= -2 ? $log_prio_err
: $log_prio_crit;
if ($log_to_syslog && !$log_to_stderr) {
if ($Amavis::Util::current_config_syslog_ident
ne $current_actual_syslog_ident ||
$Amavis::Util::current_config_syslog_facility
ne $current_actual_syslog_facility) {
close_log() if defined $current_actual_syslog_ident ||
defined $current_actual_syslog_facility;
open_log();
}
my $pre = $alert_mark;
# $logline_maxlen should be less than (1023 - prefix) for a typical syslog,
# 980 is a suitable length to avoid truncations by the syslogd daemon
my $logline_size = $logline_maxlen;
$logline_size = 50 if $logline_size < 50; # let at least something out
while (length($am_id)+length($pre)+length($errmsg) > $logline_size) {
my $avail = $logline_size - length($am_id . $pre . '...');
$log_lines++; $! = 0;
# syslog($prio, '%s', $am_id . $pre . substr($errmsg,0,$avail) . '...');
Unix::Syslog::_isyslog($prio,
$am_id . $pre . substr($errmsg,0,$avail) . '...');
if ($! != 0) { $log_retries++; $log_status_counts{"$!"}++ }
$pre = $alert_mark . '...'; $errmsg = substr($errmsg,$avail);
}
$log_lines++; $! = 0;
# syslog($prio, '%s', $am_id . $pre . $errmsg);
Unix::Syslog::_isyslog($prio, $am_id . $pre . $errmsg);
if ($! != 0) { $log_retries++; $log_status_counts{"$!"}++ }
} elsif ($log_to_stderr || !defined $loghandle) {
$log_lines++;
my $prefix;
if ($DEBUG) {
my $now = Time::HiRes::time; # timestamp with milliseconds
$prefix = sprintf('%s:%06.3f %s %s[%s]: ', # syslog-like prefix
strftime('%b %e %H:%M',localtime($now)), $now-int($now/60)*60,
Amavis::Util::idn_to_utf8(c('myhostname')), c('myprogram_name'), $$);
} else {
$prefix = "<$prio>"; # sd-daemon(3), SyslogLevelPrefix=true
}
# avoid multiple calls to write(2), join the string first!
my $s = $prefix . $am_id . $alert_mark . $errmsg . "\n";
#
# IEEE Std 1003.1, 2013: Write requests to a pipe or FIFO shall be handled
# in the same way as a regular file with the following exceptions: [...]
# - There is no file offset associated with a pipe, hence each write
# request shall append to the end of the pipe.
# - Write requests of {PIPE_BUF} bytes or less shall not be interleaved
# with data from other processes doing writes on the same pipe.
# Writes of greater than {PIPE_BUF} bytes may have data interleaved, on
# arbitrary boundaries, with writes by other processes, whether or not
# the O_NONBLOCK flag of the file status flags is set.
#
# PIPE_BUF is 512 on *BSD, 4096 on Linux.
print STDERR ($s) or die "Error writing to STDERR: $!";
} else {
$log_lines++;
my $now = Time::HiRes::time;
my $prefix = sprintf('%s %s %s[%s]: ', # prepare a syslog-like prefix
strftime('%b %e %H:%M:%S',localtime($now)),
Amavis::Util::idn_to_utf8(c('myhostname')), c('myprogram_name'), $$);
my $s = $prefix . $am_id . $alert_mark . $errmsg . "\n";
# NOTE: a lock is on a file, not on a file handle
flock($loghandle,LOCK_EX) or die "Can't lock a log file: $!";
# seek() seems redundant with O_APPEND:
# IEEE Std 1003.1, 2013: If the O_APPEND flag of the file status flags is
# set, the file offset shall be set to the end of the file prior to each
# write and no intervening file modification operation shall occur between
# changing the file offset and the write operation.
seek($loghandle,0,2) or die "Can't position log file to its tail: $!";
$loghandle->print($s) or die "Error writing to log file: $!";
# we have autoflush on, so unlocking here is safe
flock($loghandle,LOCK_UN) or die "Can't unlock a log file: $!";
}
# POSIX::setlocale(LC_TIME, $old_locale);
$within_write_log = 0;
}
1;