source: A2P/a2p/A2P/BackEnd.pm @ 3

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

package A2P::BackEnd ;

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

use strict ;
use integer ;
use Time::HiRes qw( usleep ) ;
use A2P::Globals ;
use A2P::Syslog ;
use A2P::Com qw( IsCom comJOB comZIP comFILE );

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

################################################################################
##             BackEnd code                                                   ##
################################################################################
sub Do {
    my $self = shift ;
    my $ref  = shift ;

    my $Ret = 0 ;

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

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

        my ( $SigPipe , $SigChild ) = ( 0 , 0 );
        $SIG{PIPE}  = sub { $SigPipe  ++ ; };
        $SIG{CHILD} = sub { $SigChild ++ ; };

        my $ThisCmdId = sprintf("%s-T%sCMD%03d", $Job, $$, $self->{CmdIndex});
        $self->{CmdIndex} = 1 if ( ++ $self->{CmdIndex} > 999 );
        &Debug("Set Id $ThisCmdId to this command");

        # Keep internal stats
        &UPSTAT('CMD-EXEC');

        my $try = 0 ;

        if ( @Job = &IsCom( comZIP , $Cmd ) ) {
            # If we are cleaning making a zip file, we should process differen-
            # tly as file list to zip can be too long for zip command line

            my $command = 'zip -@' .
                ( $COMPRESSFILES ?
                    ( $COMPRESSFILES > 0 and
                        $COMPRESSFILES <= 9 ? $COMPRESSFILES : 1 ) : 0 ) .
                $ZIPOPTIONS . ' ' . $Job[0] ;

            &Debug("Setting $ThisCmdId to '$command'");

            my @files = split( /(?<=file>)(?=<file)/, $Job[1] );

            if ( @files ) {
                &Debug("Sending '$Job[1]' to $ThisCmdId zip process");
                if (defined(open(*CMD , '|' . $command))) {
                    local $\ = "\n" ;
                    foreach my $rawfile ( @files ) {
                        my $file = "" ;
                        unless (( $file ) = &IsCom( comFILE , $rawfile )) {
                            $self->ThisError("Bad file format in file list '" .
                                $Job[1] ."'");
                            $Ret = 260 ; # Ret will be evaluated to 5 later
                            last ;
                        }
                        unless ( $file and print CMD $file ) {
                            $self->ThisError("Can't send '$file' to " .
                                $ThisCmdId . " zip command: $! $?");
                            $Ret = 257 ; # Ret will be evaluated to 2 later
                            last ;
                        }
                    }
                    close(CMD);

                } else {
                    $self->ThisError("Can't open $ThisCmdId: $!");
                    $Ret = 258 ; # Ret will be evaluated to 3 later
                }

            } else {
                $self->ThisError("Bad to zip list format in '$Job[1]'");
                $Ret = 259 ; # Ret will be evaluated to 4 later
            }

        } else {
            &Debug("Starting $ThisCmdId");

            # Try to do command
            my $timeout = time + $BACKEND_RETRYTIMEOUT ;
            while ( $try ++ < $BACKEND_RETRY ) {
                $! = 0 ;
                # Don't retry if command returns as expected
                last unless ( $Ret = system( $Cmd ) );
                &Debug("Try #$try '$Cmd' as it returned $Ret ($!)");
                &UPSTAT('CMD-EXEC-ERR-'.$Ret);
                last if ( time > $timeout );
                usleep $try * $USLEEP ;
            }
        }

        if ($Ret) {
            # update try to real count
            $try -- ;

            &Warn("$Job: $ThisCmdId core dumped") if ($Ret & 128);
            &Info("$Job: $ThisCmdId received signal " . ($Ret & 127))
                if ($Ret & 127);
            $Ret = $Ret >> 8 ;
            $self->ThisError("$ThisCmdId returned with value $Ret after " .
                $try . ($try<2?" try":" tries").(($!)?": '$!'":""));

            # Keep internal stats
            &UPSTAT('CMD-EXEC-FAILED');
            $STATS{'CMD-EXEC-LAST-FAILED'} = $Job . ': ' . $Cmd ;

        } else {
            &Debug("$ThisCmdId received signal " . ($Ret & 127))
                if ($Ret & 127);
            $Ret = DONE ;

            # Keep internal stats
            &UPSTAT('CMD-EXEC-DONE');

        }

        &Debug("SIGPIPE received: $! $? $@") if $SigPipe ;
        wait ;
        &Debug("SIGCHLD received: $! $? $@") if $SigChild ;

        &Debug("$ThisCmdId status = " .
            (defined($means{$Ret}) ? $means{$Ret} : $Ret));
        $self->Return( $Job , $Ret );
        $self->AnswerDone( $Job );

    } else {
        $self->ThisError("Got bad command request '$$ref'");

        $Ret = 9 ;

        if (@Job) {
            # Return exec status even for bad format to not break job processing
            $self->Return( $Job[0] , $Ret );
            $self->AnswerDone( $Job[0] );
        }

        # Keep internal stats
        &UPSTAT('BA-CMD-FORMAT');
    }

    return $Ret == DONE ? 1 : 0 ;
}

sub ThreadInit {
    $_[0]->{CmdIndex} = 1 ;
}

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

1;