#
# Copyright (c) 2004-2007 - Consultas, PKG.fr
#
# This file is part of A2P.
#
# A2P is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# A2P is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with A2P; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
#
# $Id: Syslog.pm 3 2007-10-18 16:20:19Z guillaume $
#

package A2P::Syslog;

use strict ;
use Socket ;
use Errno qw( EINTR );
use Time::HiRes qw( usleep gettimeofday tv_interval );
use IO::Socket ;
use MIME::Base64 ;
use A2P::Globals ;
use A2P::Com qw( GetCom comREQ comCOM comLOG TakeComLocking ReleaseComLocking );

BEGIN {
    use Exporter ();
    our ( $VERSION , @ISA , @EXPORT , @EXPORT_OK , @TT );

    $VERSION = sprintf "%s", q$Rev: 762 $ =~ /(\d[0-9.]+)\s+/ ;

    @ISA = qw(Exporter);
    @EXPORT = qw(   &Debug &Info &Notice &Error &Warn &Alert
                    $loggertid &DirectLog &SetLogger &getBackLogs &AlertError
                    &debugdev &NotImplemented &ResetDebug );
    @EXPORT_OK= qw( &AttachZipToAlertError );

    # Set timer ref to starting time
    @TT = ( $^T , ( $^T * 1_000_000 ) % 1_000_000 ) unless @TT ;
}
our $VERSION ;

our $loggertid  = 0 ;

my $Logger      = 0 ;
my $loggingname = $Progname ;

# Shared timer to get syslog timestamps synchronized
our @TT ;

# Log backup
my @BackLogs = () ;

# Locking var to not get coflicts with coms
my $lockfile = undef ;
my $locked   = 0 ;

# Syslog socket
sub facility { 6 << 3 } # LOG_LPR Facility
my $who = "" ;

sub OpenSyslog {
    my $toconnect = sockaddr_un($SYSLOG_PATH);
    unless ( $toconnect ) {
        warn "Can't locate $SYSLOG_PATH: $!\n" ;
        return "" ;
    }

    unless ( socket( $SYSLOG, AF_UNIX, SOCK_STREAM, 0 )) {
        warn "Can't open Syslog unix stream socket: $!\n" ;
        return "" ;
    }

    if (!connect($SYSLOG,$toconnect)) {
        unless (socket( $SYSLOG, AF_UNIX, SOCK_DGRAM, 0 )) {
            warn "Can't open Syslog unix datagram socket: $!\n" ;
            return "" ;
        }
        unless (connect($SYSLOG,$toconnect)) {
            warn "Can't connect to Syslog unix datagram socket: $!\n" ;
            return "" ;
        }
    }
    return $loggingname . ( $LOCKID ? "-$LOCKID" : "" ) . "[$$]" ;
}

my %Level = ( 1 => 'alert', 3 => 'error' , 4 => 'warning' , 5 => 'notice' ,
    6 => 'info' , 7 => 'debug' );

sub DirectLog {

    # First argument should be log level
    # Second is an array of messages to log
    # Third should be defined to get message up to parent
    #   and content debugging info when required

    return unless ( ref($_[1]) =~/^ARRAY/ );

    my $level = shift ;
    my $ref   = shift ;
    $level = 6 unless ( defined($level) and $level );

    my @hdr = $NO_SYSLOG_DEBUG ? () : ( &timestamp(), '>' );
    push @hdr, "$Level{$level}: $loggingname:", @_ if @_ ;

    # Reset error status for debugging output problems
    $! = 0 ;

    if ( $loggertid and $loggertid != $$ and $Logger and ! $ADVANCED_DEBUGGING ) {

        close($SYSLOG) if (defined($SYSLOG));

        # Keep who is logging when logging in file, and not at debug level
        push @hdr, $Level{$level} . ":", $loggingname . "[$$]:"
            if ( $LOGFILE_VS_SYSLOG and $level < 7 );

        foreach my $logline ( @{$ref} ) {

            my $comlog = &GetCom( comLOG , $level ,
                 &KeepValidatedLog( \@hdr, $logline ));

            unless($Logger->DoLog($comlog)) {
                &debugdev("Log not sent on $Logger: $logline");

                # Try to log directly by recall ourselves but avoiding this case
                my $keep = $ADVANCED_DEBUGGING ;
                $ADVANCED_DEBUGGING = 1 ;
                &DirectLog( $level , $ref, @_ );
                $ADVANCED_DEBUGGING = $keep ;
            }
        }

    } elsif ( $LOGFILE_VS_SYSLOG or ( $level == 7 and $DEBUG_IN_FILE )) {

        my $LOG ;

        unshift @hdr, scalar(localtime), "[$$]:" ;
        open( $LOG, '>>', $LOGFILENAME )
            or warn "Can't open '$LOGFILENAME' for appending: $!\n", return 0 ;

        &TakeComLocking($LOG);

        my $test = 0 ;
        map {
            $test += print $LOG &KeepValidatedLog( \@hdr, $_ ), "\n"
        } @{$ref} ;

        $test == @{$ref} ? &UPSTAT('GOOD-LOGPRINT') : &UPSTAT('BAD-LOGPRINT');

        &ReleaseComLocking($LOG);
        close($LOG);

    } else {

        $who = &OpenSyslog();

        if ($who) {
            $level += facility ;
            unshift @hdr, "<$level>$who:" ;

            my $test = 0 ;
            my $tempo = 0 ;
            foreach my $line ( @{$ref} ) {
                my $log = &KeepValidatedLog( \@hdr, $line );
                my $sent = $! = 0 ;
                while ( ! defined($sent = send( $SYSLOG , $log . "\0" , 0 ))) {
                    # Retry only when we got a interrupted system call
                    unless ( $! == EINTR ) {
                        &debugdev("With line '$line'...",
                            "Can't send to syslog '$log'");
                        &debugdev("And errno[".int($!)."]= $!") if $! ;
                        last ;
                    }
                    usleep $USLEEP ;
                    $! = 0 ;
                }

                $test ++ ;
                $tempo += $sent ;
            }

            $test == @{$ref} ? &UPSTAT('GOOD-SYSLOGPRINT') : &UPSTAT('BAD-SYSLOGPRINT');

            close($SYSLOG);
        }
    }

    $! = 0 ;
}

