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

Last change on this file since 3 was 3, checked in by guillaume, 17 years ago
  • AUTHORS: Ajout des différents contributeurs
  • COPYING: Ajout de la licence GPL v3
  • a2p: Préparation des sources pour leur publication sous GPL
  • Property svn:keywords set to Id
File size: 10.1 KB
Line 
1#
2# Copyright (c) 2004-2007 - Consultas, PKG.fr
3#
4# This file is part of A2P.
5#
6# A2P is free software; you can redistribute it and/or modify
7# it under the terms of the GNU General Public License as published by
8# the Free Software Foundation; either version 2 of the License, or
9# (at your option) any later version.
10#
11# A2P is distributed in the hope that it will be useful,
12# but WITHOUT ANY WARRANTY; without even the implied warranty of
13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14# GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License
17# along with A2P; if not, write to the Free Software
18# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
19#
20# $Id: EService.pm 3 2007-10-18 16:20:19Z guillaume $
21#
22
23package A2P::EService ;
24
25# Derived class from Thread.pm
26use base qw(A2P::Thread);
27
28use strict ;
29use integer ;
30use IO::Socket ;
31use A2P::Globals ;
32use A2P::Syslog ;
33use A2P::Com qw( IsCom comJOB comFILE );
34use A2P::XML ;
35use A2P::JobStatus 'a2pjobstate' ;
36
37BEGIN {
38    our $VERSION = sprintf "%s", q$Rev: 885 $ =~ /(\d[0-9.]+)\s+/ ;
39}
40our $VERSION ;
41
42################################################################################
43##             E-Service thread object                                        ##
44################################################################################
45sub Do {
46    my $self = shift ;
47    my $ref  = shift ;
48
49    my $Ret = 0 ;
50    $! = 0 ;
51
52    my $OLDERR ;
53    my $errfile ;
54
55    my @Job = &IsCom( comJOB , $$ref );
56
57    if ( @Job == 2 ) {
58        my ( $Job , $req ) = @Job ;
59
60        &Debug("Received E-Service request for $Job");
61        $ENV{JOB} = $self->{JOB} = $Job ;
62
63        # Keep internal stats
64        &UPSTAT('E-SERVICE_REQ');
65
66        # E-Service main sub-routine connector
67        if ( $ESERVICE_ENABLED < 100 ) {
68            my @service ;
69
70            # Extract the request as comFILE
71            my @Req = &IsCom( comFILE , $req );
72
73            if ( @Req == 2 and -e $Req[1] ) {
74                my ( $Service , $A2PXML ) = @Req ;
75                &Debug("Got request on '$Service' E-Service for $Job job",
76                    "Request comes with '$A2PXML' A2P xml");
77
78                my $conf = $self->getconf ;
79                if ( defined($conf) and @service = $conf->getbin($Service)
80                and ! $conf->error) {
81                    # Service array should be the binary full path plus the
82                    # calling mode:
83                    # mode 0: We should send the A2P xml on the STDIN of program
84                    # mode 1: We should launch program with A2P xml full path as
85                    #         first and only argument
86                    my $mode = pop @service ;
87
88                    # Redirect STDERR to a file
89                    open $OLDERR, ">&", \*STDERR or undef $OLDERR ;
90
91                    if (defined($OLDERR)) {
92                        open STDERR, '>', $errfile = $A2PXML . '.stderr'
93                            or undef $OLDERR ;
94                    }
95
96                    # Unbufferize STDERR
97                    select STDERR ; $| = 1 ; select STDOUT ;
98
99                    if ( $mode == 0 ) {
100                        &Debug("Executing '@service' in mode 0: XML on STDIN");
101                        my $XML ;
102                        # Launch program sending a2p xml content on stdin
103                        unless( open($XML , '<', $A2PXML) ) {
104                            $Ret = scalar($!) ;
105                            $self->ABTERM("Can't open $A2PXML for reading: $!");
106                        }
107
108                        my $SERVICE ;
109                        my $pid = defined($XML) ?
110                            open( $SERVICE, '|-', @service ) : undef ;
111
112                        bless $SERVICE , "IO::Socket" ;
113                        $SERVICE->autoflush(1);
114
115                        if (defined($pid)) {
116                            &Warn("Can't print to '@service' stdin: $!")
117                                  unless print { $SERVICE } <$XML> ;
118
119                            &Debug("Waiting son[$pid] has finished");
120                            my $test = waitpid $pid, 0 ;
121                            &Debug("Son[$pid] has finished");
122
123                            &Warn("Not expected terminating son ($test)")
124                                unless ($test == $pid);
125
126                            my $result = $?;
127                            $Ret       = $result >> 8;
128                            my $signal = $result & 127;
129                            my $cd     = $result & 128 ? "with core dump" : "";
130
131                            $self->ABTERM("Execution of '@service' failed $cd: "
132                                . "exit=$Ret signal=$signal")
133                                if ($Ret or $cd);
134
135                            close($SERVICE);
136
137                        } else {
138                            $Ret = scalar($!) ;
139                            $self->ABTERM("Can't fork to start '@service': $!")
140                                if (defined($XML));
141                        }
142
143                        close($XML);
144
145                    } elsif ( $mode == 1 ) {
146                        &Debug("Executing '@service' in mode 1: XML as ARGV");
147                        # Launch program with full path to a2p xml content
148                        # as argument
149                        my $pid = fork ;
150
151                        push @service , $A2PXML ;
152
153                        if (defined $pid) {
154
155                            unless ($pid) {
156                                # As forked try to exec the program
157                                exec @service
158                                    or die "Cannot exec '@service': $!\n";
159                            }
160
161                            wait ;
162
163                            my $result = $?;
164                            $Ret       = $result >> 8;
165                            my $signal = $result & 127;
166                            my $cd     = $result & 128 ? "with core dump" : "";
167
168                            $self->ABTERM("Execution of '@service' failed $cd: "
169                                . "exit=$Ret signal=$signal")
170                                if ($Ret or $cd);
171
172                        } else {
173                            $Ret = scalar($!) ;
174                            $self->ABTERM("Can't fork to start '@service': $!");
175                        }
176
177                    } else {
178                        $Ret = 20 + scalar($mode) ;
179                        $self->ABTERM("E-Service '@service' mode '$mode' " .
180                            "is not supported");
181                    }
182
183                    # Re-open old STDERR
184                    if (defined($OLDERR)) {
185                        close(STDERR);
186                        open STDERR, '>&', $OLDERR ;
187
188                    } else {
189                        undef $errfile ;
190                    }
191
192                    undef $OLDERR ;
193
194                } else {
195                    $Ret = 19 ;
196                    if (defined($conf) and $conf->error) {
197                        my @error = $conf->error ;
198                        $self->ABTERM("XML conf error $error[0]: $error[1]");
199                    }
200                    $self->ABTERM("E-Service '$Service' not configurated");
201                }
202
203            } elsif ( @Req == 2 and ! -e $Req[1] ) {
204                $Ret = 15 ;
205                $self->ABTERM("Can't start '$Req[0]' E-Service request " .
206                    "without a2p xml content");
207
208            } else {
209                $Ret = 10 ;
210                $self->ABTERM("Can't understand E-Service request '$req'");
211            }
212
213        } else {
214            # E-Service can just be simulated
215            $Ret = $ESERVICE_ENABLED == 100 ? 0 :
216                ( rand($ESERVICE_ENABLED) > 99 ? 1 : 0 ) ;
217        }
218
219        # Keep status and log error
220        my $status_step = 'o' ;
221        my $status = { JID => $Job , STATUS => 'TRANSMITTED' } ;
222
223        if ($Ret) {
224            $self->ABTERM("E-Service transmission returned with value $Ret" .
225                (($!)? ": $! $? $@" : ""));
226            $status->{ABTERM} = 'Not transmitted';
227            $status->{STATUS} = 'KO' ;
228            $status_step = 'A' ;
229
230            # Try to read STDERR file for an ABTERM
231            if (defined($errfile) and -s $errfile) {
232                if (open( FILE, '<', $errfile )) {
233                    while (<FILE>) {
234                        if ( /^ABTERM:(.*)$/i ) {
235                            $status->{INFOS} = $1 ;
236                            last ;
237                        }
238                    }
239                    close(FILE);
240                }
241            }
242        }
243
244        my ( $JobId ) = $Job =~ /^(.*)-\d+$/ ;
245        &a2pjobstate( $JobId || $Job , 10, $status_step, $status )
246            or &Info("Can't set job status '$status_step'");
247
248        # Keep internal stats
249        $Ret ? &UPSTAT('BAD_E-SERVICE_REQ') : &UPSTAT('GOOD_E-SERVICE_REQ');
250
251        # Return the result
252        $self->Return( $Job , $Ret ? $Ret : DONE );
253        $self->AnswerDone( $Job );
254
255        # Not processing a job now
256        $ENV{JOB} = $self->{JOB} = "" ;
257
258    } else {
259        # Keep internal stats
260        &UPSTAT('BAD_E-SERVICE_FORMAT');
261
262        $self->ABTERM("Can't understand request '$$ref'");
263
264        $Ret = 9 ;
265    }
266
267    return $Ret ? 0 : 1 ;
268}
269
270my $XMLCONF ;
271sub getconf {
272    my $self = shift ;
273
274    # Check file availability
275    unless ( -e $ESERVICE_CONF ) {
276        $self->ABTERM("E-Service configuration '$ESERVICE_CONF' unavailable");
277        return $XMLCONF = undef ;
278    }
279
280    # Check if we still have an XML object to handle E-Service configuration
281    unless (defined($XMLCONF) and ref($XMLCONF) =~ /^A2P::XML$/ ) {
282        &Debug("Creating new XML object to handle E-Service configuration");
283        $XMLCONF = new A2P::XML ;
284    }
285
286    return $XMLCONF = undef
287        unless ($XMLCONF->setDTD('e-service.conf.dtd'));
288
289    $XMLCONF = undef
290        unless ( $XMLCONF->parse_file( $ESERVICE_CONF ) eq $ESERVICE_CONF );
291
292    return $XMLCONF ;
293}
294
295sub ThreadInit {
296    my $self = shift ;
297
298    # Can be only in ABTERM condition
299    $self->{STEP} = 10 ;
300
301    # Update PERL5LIB with our @INC list
302    $ENV{PERL5LIB} = join(':',@INC);
303}
304
305&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");
306
3071;
Note: See TracBrowser for help on using the repository browser.