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;