sub KeepValidatedLog {
    my $timeref = shift ;
    my $logline = shift ;

    $logline =~ s/[^ -~]/ /go ;

    # Keep ref to log if requested
    if ( $MAX_BACKLOG and ! $KEEP_DYNAMIC_JOB_LOG ) {
        shift @BackLogs until ( @BackLogs < $MAX_BACKLOG );
        push @BackLogs, [ @{$timeref} , $logline ] ;
    }

    local $" = ' ' ;
    return ( @{$timeref} ? "@{$timeref} " : "" ) . $logline ;
}

sub getBackLogs {
    # Re-assemble logs ref
    return map { join('', @{$_}) } @BackLogs ;
}

sub timestamp {
    return "" if ( $NO_SYSLOG_DEBUG and ! $MAX_BACKLOG and ! $STDOUT_DEBUG);
    # Keep timer in the current minute
    my @tt = &gettimeofday() ;
    return sprintf("%.8d",
        (( $tt[0] - $TT[0] ) * 1_000_000 + ( $tt[1] - $TT[1] )) % 60_000_000 );
}

#############################################################################
##                 Standard system logging functions                       ##
#############################################################################
my $LastCount = 0 ;
my $LastDebugMessage = "" ;

sub SetLogger {
    $Logger      = shift ;
    $loggingname = $0 ;
}

sub debugdev {
    my $time = localtime(time);
    print STDERR
        map { $time, &timestamp, ": $Progname\[$$]: [DEV]: ", $_, "\n" } @_ ;
}

sub NotImplemented {
    my ( $package, $filename, $line, $sub ) = caller ;
    &DirectLog( 5 , [ "Need implementation".(@_?" of '@_'":"")." in $filename" ],
         $package.", ".$sub."(), L.".$line.":");
}

my %DebugMods = () ;
my $ReversedDebugModList = 0 ;
sub ResetDebug {
    my $last = $ReversedDebugModList ;
    $ReversedDebugModList = $NODEBUG_MOD_LIST =~ /^(!)/ ;
    $NODEBUG_MOD_LIST =~ s/[!]//g ;
    %DebugMods = map { $_ => 1 } split(/[,;\s]+/,$NODEBUG_MOD_LIST) ;
    return if ($NO_SYSLOG_DEBUG);
    &DirectLog( 7 , [ "Switching NODEBUG_MOD_LIST comportement to " .
        ($ReversedDebugModList?"":"not ") . "debug on ".join(" ",keys(%DebugMods)) ] )
        unless ( $ReversedDebugModList == $last );
}

