#
# 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: EService.pm 3 2007-10-18 16:20:19Z guillaume $
#

package A2P::EService ;

# Derived class from Thread.pm
use base qw(A2P::Thread);

use strict ;
use integer ;
use IO::Socket ;
use A2P::Globals ;
use A2P::Syslog ;
use A2P::Com qw( IsCom comJOB comFILE );
use A2P::XML ;
use A2P::JobStatus 'a2pjobstate' ;

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

################################################################################
##             E-Service thread object                                        ##
################################################################################
sub Do {
    my $self = shift ;
    my $ref  = shift ;

    my $Ret = 0 ;
    $! = 0 ;

    my $OLDERR ;
    my $errfile ;

    my @Job = &IsCom( comJOB , $$ref );

    if ( @Job == 2 ) {
        my ( $Job , $req ) = @Job ;

        &Debug("Received E-Service request for $Job");
        $ENV{JOB} = $self->{JOB} = $Job ;

        # Keep internal stats
        &UPSTAT('E-SERVICE_REQ');

        # E-Service main sub-routine connector
        if ( $ESERVICE_ENABLED < 100 ) {
            my @service ;

            # Extract the request as comFILE
            my @Req = &IsCom( comFILE , $req );

            if ( @Req == 2 and -e $Req[1] ) {
                my ( $Service , $A2PXML ) = @Req ;
                &Debug("Got request on '$Service' E-Service for $Job job",
                    "Request comes with '$A2PXML' A2P xml");

                my $conf = $self->getconf ;
                if ( defined($conf) and @service = $conf->getbin($Service)
                and ! $conf->error) {
                    # Service array should be the binary full path plus the
                    # calling mode:
                    # mode 0: We should send the A2P xml on the STDIN of program
                    # mode 1: We should launch program with A2P xml full path as
                    #         first and only argument
                    my $mode = pop @service ;

                    # Redirect STDERR to a file
                    open $OLDERR, ">&", \*STDERR or undef $OLDERR ;

                    if (defined($OLDERR)) {
                        open STDERR, '>', $errfile = $A2PXML . '.stderr'
                            or undef $OLDERR ;
                    }

                    # Unbufferize STDERR
                    select STDERR ; $| = 1 ; select STDOUT ;

                    if ( $mode == 0 ) {
                        &Debug("Executing '@service' in mode 0: XML on STDIN");
                        my $XML ;
                        # Launch program sending a2p xml content on stdin
                        unless( open($XML , '<', $A2PXML) ) {
                            $Ret = scalar($!) ;
                            $self->ABTERM("Can't open $A2PXML for reading: $!");
                        }

                        my $SERVICE ;
                        my $pid = defined($XML) ?
                            open( $SERVICE, '|-', @service ) : undef ;

                        bless $SERVICE , "IO::Socket" ;
                        $SERVICE->autoflush(1);

                        if (defined($pid)) {
                            &Warn("Can't print to '@service' stdin: $!")
                                  unless print { $SERVICE } <$XML> ;

                            &Debug("Waiting son[$pid] has finished");
                            my $test = waitpid $pid, 0 ;
                            &Debug("Son[$pid] has finished");

                            &Warn("Not expected terminating son ($test)")
                                unless ($test == $pid);

                            my $result = $?;
                            $Ret       = $result >> 8;
                            my $signal = $result & 127;
                            my $cd     = $result & 128 ? "with core dump" : "";

                            $self->ABTERM("Execution of '@service' failed $cd: "
                                . "exit=$Ret signal=$signal")
                                if ($Ret or $cd);

                            close($SERVICE);

                        } else {
                            $Ret = scalar($!) ;
                            $self->ABTERM("Can't fork to start '@service': $!")
                                if (defined($XML));
                        }

                        close($XML);

                    } elsif ( $mode == 1 ) {
                        &Debug("Executing '@service' in mode 1: XML as ARGV");
                        # Launch program with full path to a2p xml content
                        # as argument
                        my $pid = fork ;

                        push @service , $A2PXML ;

                        if (defined $pid) {

                            unless ($pid) {
                                # As forked try to exec the program
                                exec @service
                                    or die "Cannot exec '@service': $!\n";
                            }

                            wait ;

                            my $result = $?;
                            $Ret       = $result >> 8;
                            my $signal = $result & 127;
                            my $cd     = $result & 128 ? "with core dump" : "";

                            $self->ABTERM("Execution of '@service' failed $cd: "
                                . "exit=$Ret signal=$signal")
                                if ($Ret or $cd);

                        } else {
                            $Ret = scalar($!) ;
                            $self->ABTERM("Can't fork to start '@service': $!");
                        }

                    } else {
                        $Ret = 20 + scalar($mode) ;
                        $self->ABTERM("E-Service '@service' mode '$mode' " .
                            "is not supported");
                    }

                    # Re-open old STDERR
                    if (defined($OLDERR)) {
                        close(STDERR);
                        open STDERR, '>&', $OLDERR ;

                    } else {
                        undef $errfile ;
                    }

                    undef $OLDERR ;

                } else {
                    $Ret = 19 ;
                    if (defined($conf) and $conf->error) {
                        my @error = $conf->error ;
                        $self->ABTERM("XML conf error $error[0]: $error[1]");
                    }
                    $self->ABTERM("E-Service '$Service' not configurated");
                }

            } elsif ( @Req == 2 and ! -e $Req[1] ) {
                $Ret = 15 ;
                $self->ABTERM("Can't start '$Req[0]' E-Service request " .
                    "without a2p xml content");

            } else {
                $Ret = 10 ;
                $self->ABTERM("Can't understand E-Service request '$req'");
            }

        } else {
            # E-Service can just be simulated
            $Ret = $ESERVICE_ENABLED == 100 ? 0 :
                ( rand($ESERVICE_ENABLED) > 99 ? 1 : 0 ) ;
        }

        # Keep status and log error
        my $status_step = 'o' ;
        my $status = { JID => $Job , STATUS => 'TRANSMITTED' } ;

        if ($Ret) {
            $self->ABTERM("E-Service transmission returned with value $Ret" .
                (($!)? ": $! $? $@" : ""));
            $status->{ABTERM} = 'Not transmitted';
            $status->{STATUS} = 'KO' ;
            $status_step = 'A' ;

            # Try to read STDERR file for an ABTERM
            if (defined($errfile) and -s $errfile) {
                if (open( FILE, '<', $errfile )) {
                    while (<FILE>) {
                        if ( /^ABTERM:(.*)$/i ) {
                            $status->{INFOS} = $1 ;
                            last ;
                        }
                    }
                    close(FILE);
                }
            }
        }

        my ( $JobId ) = $Job =~ /^(.*)-\d+$/ ;
        &a2pjobstate( $JobId || $Job , 10, $status_step, $status )
            or &Info("Can't set job status '$status_step'");

        # Keep internal stats
        $Ret ? &UPSTAT('BAD_E-SERVICE_REQ') : &UPSTAT('GOOD_E-SERVICE_REQ');

        # Return the result
        $self->Return( $Job , $Ret ? $Ret : DONE );
        $self->AnswerDone( $Job );

        # Not processing a job now
        $ENV{JOB} = $self->{JOB} = "" ;

    } else {
        # Keep internal stats
        &UPSTAT('BAD_E-SERVICE_FORMAT');

        $self->ABTERM("Can't understand request '$$ref'");

        $Ret = 9 ;
    }

    return $Ret ? 0 : 1 ;
}

my $XMLCONF ;
sub getconf {
    my $self = shift ;

    # Check file availability
    unless ( -e $ESERVICE_CONF ) {
        $self->ABTERM("E-Service configuration '$ESERVICE_CONF' unavailable");
        return $XMLCONF = undef ;
    }

    # Check if we still have an XML object to handle E-Service configuration
    unless (defined($XMLCONF) and ref($XMLCONF) =~ /^A2P::XML$/ ) {
        &Debug("Creating new XML object to handle E-Service configuration");
        $XMLCONF = new A2P::XML ;
    }

    return $XMLCONF = undef
        unless ($XMLCONF->setDTD('e-service.conf.dtd'));

    $XMLCONF = undef
        unless ( $XMLCONF->parse_file( $ESERVICE_CONF ) eq $ESERVICE_CONF );

    return $XMLCONF ;
}

sub ThreadInit {
    my $self = shift ;

    # Can be only in ABTERM condition
    $self->{STEP} = 10 ;

    # Update PERL5LIB with our @INC list
    $ENV{PERL5LIB} = join(':',@INC);
}

&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");

1;