source: A2P/a2p/a2p.pl @ 14

Last change on this file since 14 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:executable set to *
  • Property svn:keywords set to Id
File size: 25.7 KB
RevLine 
[3]1#!/usr/bin/perl
2#
3# Copyright (c) 2004-2007 - Consultas, PKG.fr
4#
5# This file is part of A2P.
6#
7# A2P is free software; you can redistribute it and/or modify
8# it under the terms of the GNU General Public License as published by
9# the Free Software Foundation; either version 2 of the License, or
10# (at your option) any later version.
11#
12# A2P is distributed in the hope that it will be useful,
13# but WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15# GNU General Public License for more details.
16#
17# You should have received a copy of the GNU General Public License
18# along with A2P; if not, write to the Free Software
19# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
20#
21# $Id: a2p.pl 3 2007-10-18 16:20:19Z guillaume $
22#
23
24BEGIN {
25    use strict ;
26    use warnings ;
27    use POSIX 'setsid' ;
28    use A2P::Globals ;
29
30    our $VERSION = sprintf "%s", q$Rev: 762 $ =~ /(\d[0-9.]+)\s+/ ;
31
32    if (defined($ENV{JAVA_HOME}) and $ENV{JAVA_HOME}) {
33        # Don't fork if launch by Eclipse, script launcher unset JAVA_HOME
34        $Progname = "a2p-eclipse" ;
35        $MUSTQUIT = 1 ;
36
37    } else {
38        # Daemonize early
39        my $forkpid = 0 ;
40        our $argument = $ARGV[0] || "" ;
41        chdir '/'                      or die "Can't chdir to /: $!";
42        open *STDIN , '<', '/dev/null' or die "Can't read from /dev/null: $!";
43        open *STDOUT, '>', $StdoutFile or die "Can't write to $StdoutFile: $!";
44        defined($forkpid = fork)       or die "Can't fork: $!";
45
46        # Save son PID in system file provided as argument if file exists
47        if ( $forkpid > 0 ) {
48            if ( length($argument) > 0 ) {
49                open *PIDFILE , '>', $argument
50                    or die "Can't open PID file '$argument': $!";
51                print PIDFILE $forkpid ;
52                close(PIDFILE);
53            }
54            # and leave our son alone
55            exit(0);
56        }
57
58        my $priority = getpriority( 0, $$ );
59        if ( $priority < 10 ) {
60            # Increase our priority
61            setpriority 0, 0, $priority + 5
62                or die "Can't update priority: $!" ;
63        }
64    }
65}
66our $VERSION  ;
67our $argument ;
68our $Progname ;
69our $MUSTQUIT ;
70
71#--------------------------------------------------------------------------
72# Here we import any needed modules only after we are in background
73#--------------------------------------------------------------------------
74
75use strict   ;
76use warnings ;
77use integer  ;
78use POSIX qw( :signal_h :sys_wait_h setsid );
79use Time::HiRes qw( usleep gettimeofday tv_interval );
80use A2P::Init    ;
81use A2P::Globals ;
82use A2P::Globals qw( UpdateSharedEnv ) ;
83use A2P::Syslog  ;
84use A2P::Com qw( GetCom IsCom comCOM comREQ comLOG comJOB comDONE );
85use A2P::Signal  ;
86use A2P::threads ;
87use A2P::threads qw(
88    SetNewLogger ThreadsStarter ThreadsChecker THCountAll is_son
89    THCountStopping FromToDoCom CheckChildrenQuitTimeOut is_really_logger
90    threads_internal_updates THList threadSleep reduceSleep
91    ) ;
92use A2P::Thread ;
93use A2P::Logger ;
94use A2P::BackEnd ;
95use A2P::Listener ;
96use A2P::Archiver ;
97use A2P::EService ;
98use A2P::Converter ;
99use A2P::JobManager ;
100use A2P::SpoolManager ;
101use A2P::Signal  'LogSigMessage' ;
102
103&Debug(" Module load error: $! $? $@") if ( $! or $? or $@ );
104&Debug(" =============================START==============================");
105
106&setsid                     or die "Can't set a new session: $!";
107open *STDERR, '>&', *STDOUT or die "Can't redirect STDERR to STDOUT: $!";
108
109#-------------------------------------
110# Here we are in a daemonized process
111#-------------------------------------
112
113&Debug("Current progname = $0, version $VERSION, started");
114&Debug("Setting service name to $Progname");
115# Update system name of this daemon to be pretty with ps command
116$0 = $Progname ;
117
118# Reset error code
119$! = 0 ;
120
121# Declarations in threads.pm
122# Empty Sons/Threads lists and hashs, hash keys are processes PID
123%sons    = () ;
124%HasQuit = () ;
125@answers = () ;
126
127my %requests = () ;
128
129#############################################################################
130sub InitCheck {
131    # AFPSPOOL must be correctly defined and checked at any update
132    unless ( -d $AFPSPOOL ) {
133        &Alert("abterm: AFPSPOOL '$AFPSPOOL' folder doesn't exist");
134        return ++$MUSTQUIT ;
135    }
136
137    # Check needed folders
138    my %Folders = (
139        LOCKID_FOLDER =>  $AFPSPOOL . '/.a2p',
140        SERVICE_TMP   =>  $SERVICE_TMP,
141        SHMDIR        =>  $SHMDIR,
142        ERRORSPOOL    =>  $ERRORSPOOL,
143        DONESPOOL     =>  $DONESPOOL,
144        STATS_FOLDER  =>  $STATS_FOLDER
145        );
146
147    while ( my ($var, $Path) = each(%Folders) ) {
148        unless ( -d $Path ) {
149            &Info("Creating $Path folder as $var");
150            my $Folder = "" ;
151            foreach my $tmp_path ( split(m{[/]+}, $Path) ) {
152                $Folder .= "/$tmp_path" ;
153                mkdir $Folder , oct(775) unless ( -d $Folder );
154                &Error("Can't create '$Path' folder as $var: $!"), last
155                    unless ( -d $Folder );
156            }
157        }
158    }
159
160    # Initialize SERVICE_TMP folder
161    if ( -d $SERVICE_TMP ) {
162        unless ( system("touch $SERVICE_TMP/init_$Progname") == 0 ) {
163            &Error("Can't initialize $SERVICE_TMP folder: $!");
164            $MUSTQUIT = 1 ;
165        }
166
167    } else {
168        &Error("Can't initialize unavailable $SERVICE_TMP folder: $!");
169        $MUSTQUIT = 1 ;
170    }
171
172    # MAXTASK must be greater or equal to 1
173    if ( $MAXTASK < 1 ) {
174        &Info("Setting MAXTASK to 1 as it is lower: ".$MAXTASK);
175        $MAXTASK = 1 ;
176    }
177
178    if ( $MAX_BUFFER_SIZE < 8192 ) {
179        &Info("Setting MAX_BUFFER_SIZE to 8192 as it is lower: " .
180            $MAX_BUFFER_SIZE );
181        $MAX_BUFFER_SIZE = 8192 ;
182    }
183
184    # Test opening logfile in case of file logging
185    if ( $LOGFILENAME and ( $LOGFILE_VS_SYSLOG or $DEBUG_IN_FILE )) {
186        $! = 0 ;
187        unless (open(*LOG, '>', $LOGFILENAME)) {
188            $LOGFILE_VS_SYSLOG = 0 ;
189            $DEBUG_IN_FILE     = 0 ;
190            return &Error("Can't open '$LOGFILENAME': $!");
191        }
192
193        if ( $LOGFILE_PURGE ) {
194            &UPSTAT('PURGE-LOG');
195            truncate LOG , 0 ;
196            $LOGFILE_PURGE = 0 ;
197        }
198
199        close(LOG);
200    }
201
202    # Reset Debug comportement
203    &ResetDebug() ;
204
205    &threads_internal_updates();
206}
207################################################################################
208
209&InitCheck ;
210
211$STATS{'A2P-VERSION'} = A2P_RPM_VERSION ;
212
213$maintid = $$ ;
214
215map {
216    if ( ! $MUSTQUIT and &ThreadsStarter( $_ , 1 ) != $SonKind{$_} * $MAXTASK ) {
217        &Error("Fatal error can start a thread");
218        $MUSTQUIT ++ ;
219    }
220} keys(%SonKind) ;
221
222&Debug(&THCountAll . " modules started");
223
224&SetNewLogger(-1) if (&THCountAll); # First logger initialization
225
226my ( $Get, @Temp, $MaxAnswers, $busyby, @RollChilds, @KeptAnswers );
227my %LastGetRequests ;
228my @MarkTimer = &gettimeofday() ;
229$started = 0 ;
230my %logtimeout = () ;
231my $lastcheck  = [ &gettimeofday() ];
232my $SleepFactor = 1 ;
233
234# Empty lists to rotate getanswers other childs and to keep answers
235@KeptAnswers = () ;
236@RollChilds  = () ;
237
238$MaxAnswers = $COM_BURST ? 100 * $COM_BURST : 100 ;
239
240# Hack to handle some rare cut answer
241my @bad_answer = () ;
242
243# Threads handler will loop only if threads are availables
244while ( keys(%sons) and ! $MUSTQUIT ) {
245    &TIMESTAT('MainLoop');
246
247    &LogSigMessage();
248
249    A2P::Thread::self_TEST() if $do_test ;
250
251    @MarkTimer = &gettimeofday() , &Info("---MARK---")
252        unless ( &tv_interval(\@MarkTimer) < 1800 );
253
254    #######################
255    # Check communication
256    #######################
257
258    # First get any new Com from childs
259    # 1. Update our child list if empty
260    @RollChilds = keys(%sons) unless @RollChilds ;
261
262    # 2. Update answers list if not full and when we have child to getanswers
263    while ( @RollChilds ) {
264        my $OneSon = shift @RollChilds ;
265        next unless &is_son($OneSon);
266        next if ( @answers > $MaxAnswers
267            and defined($LastGetRequests{$OneSon})
268            and &tv_interval($LastGetRequests{$OneSon}) < 2 );
269        $LastGetRequests{$OneSon} = [ &gettimeofday() ];
270        my @SonAnswers = $sons{$OneSon}->getAnswers() ;
271        push @answers , @SonAnswers ;
272        &UPSTAT('GETANSWERS', scalar(@SonAnswers));
273    }
274
275    # 3. Only sleep when have nothing to tell or to few new request has arrived
276    &UPSTAT('LOOPS');
277    @answers ? &reduceSleep() : &threadSleep() ;
278
279    # 4. Reintegrate last kept answers to the end only if we have not
280    #    something more urgent to do
281    # By default we will read current answers
282    if (@KeptAnswers) {
283        $LastGetRequests{'KeptAnswers'} = [ &gettimeofday() ]
284            unless (defined($LastGetRequests{'KeptAnswers'}));
285
286        if ( ! @answers or &tv_interval($LastGetRequests{'KeptAnswers'})>= 1 ) {
287            push @answers, @KeptAnswers ;
288            @KeptAnswers = () ;
289            $LastGetRequests{'KeptAnswers'} = [ &gettimeofday() ];
290        }
291    }
292
293    &MAXSTAT('answers-KEPT',scalar(@KeptAnswers));
294    &MAXSTAT('answers-COUNT',scalar(@answers));
295
296    # 5. Then check COM_BURST answers max
297    my $max = $COM_BURST ;
298    while ( $max --  and defined( $Get = shift @answers )) {
299        chomp($Get);
300
301        my ( $Id , $Req ) = &IsCom( comCOM , $Get );
302
303        # 6. Empty COM should not exist but just in case
304        unless ( $Get ) {
305            &debugdev("Skipping unexpected empty COM '$Get'");
306            next ;
307        }
308
309        # 7. Check $Get is really a COM
310        unless ( defined($Id) and defined( $Req ) ) {
311            if ($Get =~ /^[<]/) {
312                my $ref ;
313                &UPSTAT('COM-CHECK-FRAGMENT');
314                # Control this com is still not handled
315                if (($ref) = grep { $_->[0] eq $Get } @bad_answer ) {
316                    # Don't keep too much time
317                    next if (++ $ref->[1] < 100);
318
319                } else {
320                    # Will try to reassemble a fragmented com
321                    push @bad_answer, [ $Get, 0 ] ;
322                    next ;
323                }
324
325            } elsif (@bad_answer) {
326                # Try to assemble and reinject immediatly
327                my $try = shift @bad_answer ;
328                unshift @answers, $try->[0] . $Get ;
329                &Info("Trying reassembled com: " . $try->[0] . $Get);
330                &UPSTAT('COM-REASSEMBLED');
331                next ;
332            }
333
334            &Error("[DEV] Can't understand answer '$Get'");
335            &UPSTAT('COM-BAD-FRAGMENT');
336            next ;
337        }
338
339        # 8. Check if we just got a number as COM shortcut
340        if ( $Req =~ /^\d+$/ ) { # Got a scalar
341            &UPSTAT('GETNUMCOM');
342
343            if ( $Req == QUIT ) {
344                &UPSTAT('GETQUITCOM');
345
346                # Should now delete this thread from list
347                if (&is_son($Id)) {
348                    &Debug("Received QUIT from " . $sonname{$Id} );
349
350                    $HasQuit{$Id} = $sonname{$Id} ;
351
352                    # A thread has quit, so we must restart it unless
353                    #  we are quitting or we have ask it to stop
354                    if ($sons{$Id}->StoppingSince()) {
355                        $sons{$Id}->Delete();
356
357                    } else {
358                        my $kind = $sons{$Id}->getKind ;
359                        $sons{$Id}->Delete();
360                        unless ( $do_quit or $MUSTQUIT ) {
361                            &ThreadsChecker( $kind );
362                            &Info("Module $kind restarted");
363                        }
364                    }
365
366                } else {
367                    # Check threads later in we need to restart some child
368                    $do_check ++ ;
369                    &Debug("Received QUIT from " . $sonname{$Id} .
370                        ", should check what's happened");
371                }
372
373            } elsif (&is_son($Id)) {
374                if ( $Req == PING ) {
375                    &UPSTAT('GETPINGCOM');
376
377                    &Debug("Received PING from " . $sonname{$Id} );
378                    $sons{$Id}->GotPing();
379
380                } elsif ( $Req == _INIT ) {
381                    &UPSTAT('GETINITCOM');
382
383                    &Debug("Received INIT from " . $sonname{$Id} );
384                    $sons{$Id}->GotInit();
385
386                } elsif ( $Req == comDONE ) {
387                    &UPSTAT('GETCOMDONE');
388
389                    &Debug("Received comDONE from " . $sonname{$Id} )
390                        if $ADVANCED_DEBUGGING ;
391                    $sons{$Id}->ResetRemoteBufSize();
392
393                } else {
394                    &UPSTAT('GETBADCOM');
395
396                    &Error("[DEV] Don't understand com '$Get' as Req=" .
397                        ( defined($means{$Req}) ? $means{$Req} : $Req ) .
398                        " from " . $sonname{$Id} );
399                }
400
401            } elsif (defined($HasQuit{$Id})) {
402                if ($HasQuit{$Id}) {
403                    &UPSTAT('GETDEADCOM');
404
405                    # Son still has QUIT and is deleted
406                    &Debug("Received Req=" .
407                        ( defined($means{$Req}) ? $means{$Req} : $Req ) .
408                        " from dead thread T$Id" );
409
410                } else {
411                    &UPSTAT('GETBADCOM');
412
413                    &Error("[DEV] Received Req=" .
414                        ( defined($means{$Req}) ? $means{$Req} : $Req ) .
415                        " for thread T$Id" );
416                }
417
418            } else {
419                &UPSTAT('GETBADCOM');
420
421                &Error("[DEV] Unsupported com '$Get' as Req=" .
422                    ( defined($means{$Req}) ? $means{$Req} : $Req ) .
423                    " from thread T$Id" );
424            }
425
426            # Numeric COM analysed so looping on next answer
427            next ;
428        }
429
430        # 9. Manage log message:
431        # 9.1. Enqueue log message if still have some
432        # 9.2. Transmit to logger if running
433        # 9.3. Do our self the log when logger is not available
434        if ( @Temp = &IsCom( comLOG , $Req )) {
435            &UPSTAT('GETLOGCOM');
436            unless ( @Temp == 2 and $Temp[1] ) {
437                &UPSTAT('BAD-LOGCOM');
438                &Debug("Found bad log request '$Req'");
439                next ;
440            }
441
442            if (&is_really_logger($loggertid)) {
443                # 9.2. Just transmit log to logger
444                $sons{$loggertid}->AskThread( TODO , $Req );
445
446            } else {
447                # 9.3. Finally try to log directly if Logger not available
448                &SetNewLogger(0) if $loggertid ;
449                &DirectLog( $Temp[0] , [ $Temp[1] ] , "MAIN:" );
450            }
451            next ;
452        }
453
454        # 10. Manage requests from ourself, JobManager and Listener
455        if ( @Temp = &IsCom( comREQ , $Req )) {
456            &UPSTAT('GETREQCOM');
457            unless ( @Temp == 2 and $Temp[1] ) {
458                &UPSTAT('GETBADREQCOM');
459                &Debug("Found bad REQ request '$Req'");
460            }
461
462            if (&is_son($Id) or $Id == $$) {
463                &Debug((($Id == $$)? "I am" : $sonname{$Id} . " is" )
464                    . " requesting $Temp[1] to $Temp[0]");
465
466                # if @threads list is empty we don't find available thread
467                unless ( &FromToDoCom( $Id , @Temp ) ) {
468                    &UPSTAT('BUSY-MODULE');
469
470                    &Debug("No $Temp[0] thread available, keep request");
471                    push @KeptAnswers , $Get ;
472                }
473
474            } elsif (defined($HasQuit{$Id})) {
475                if ($HasQuit{$Id}) {
476                    &UPSTAT('GETDEADREQCOM');
477                    # Son still has QUIT and is deleted, still try to send it if
478                    # it is for JobManager
479                    if ($Temp[0] =~ /^JobManager$/) {
480                        &Debug("Transmitting request $Temp[1] from dead " .
481                            $sonname{$Id} . " to $Temp[0] thread as myself");
482                        unshift @answers , &GetCom( comCOM, $$ => $Req );
483
484                    } else {
485                        &Debug("Won't transmit request $Temp[1] from dead " .
486                            $sonname{$Id} . " to $Temp[0] thread");
487                    }
488
489                } else {
490                    &UPSTAT('GETBADREQCOM');
491                    &Error("Can't transmit request $Temp[1] from " .
492                        $sonname{$Id} . " to $Temp[0] thread");
493                }
494
495            } else {
496                &UPSTAT('GETBADREQCOM');
497                &Error("[DEV] Unsupported req $Temp[1] from " .
498                    $sonname{$Id} . " to $Temp[0]");
499            }
500            next ;
501        }
502
503        # 11. Com should come from still alive thread
504        if ( ! &is_son($Id) ) {
505            &Info("Forgetting com $Req as " . $sonname{$Id} . " is dead");
506
507        # 12. Manage answers from busy threads BackEnd, SpoolManager, Converter
508        #     and Archivage
509        } elsif ( $busyby = $sons{$Id}->isBusyBy ) {
510            # 12.a This must be an answer for another thread
511            @Temp = &IsCom( comJOB , $Req );
512
513            # 12.b Handle JOB comDONE
514            if ( @Temp and &IsCom( comDONE , $Temp[1] )) {
515                # Cancel business only when we receive a comDONE
516                &Debug("JobDone received from " . $sonname{$Id} );
517                $sons{$Id}->setReady();
518                # Thread is now ready to receive another request
519
520            # 12.c Check business is not lost
521            } elsif (defined($HasQuit{$busyby})) {
522                &UPSTAT('DEAD-REQUESTER');
523
524                if ($HasQuit{$busyby}) {
525                    # Son still has QUIT and is deleted
526                    &Debug("Delete answer $Req from T$Id to dead $busyby");
527
528                } else {
529                    &Error("Delete request $Req from T$Id to ghost $busyby");
530                }
531
532            } elsif ( $busyby == $$ ) {
533                # This is an answer for parent thread
534                if ( $Req =~ /^started$/i and &is_son($Id)) {
535                    if ($sons{$Id}->is('JobManager')) {
536                        &Info("$Progname service v".A2P_RPM_VERSION." started");
537                        &FromToDoCom( $$ , Listener => 'STARTED' )
538                            or &Error("Can't tell Listener we are started");
539
540                    } elsif ($sons{$Id}->is('Listener')) {
541                        &Debug("Listener is informed we have started");
542
543                    } else {
544                        &debugdev("Bad STARTED answer from " . $sonname{$Id});
545                    }
546                    $sons{$Id}->setReady ;
547
548                } else {
549                    &debugdev("Found '$Req' answer from " . $sonname{$Id});
550                }
551
552            } else {
553                &debugdev("Bad answer $Req from T$Id and for T$requests{$Id}");
554            }
555
556            next ;
557        }
558
559        # We should never come there
560        &UPSTAT('GETBADCOM');
561        &debugdev("'$Req' from " . $sonname{$Id} . " no more supported");
562        &debugdev("Next com to get is '$answers[0]'") if (defined($answers[0]));
563        &debugdev("Then com will be '$answers[1]'")   if (defined($answers[1]));
564
565    } # Loop on COMBURST answers
566
567    #######################
568    # Check flags
569    #######################
570
571    # Quit only when no job is being converted, and we're not still quitting
572    # Any Job in error will be lost
573    if ($MAXTASK and $do_quit ) {
574        if ( $do_quit == 1 ) {
575            &Info("Waiting until threads have quit");
576
577            # Divide USLEEP by 2 to accelerate communications
578            $USLEEP >>= 1 ;
579
580            # Firstly, ask JobManager to not do any more jobs by
581            # setting its MAXJOBS env to 0, it should quit when lasts are done
582            map {
583                $sons{$_}->AskInit('$ENV{MAXJOBS} = 0');
584                $sons{$_}->AskInit('CAN_UPDATE_NOW');
585            } &THList('JobManager') ;
586
587            # Secondly, ask threads to update USLEEP
588            map {
589                $sons{$_}->AskInit('$ENV{USLEEP} = ' . $USLEEP);
590            } keys(%sons) ;
591
592            $do_quit ++ ;
593
594        } elsif ( $do_quit == 2 ) {
595            # Secondly, just check if JobManager has quit before switching
596            # To normal quit
597            $do_quit ++ unless &THList('JobManager');
598
599        } else {
600            # Normal quit by asking all processes to quit
601
602            &Debug("Setting MAXTASK to 0");
603            $MAXTASK = 0 ;
604
605            &Debug("Asking threads to stop");
606            map {
607                $sons{$_}->AskToStop()
608                    or &Info("Can't asking " . $sonname{$_} . " to quit")
609            } keys(%sons) ;
610
611            &SetNewLogger(0);
612
613            # We can safely activate debugging when quitting is requested
614            $NO_SYSLOG_DEBUG = 0 if $SERVICE_DEBUG ;
615        }
616
617    } elsif ( $do_quit > 4 ) {
618        $MUSTQUIT ++ ;
619
620    } elsif ( $do_quit ) {
621        &CheckChildrenQuitTimeOut() ;
622    }
623
624    if ($Childquit) {
625        my $pid = 0 ;
626        &Debug("$Childquit SIGCHLD received");
627        while ($Childquit > 0 and ! $MUSTQUIT and $pid = waitpid(-1,&WNOHANG)) {
628            &Debug("SIGCHLD with pid = $pid");
629            last if ( $pid < 0 );
630            if (defined($sons{$pid})) {
631                $Childquit -- ;
632
633                my $kind = $sons{$pid}->getKind ;
634                my $isLogger = $sons{$pid}->is('Logger');
635
636                # Get answers just in case we missed last QUIT
637                push @answers , $sons{$pid}->getAnswers ;
638
639                &Debug($kind."[".$sonname{$pid}."] returns with code ".($?>>8));
640
641                &SetNewLogger(0) if $isLogger ;
642
643                # We should better push the pid in a list to check it elsewhere
644                $HasQuit{$pid} = $sonname{$pid} ;
645
646                # Check if we need to restart the thread
647                if ( ! $do_quit and ! $MUSTQUIT ) {
648                    if (&ThreadsChecker( $kind )) {
649                        &Info("Module $kind thread restarted");
650                        &SetNewLogger(-1) if $isLogger ;
651
652                    } else {
653                        &Alert("Aborting as I can't restart $kind thread");
654                        $do_quit ++ ;
655                    }
656                }
657            }
658            &Debug("T$pid has terminated");
659        }
660        $do_check ++ unless ( $Childquit > 0 or $do_quit or $MUSTQUIT );
661        $Childquit = 0 ;
662    }
663
664    if ($MAXTASK and $do_init) { # >0 after HUP signal has been received
665        $do_init = 0 ;
666
667        # Reload configuration
668        my @Updates = &Init() ;
669
670        if (@Updates) {
671            # First update ourself
672            map { eval "$_" } @Updates ;
673            &UpdateSharedEnv ;
674            &InitCheck ;
675
676            # And transmit to children any modification
677            map {
678                my $tid = $_ ;
679                map { $sons{$tid}->AskInit($_) } @Updates, 'CAN_UPDATE_NOW' ;
680            } keys(%sons) ;
681
682            # Here we can have to load some threads or
683            # unload some so just check threads
684            $do_check ++ ;
685        }
686
687        # Now we can start has threads are initialized
688        if ( ! $started ++ ) {
689            unless (&FromToDoCom( $$ , JobManager => 'START' )) {
690                &Error("Can't ask JobManager to start, aborting");
691                $do_quit ++ ;
692            }
693        }
694
695        $MaxAnswers = $COM_BURST ? 1000 * $COM_BURST : 1000 ;
696    }
697
698    $do_check ++ if ( &tv_interval($lastcheck) - 5 > 0 );
699
700    if ($MAXTASK and $do_check and ! $do_quit and ! $MUSTQUIT) {
701
702        $do_check = 0 ;
703        $lastcheck = [ &gettimeofday() ];
704
705        # Call checker only for threads not still in check mode but also
706        # force check when quitting as this is the way to advertize threads
707        map {
708            if ( $sons{$_}->isToCheck ) {
709                $do_ping ++ ;
710                &Debug("Checking " . $sonname{$_} . "...");
711                $sons{$_}->Check() if $sons{$_}->isAlive();
712            }
713        } keys(%sons) ;
714        &Debug("No thread to check") unless $do_ping ;
715
716        # Also check threads numbers
717        &ThreadsChecker();
718    }
719
720    if ($MAXTASK and $do_ping) {
721        map {
722            if ( $sons{$_}->Ping() ) {
723                &Debug("Ping " . $sonname{$_} . " thread");
724                $do_ping -- ;
725            }
726        } keys(%sons);
727    }
728
729}
730
731# Be sure to keep debugging information when stopping
732$NO_SYSLOG_DEBUG = 0 ;
733
734&LogSigMessage ;
735# Do some check while quitting
736&Debug(&THCountStopping . " modules stopping") if &THCountStopping;
737if ( &THCountAll ) {
738    &Debug(&THCountAll . " modules running, asking them to stop");
739    map {
740        $sons{$_}->AskToStop()
741            or &Info("Can't asking " . $sonname{$_} . " to quit")
742    } keys(%sons) ;
743}
744&Info("$Progname service is stopping");
745
746# Wait until every child has quit
747while ( &THCountAll or &THCountStopping ) {
748    &CheckChildrenQuitTimeOut() unless $Childquit ;
749    @MarkTimer = &gettimeofday() , &Debug("---QUITTING---")
750        unless ( &tv_interval(\@MarkTimer) < 1 );
751    &Debug("$Childquit SIGCHLD received") if $Childquit ;
752    while ( $Childquit > 0 ) {
753        $Childquit -- ;
754        my $pid ;
755        while ( $pid = waitpid(-1,&WNOHANG) ) {
756            last unless ( $pid > 0 and defined($sonname{$pid}));
757            delete $sons{$pid};
758            &Debug("$sonname{$pid} has terminated");
759            $HasQuit{$pid} = $sonname{$pid};
760        }
761    }
762    $Childquit = 0 if ( $Childquit < 0 );
763    usleep $USLEEP ;
764}
765
766while ( my $pid = wait ) {
767    last if ( $pid < 0 );
768    delete $sons{$pid} if (defined($sons{$pid}));
769    &Debug("T$pid has terminated");
770}
771
772unlink $LISTENER if ( -S $LISTENER );
773if (defined($argument)) {
774    &Debug("PID file = '$argument'");
775
776    # Delete our PID in PID file
777    open *RET , '>', $argument or die "Can't open PID file '$argument': $!" ;
778    print RET "0" ;
779    close(RET);
780}
781
782&LogSigMessage ;
783&Info("$Progname service stopped");
784
785exit(0);
786
787END {
788    # Output statistics when quitting from a disgnostic service
789    A2P::Thread::self_TEST() if ($Progname =~ /^diagnostics/);
790
791    $$ == $maintid ?
792    &Debug("=============================QUIT===============================")
793    :
794    &Debug($0 . "[$$] =====QUIT=====");
795}
Note: See TracBrowser for help on using the repository browser.