my $lastdebug = [ &gettimeofday() ] ;
sub Debug {
    return &debugdev(@_) if ( $STDOUT_DEBUG );
    return if ( $NO_SYSLOG_DEBUG and ( $KEEP_DYNAMIC_JOB_LOG or ! $MAX_BACKLOG ));

    my ($package, $filename, $line) = caller ;

    return if ($ReversedDebugModList ^ defined($DebugMods{$package}));

    my @sub = caller(1);
    @sub = caller(2) if ( defined($sub[3]) and $sub[3] =~ /Debug$/ );
    $sub[3] = "(none)" unless (@sub > 3);
    my ( $sub ) = $sub[3] =~ /^.*::([^:]*)$/ ;

    return if ( $sub and $NODEBUG_SUB_LIST =~ /$sub/ );
    if ( $#_ or $_[0] ne $LastDebugMessage or &tv_interval($lastdebug) > 1 ) {
        if ($NO_SYSLOG_DEBUG) {
            &KeepValidatedLog( [ &timestamp() ],
                "Last message repeated $LastCount times")
                    if $LastCount ;
            map {
                &KeepValidatedLog( [ &timestamp(), "$package,".
                ( $sub ? "$sub," : ""), "L.$line:" ], $_ )
            } @_ ;

        } else {
            &DirectLog( 7 , [ " last message repeated $LastCount times" ] , "..." )
                if $LastCount ;
            &DirectLog( 7 , \@_, "$package,".( $sub ? "$sub," : ""), "L.$line:" );
        }
        $LastDebugMessage = defined($_[$#_]) ? $_[$#_] : "" ;
        $LastCount = 0 if $LastCount ;
        $lastdebug = [ &gettimeofday() ] ;

    } else {
        $LastCount ++ ;
    }
}

sub Info {
    &DirectLog( 6 , \@_ );
}

sub Notice {
    &DirectLog( 5 , \@_ );
}

sub Error {
   if ($NO_SYSLOG_DEBUG and ! $ADVANCED_DEBUGGING) {
        &DirectLog( 3 , \@_ );

    } else {
        my ( $package, $filename, $line, $sub ) = caller ;
        $filename =~ m|([^/]+)$| ;
        &DirectLog( 3   , \@_ , "$package, L.$line:" );
        &DirectLog( 7 , \@_ , "ERROR: $package, L.$line:" );
        ($package, $filename, $line, $sub) = caller(1);
        return 0 unless (defined($filename) and defined($line) and defined($sub) and $sub);
        $filename =~ m|([^/]+)$| ;
        &DirectLog( 7 , \@_ , "ERROR: $1, $sub, L.$line:" );
        ($package, $filename, $line, $sub) = caller(2);
        return 0 unless (defined($filename) and defined($line) and defined($sub) and $sub);
        $filename =~ m|([^/]+)$| ;
        &DirectLog( 7 , \@_ , "ERROR: $1, $sub, L.$line:" );
    }
    0 ;
}

sub Warn {
    &DirectLog( 4 , \@_ );
}

sub Alert {
    return &Warn("Alert called without message") unless ( @_ and $_[0] );
    if ( -x $MAIL_BIN ) {
        if ( $ALERT_MAILS ) {
            open(*MAIL,"|$MAIL_BIN $ALERT_MAILS")
                or &Warn("Can't open mailer program: $!");
            print MAIL "Subject: [$Progname;$LOCKID] $_[0]\n";
            close(MAIL);
            &Info("Alert sent to '$ALERT_MAILS'");
        }
        &AlertError(@_) if $ERROR_MAILS ;

    } else {
        &Warn("Can't open mailer program as it is not launchable");
    }
    # Reduce alert to syslog to only give the alert title
    &DirectLog( 1 , [ $_[0] ] );
}

my $zipfile = "" ;
sub AttachZipToAlertError {
    $zipfile = shift ;
}

sub AlertError {
    return &Warn("Alert called without message") unless ( @_ and $_[0] );
    if ( -x $MAIL_BIN ) {
        if ( $ERROR_MAILS ) {

            open(*MAIL,"|$MAIL_BIN $ERROR_MAILS")
                or return &Warn("Can't open mailer program: $!");

            my $boundary = "_----------=_" . int(time) . $$ ;

            print MAIL "Subject: [$Progname;$LOCKID] $_[0]\n" ;

            print MAIL "Content-Transfer-Encoding: binary
Content-Type: multipart/mixed; boundary=$boundary
MIME-Version: 1.0
X-Mailer: $loggingname v$VERSION (", __PACKAGE__, " rev $VERSION)

This is a multi-part message in MIME format.

--$boundary

"               if ( $zipfile and -e $zipfile );

            # Anyway insert alert content
            map { print MAIL $_ , "\n" } @_ ;

            if ( $zipfile and -e $zipfile ) {
                my $buf ;
                my ( $zipname ) = $zipfile =~ m|^.*/([^/]+)$| ;
                if ( open(*ZIP, '<', $zipfile)) {
                    binmode(ZIP);
                    print MAIL "
--$boundary
Content-Transfer-Encoding: base64
Content-Type: application/zip; name='$zipname'\n\n" ;
                    while (read(ZIP,$buf,60*57)) {
                        print MAIL encode_base64($buf);
                    }
                }
                $zipfile = "" ;
                print MAIL "\n\n--$boundary--\n\n" ;
            }
            close(MAIL);
            &Info("Alert with errors sent to '$ERROR_MAILS'");
            &Debug("Mail sent");
        }

    } else {
        &Warn("Can't open mailer program as it is not launchable");
    }
}

&Debug("Module " . __PACKAGE__ . " v$VERSION loaded") unless ( $0 =~ /cgi/ );

1;