source: A2P/a2p/a2p-stat.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: 27.0 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-stat.pl 3 2007-10-18 16:20:19Z guillaume $
22#
23# Simple service to synchronize Job STATISTICS with a DB
24#
25
26BEGIN {
27    use strict ;
28    use warnings ;
29    use POSIX 'setsid' ;
30    use A2P::Globals ;
31
32    our $VERSION = sprintf "%s", q$Rev: 415 $ =~ /(\d[0-9.]+)\s+/ ;
33
34    if (defined($ENV{JAVA_HOME}) and $ENV{JAVA_HOME}) {
35        # Don't fork if launch by Eclipse, script launcher unset JAVA_HOME
36        $Progname = "a2p-eclipse" ;
37        $MUSTQUIT = 1 ;
38
39    } else {
40        # Daemonize early
41        my $forkpid = 0 ;
42        our $argument = $ARGV[0] || "" ;
43        chdir '/'                      or die "Can't chdir to /: $!";
44        open *STDIN , '<', '/dev/null' or die "Can't read from /dev/null: $!";
45        open *STDOUT, '>', $StdoutFile or die "Can't write to $StdoutFile: $!";
46        defined($forkpid = fork)       or die "Can't fork: $!";
47
48        # Save son PID in system file provided as argument if file exists
49        if ( $forkpid > 0 ) {
50            if ( length($argument) > 0 ) {
51                open *PIDFILE , '>', $argument
52                    or die "Can't open PID file '$argument': $!";
53                print PIDFILE $forkpid ;
54                close(PIDFILE);
55            }
56            exit(0);
57        }
58    }
59}
60our $VERSION  ;
61our $argument ;
62our $Progname ;
63our $MUSTQUIT ;
64
65#--------------------------------------------------------------------------
66# Here we import any needed modules only after we are in background
67#--------------------------------------------------------------------------
68
69use strict   ;
70use warnings ;
71use Socket ;
72use IO::Socket ;
73use Fcntl ;
74use Fcntl qw(:flock);
75use GDBM_File ;
76use POSIX qw( :signal_h :sys_wait_h setsid );
77use Time::HiRes qw( usleep gettimeofday tv_interval );
78use A2P::Init   ;
79use A2P::Globals;
80use A2P::Syslog ;
81use A2P::Signal ;
82use A2P::Thread ;
83use A2P::Signal 'LogSigMessage' ;
84use A2P::DB ;
85use A2P::DB qw(
86    a2p_db_statistics_ready CheckJobsTables stats_set_service stats_jobmanager
87    stats_converter check_commit
88    );
89
90&Debug(" Module load error: $! $? $@") if ( $! or $? or $@ );
91&Debug(" =============================START==============================");
92
93&setsid                     or die "Can't set a new session: $!";
94open *STDERR, '>&', *STDOUT or die "Can't redirect STDERR to STDOUT: $!";
95
96#-------------------------------------
97# Here we are in a daemonized process
98#-------------------------------------
99
100&Debug("Current progname = $0, version $VERSION, started");
101&Debug("Setting service name to $Progname");
102# Update system name of this daemon to be pretty with ps command
103$0 = $Progname ;
104
105# Reset error code
106$! = 0 ;
107
108# Here constant
109my $dbmbase = "statistics.dbm" ;
110
111# First forked process is the master
112my $MASTER = 1 ;
113
114# Empty Sons/Threads lists and hashs, hash keys are processes PID
115# PID -> Managed folder
116my %sons = () ;
117my $LCK ;
118my $UNIXSOCK ;
119my %FILES = () ; # Hash to tie
120my $pid ;
121
122################################################################################
123### Only called from Main loop
124################################################################################
125sub CheckThreads {
126
127    my %known = () ;
128    map { $known{$_} = 0 } values(%sons) ;
129
130    while ( $MASTER and @_ ) {
131        $STATS_FOLDER = shift ;
132        next unless (defined($STATS_FOLDER) and $STATS_FOLDER);
133
134        # Skip still managed folder
135        if (defined($known{$STATS_FOLDER})) {
136            &Debug("Skipping still managed '$STATS_FOLDER' folder");
137
138        } else {
139            # Set some file name
140            my $unixname = $SERVICE_TMP . "/" . $dbmbase . '-' .$$. '_' .time ;
141            my $dbmname = $STATS_FOLDER . "/." . $dbmbase ;
142            my $lockname = $dbmname . ".LCK" ;
143
144            # First try to lock the lock file if exists
145            if ( -e $lockname ) {
146                &Debug("Checking why lock file still exists...");
147                if (open($LCK,$lockname)) {
148                    if (flock($LCK, LOCK_EX | LOCK_NB)) {
149                        flock($LCK, LOCK_UN);
150                        close($LCK);
151                        &Debug("Removing $lockname lock file on '$STATS_FOLDER'"
152                            . " as it is not used");
153                        unlink $lockname ;
154
155                    } else {
156                        &Debug("Still managed  by other thread " .
157                            " as I can't lock on '$lockname': $!");
158                    }
159
160                } else {
161                    &Error("Can't open lock file on '$STATS_FOLDER': $!");
162                }
163            }
164
165            if ( -e $lockname and -e $dbmname ) {
166                &Info("'$STATS_FOLDER' statistics manager seems still present");
167                $lockname = "" ;
168                my $tied = tie( %FILES,'GDBM_File',$dbmname,GDBM_READER,0666 );
169                if (defined($tied)) {
170                    $pid = $FILES{'PID'} ;
171                    my $sockname = $FILES{'SOCKET'} ;
172                    if (socket(SOCK, PF_UNIX, SOCK_STREAM, 0)) {
173                        if (-S $sockname
174                        and connect(SOCK, pack_sockaddr_un($sockname))) {
175                            $SIG{'ALRM'} = sub { close(SOCK) } ;
176                            alarm 5 ; # Get response until 5 seconds
177                            kill 12 , $pid ;
178                            my @messages = <SOCK> ;
179                            alarm 0 ;
180                            close(SOCK);
181                            my $last = pop @messages || "" ;
182                            &Debug("Got '$last' message on '$sockname'");
183                            $last =~ m|^<active\s+time=['](\d+)[']/>$| ;
184                            if (defined($1) and time - $1 < 60) {
185                                &Info("'$STATS_FOLDER' statistics manager " .
186                                    "still available as process $pid");
187                                $sons{$pid} = $STATS_FOLDER ;
188
189                            } else {
190                                &Info("'$STATS_FOLDER' statistics manager seems"
191                                    . " unavailable, trying to start another");
192                                $lockname = $dbmname . ".LCK" ;
193                            }
194
195                        } elsif (-S $sockname) {
196                            &Error("Can't connect to '$sockname' socket: $!");
197
198                        } else {
199                            &Info("'$STATS_FOLDER' statistics manager seems " .
200                                "not listening, trying to launch another one");
201                            $lockname = $dbmname . ".LCK" ;
202                        }
203
204                    } else {
205                        &Error("Can't create an unix socket: $!");
206                    }
207
208                } else {
209                    &Error("Can't open tied file $dbmname for reading: $!");
210                }
211
212                # Remove lock file if set again
213                unlink $lockname if $lockname ;
214            }
215
216            if ($lockname) {
217                &Info("Trying to start '$STATS_FOLDER' statistics manager");
218                if (open($LCK,">$lockname")) {
219                    if (flock($LCK, LOCK_EX | LOCK_NB)) {
220                        if (defined(tie ( %FILES, 'GDBM_File', $dbmname,
221                                          GDBM_WRCREAT, 0666 ))) {
222                            # Now we can fork as pre-init is done
223                            $pid = fork ;
224                            if (defined($pid)) {
225                                if ($pid) {
226                                    # In parent = master
227                                    $sons{$pid} = $STATS_FOLDER ;
228                                    untie %FILES ;
229                                    close($LCK);
230
231                                    &Debug("'$STATS_FOLDER' statistics manager"
232                                        . "forked");
233
234                                } else {
235                                    # In statistics manager
236                                    &InitStatistics($unixname);
237                                    &Info("'$STATS_FOLDER' statistics manager"
238                                        . " started");
239                                }
240
241                            } else {
242                                &Error("$STATS_FOLDER manager not forked: $!");
243                                untie %FILES ;
244                                flock($LCK, LOCK_UN);
245                                close($LCK);
246                            }
247
248                        } else {
249                            &Error("Can't open tied hash file '$dbmname': $!");
250                            flock($LCK, LOCK_UN);
251                            close($LCK);
252                        }
253
254                    } else {
255                        &Error("Can't lock folder '$STATS_FOLDER'" .
256                            "on '$lockname': $!");
257                        close($LCK);
258                    }
259
260                } else {
261                    &Error("Can't open '$lockname' lock file: $!");
262                }
263
264            } else {
265                &Info("Can't start '$STATS_FOLDER' statistics manager");
266            }
267        }
268
269        # Now we know this folder is managed
270        $known{$STATS_FOLDER} = 1 ;
271    }
272
273    if ($MASTER) {
274        # Check to stop no more needed threads
275        foreach my $folder ( grep { ! $known{$_} } keys(%known) ) {
276            &Info("Stopping synchronization of statistics from '$folder'");
277
278            ( $pid ) = grep { $sons{$_} eq $folder } keys(%sons) ;
279            next unless (defined($pid));
280            &Debug("Sending SIGTERM to T$pid");
281            kill 15 , $pid ;
282        }
283
284    } else {
285        # Free not used memory in son
286        undef %sons ;
287    }
288}
289
290sub InitCheck {
291
292    # Read conf
293    $do_init = 0 ;
294    &Init ;
295
296    # List statistics folders
297    my @STATS_FOLDERS = () ;
298    if ( $STATS_FOLDER =~ /:/ ) {
299        @STATS_FOLDERS = split(/:/,$STATS_FOLDER) ;
300
301    } else {
302        @STATS_FOLDERS = ( $STATS_FOLDER ) ;
303    }
304
305    # Check needed folders
306    my %Folders = (
307        SERVICE_TMP  =>  $SERVICE_TMP,
308        SHMDIR       =>  $SHMDIR
309        );
310
311    while ( my ($var, $Path) = each(%Folders) ) {
312        unless ( -d $Path ) {
313            &Info("Creating $Path folder as $var");
314            my $Folder = "" ;
315            foreach my $tmp_path ( split(m{[/]+}, $Path) ) {
316                $Folder .= "/$tmp_path" ;
317                mkdir $Folder , oct(775) unless ( -d $Folder );
318                &Error("Can't create '$Path' folder as $var: $!"), last
319                    unless ( -d $Folder );
320            }
321        }
322    }
323
324    # Initialize SERVICE_TMP folder
325    if ( -d $SERVICE_TMP ) {
326        unless ( system("touch $SERVICE_TMP/init_$Progname") == 0 ) {
327            &Error("Can't initialize $SERVICE_TMP folder: $!");
328            $MUSTQUIT = 1 ;
329        }
330
331    } else {
332        &Error("Can't initialize unavailable $SERVICE_TMP folder: $!");
333        $MUSTQUIT = 1 ;
334    }
335
336    # Test opening logfile in case of file logging
337    if ( $LOGFILENAME and ( $LOGFILE_VS_SYSLOG or $DEBUG_IN_FILE )) {
338        $! = 0 ;
339        unless (open(LOG,">$LOGFILENAME")) {
340            $LOGFILE_VS_SYSLOG = 0 ;
341            $DEBUG_IN_FILE     = 0 ;
342            return &Error("Can't open '$LOGFILENAME': $!");
343        }
344
345        if ( $LOGFILE_PURGE ) {
346            &UPSTAT('PURGE-LOG');
347            truncate LOG , 0 ;
348            $LOGFILE_PURGE = 0 ;
349        }
350
351        close(LOG);
352    }
353
354    # Reset Debug comportement
355    &ResetDebug() ;
356
357    &CheckThreads(@STATS_FOLDERS);
358
359    # @STATS_FOLDERS will be check in sons
360    return @STATS_FOLDERS ;
361}
362
363################################################################################
364### Only called from Forked loop
365################################################################################
366my %FH ;
367my %FH_TIMEOUT ;
368
369sub InitStatistics {
370    my $unixname = shift ;
371
372    $0 .= "-thread" ;
373    $MASTER = 0 ;
374    $SIG{'USR2'} = \&SigUSR2 ;
375
376    $FILES{'PID'} = $$ ;
377
378    if (&openUNIXSOCK($unixname)) {
379        $FILES{'SOCKET'} = $unixname ;
380
381    } else {
382        $FILES{'SOCKET'} = "" ;
383    }
384
385    # Synchronise %FILES with %FH
386    foreach my $file (keys(%FILES)) {
387        next if ($file =~ /^(SOCKET|PID)$/);
388        my $fullpathfile = "$STATS_FOLDER/$file" ;
389        if ( -e $fullpathfile and ! -d $fullpathfile ) {
390            $FH{$file} = 0 ;
391
392        } else {
393            delete $FILES{$file} ;
394            delete $FH_TIMEOUT{$file} ;
395        }
396    }
397}
398
399# Do some statistics load timing
400my @LastLoadCheck = &gettimeofday() ;
401my $LoadedLines = 0 ;
402my $activity = 0 ;
403
404sub statistics {
405    # List available files
406    my @files = <$STATS_FOLDER/*-Converter-????????> ;
407    push @files , <$STATS_FOLDER/*-JobManager-????????> ;
408
409    &TIMESTAT('FilesControl');
410    for my $file (@files) {
411        # Only keep files with Converter or JobManager
412        # and only a date at the end of the name
413        my @count =
414            $file =~ m*$STATS_FOLDER/([\w-]+)-(Converter|JobManager)-(\d{8})$* ;
415        unless ( ! -d $file and @count == 3 ) {
416            &Debug("Skipping '$file' read") if ($ADVANCED_DEBUGGING);
417            next ;
418        }
419
420        # Keep short filename only
421        $file = join('-',@count) ;
422
423        unless (defined($FH{$file})) {
424            my ($service,$type,$date) = @count ;
425            &Debug("Found new file to handle: $file for service " . $count[0] .
426                ", generated on " .$count[2]);
427            $FILES{$file} = $FH{$file} = 0 ;
428        }
429
430        # Check to return immediatly when requested
431        return 0 if ( $do_quit or $MUSTQUIT);
432    }
433    &TIMESTAT('FilesControl');
434
435    # Lines counter to load
436    my $line_nb = 0 ;
437
438    # Read files, get an array of new lines by file
439    my %newstats = () ;
440
441    &TIMESTAT('FilesRead');
442    foreach my $file (keys(%FH)) {
443        my $fh = $FH{$file} ;
444
445        # Don't read too much lines at a loop
446        my $maxlines = $MAX_LINES ;
447        my $stats_file = "$STATS_FOLDER/$file" ;
448
449        # 0. Check file is still present
450        unless ( $fh or -s $stats_file ) {
451            &Debug("'$file' was deleted");
452            close($fh) if $fh ;
453            delete $FH{$file} ;
454            delete $FILES{$file} ;
455            delete $FH_TIMEOUT{$file} ;
456            next ;
457        }
458
459        # 1. Check old file then open not opened files
460        if ($FILES{$file} == -s $stats_file) {
461            # Only check to delete a file if no new line are found and one day
462            # has past since file was closed or last checked
463            if (defined($FH_TIMEOUT{$file})
464            and &tv_interval($FH_TIMEOUT{$file})>86400) {
465
466                my $fileage = ( time - (stat($stats_file))[9] )/ 86400 ;
467
468                if ( $fileage > $STATSFILE_MAXAGE ) {
469                    &Info("Deleting old statistics file: $stats_file");
470                    unlink $stats_file
471                        or return &Error("Can't delete old statistics file: $!");
472
473                    close($FH{$file}) if $FH{$file} ;
474                    delete $FH{$file} ;
475                    delete $FILES{$file} ;
476                    delete $FH_TIMEOUT{$file} ;
477
478                } else {
479                    # Next check in one day
480                    $FH_TIMEOUT{$file} = [ &gettimeofday() ] ;
481                }
482            }
483
484            # Handles a timer on opened file to only keep few opened files
485            if ($FH{$file}) {
486                if (defined($FH_TIMEOUT{$file})) {
487                    # Close filehandle after 30 minutes if not used
488                    if (&tv_interval($FH_TIMEOUT{$file}) > 1800) {
489                        close($FH{$file}) ;
490                        $FH{$file} = 0 ;
491                        delete $FH_TIMEOUT{$file} ;
492                    }
493
494                } else {
495                    $FH_TIMEOUT{$file} = [ &gettimeofday() ] ;
496                }
497            }
498
499            # Anyway loop to another file
500            next ;
501
502        } elsif ( ! ( $fh = $FH{$file} )) {
503            undef $fh ; # Handle must be undefined when opening on it
504            return &Error("Can't open '$file' for reading: $!")
505                unless ( open $fh , $stats_file );
506            $FH{$file} = $fh ;
507            delete $FH_TIMEOUT{$file} ;
508        }
509
510        # 2. Seek to skip still handled lines
511        seek $fh, $FILES{$file}, 0
512            if ($fh and $FILES{$file} != tell($fh));
513
514        # 3. Read lines locking on the file to not read while it is written
515        unless (eof($fh)) {
516            my $locked = flock($fh, LOCK_EX);
517            next unless ($locked);
518            my $line = '' ;
519            while ( ! eof($fh) and $maxlines-- > 0 ) {
520                $line = readline($fh) ;
521                last unless (defined($line) and $line);
522                push @{$newstats{$file}} , $line ;
523                $line_nb ++ ;
524            }
525            flock($fh, LOCK_UN);
526
527            unless (@{$newstats{$file}}) {
528                &Debug("No new line found in '$file'");
529                delete $newstats{$file} ;
530            }
531
532            # Check to don't read too much line at a time
533            #last unless ($maxlines > 0 );
534        }
535
536        # Check to return immediatly when requested
537        return 0 if ( $do_quit or $MUSTQUIT);
538    }
539    &TIMESTAT('FilesRead');
540
541    if (keys(%newstats)) {
542        &Debug("Starting DB update");
543
544        # Be sure we are connected to DB
545        my $connected = &a2p_db_connected() ? 1 : &a2p_db_connect() ;
546        return &Error("Not connected to db") unless ($connected);
547
548        # Be sure DB is ready for statistics
549        &a2p_db_statistics_ready()
550            or return &Error("Db not ready for statistics");
551
552        # Reset activity meter
553        $activity = 0 ;
554
555    } else {
556        $activity ++ unless ($activity > 100);
557
558        # Still return if nothing to do
559        return $activity > 10 ? $activity : 10 ;
560    }
561
562    foreach my $stat (keys(%newstats)) {
563        my ( $service, $proc , $date ) =
564            $stat =~ /^(.*)-(JobManager|Converter)-(\d+)$/ ;
565        unless (defined($proc) and $proc and defined($date) and $date) {
566            &Error("Won't handle lines from unrecognized '$stat' file");
567            delete $newstats{$stat} ;
568            next ;
569        }
570
571        &stats_set_service($service);
572
573        scalar(@{$newstats{$stat}}) ;
574        &Debug("Have " . $line_nb . " lines to analyse in $stat")
575            if ( $line_nb > 100 );
576
577        foreach my $line (@{$newstats{$stat}}) {
578            chomp $line ;
579
580            # Skip headers lines
581            unless ( $line =~ /^(\d{8});(\d{6});/ ) {
582                $line_nb -- ;
583                next ;
584            }
585
586            my @Job = split(/;/,$line) ;
587            if ($proc eq 'JobManager' and scalar(@Job) > 8) {
588                &stats_jobmanager(\@Job)
589                    or return &Error("Can't manage '$line' JobManager " .
590                    "statistics line as (@Job) array from $stat file");
591
592            } elsif ($proc eq 'Converter' and scalar(@Job) > 12) {
593                &stats_converter(\@Job)
594                    or return &Error("Can't manage '$line' Converter " .
595                    "statistics line as (@Job) array from $stat file");
596
597            } else {
598                &Info("Can't handle '$line' as bad formatted '$proc' line " .
599                     "from $stat file");
600                next ;
601            }
602
603            # Check statistics loading rate each 30 seconds
604            $LoadedLines ++ ;
605            if (&tv_interval(\@LastLoadCheck) > 30) {
606                &Info(sprintf(
607                    "%d more lines loaded: Loading rate %.2f lines per second" .
608                    " (now on %s)",
609                    $LoadedLines, $LoadedLines/&tv_interval(\@LastLoadCheck),
610                    $stat))
611                    if ($LoadedLines>100);
612                @LastLoadCheck = &gettimeofday() ;
613                $LoadedLines = 0 ;
614            }
615
616            # Check to return immediatly when requested
617            return 0 if ( $do_quit or $MUSTQUIT);
618
619            # Check to commit after a delay, and also cache control
620            &check_commit();
621        }
622
623        # Update %FILES to current file position after DB has been updated
624        $FILES{$stat} = tell($FH{$stat}) ;
625    }
626
627    &Debug("DB update finished") ;
628
629    # Here every thing has been done
630    return 1 ;
631}
632
633sub openUNIXSOCK {
634    my $sockname = shift ;
635    &Debug("Creating '$sockname' unix socket");
636
637    # Open UNIX Socket
638    socket( $UNIXSOCK , PF_UNIX, SOCK_STREAM , 0 )
639        or return &Error("Can't create an unix socket: $!");
640
641    bless $UNIXSOCK , "IO::Socket" ;
642
643    unlink $sockname ;
644
645    bind( $UNIXSOCK , pack_sockaddr_un( $sockname ) )
646        or return &Error("Can't bind unix socket on '$sockname': $!");
647
648    listen( $UNIXSOCK , SOMAXCONN )
649        or return &Error("Can't listenn on unix socket '$sockname': $!");
650
651    &Debug("'$sockname' unix socket created");
652    1 ;
653}
654
655sub SigUSR2 {
656    if (defined($UNIXSOCK)) {
657        my $socket ;
658        $UNIXSOCK->blocking(0);
659        my $addr = accept($socket,$UNIXSOCK);
660        if ( $addr ) {
661            &Debug("Got connection on $socket socket");
662            bless $socket , "IO::Socket" ;
663            $socket->autoflush(1);
664            my $msg = "<active time='" . time . "'/>" ;
665            print $socket "$msg\n" ;
666            close($socket);
667            &Debug("Printed '$msg' on $socket socket");
668
669        } else {
670            &Warn("No client connection on SIGUSR2 received");
671        }
672
673    } else {
674        &Warn("Can't say I'm active");
675    }
676}
677
678
679################################################################################
680### Pre-init
681################################################################################
682
683&Info("$Progname service v" . A2P_RPM_VERSION . " starting");
684
685my @MarkTimer = &gettimeofday() ;
686$STATS{'A2PSTAT-VERSION'} = A2P_RPM_VERSION ;
687
688&InitCheck ; # This sub forks other managed statistics folders
689
690################################################################################
691### Main loop
692################################################################################
693
694my $started_check = $MASTER ? 10 : 0 ;
695my %restart = () ;
696my $factor = 0 ;
697
698&TIMESTAT('MainLoop');
699while ( ! $MUSTQUIT and (! $MASTER or keys(%sons))) {
700
701    if ($started_check) {
702        &Info("$Progname service v" . A2P_RPM_VERSION . " started")
703            unless (--$started_check);
704    }
705
706    &LogSigMessage();
707
708    if ($do_test) {
709        if ($MASTER) {
710            $STATS{'#### ID ####'} = "MASTER-$$" ;
711            kill 10, keys(%sons) ;
712        } else {
713            $STATS{'#### ID ####'} = "THREAD-$$ on $STATS_FOLDER" ;
714        }
715        A2P::Thread::self_TEST();
716    }
717
718    @MarkTimer = &gettimeofday() , &Info("---MARK---")
719        unless ( ! $MASTER or &tv_interval(\@MarkTimer) < 1800 );
720
721    ###########################
722    # Statistics handling code
723    ###########################
724    last unless ($MASTER or $factor = &statistics);
725
726    # Check also stopped thread in master
727    while ( $MASTER and $pid = waitpid(-1,&WNOHANG) ) {
728        last if ( $pid < 0 );
729        &Debug("Process $pid returned");
730
731        if (defined($sons{$pid})) {
732            my $folder = $sons{$pid} ;
733            if ($?>>8) {
734                &Warn("$folder statistics manager returned with code ".($?>>8));
735
736            } else {
737                &Info("$folder statistics manager returned");
738            }
739
740            my @folders = values(%sons) ;
741            delete $sons{$pid} ;
742
743            # Check if we need to restart the thread
744            unless ( $do_quit or $started_check ) {
745                &CheckThreads(@folders);
746                &Info("'$folder' statistics manager restarted");
747
748                my $now = time ;
749                if (defined($restart{$folder})) {
750                    # Reset restart statistics if older than a minute
751                    $restart{$folder} = [ 0 , $now ]
752                         if (time - $restart{$folder}->[1] > 60);
753
754                } else {
755                    $restart{$folder} = [ 0 , $now ] ;
756                }
757
758                $restart{$folder}->[0] ++ ;
759                my $last = $now - $restart{$folder}->[1] ;
760                if ( $last and $restart{$folder}->[0]/$last > 2 ) {
761                    &Debug(sprintf("Restart rate = %.2f" ,
762                        $restart{$folder}->[0]/$last));
763                    &Alert("Can't manage '$folder' statistics folder: " .
764                        "Too much restart");
765                    $do_quit ++ ;
766                }
767            }
768
769        } else {
770            &Warn("Unknown process $pid returned");
771        }
772    }
773
774    #######################
775    # Check flags
776    #######################
777
778    # true after QUIT/TERM signal has been received
779    last if ( $do_quit );
780
781    # true after HUP signal has been received
782
783    if ( $do_init ) {
784        my $temp = $STATS_FOLDER ; # Will re-check and keep STATS_FOLDER in sons
785        # Still quit if our STATS_FOLDER not in the current
786        last unless (grep { /^$temp$/ } &InitCheck());
787        if ($MASTER) {
788            map {
789                &Debug("Sending HUP signal to $_ thread");
790                kill 1, $_ ;
791            } keys(%sons) ;
792            &Info("Configuration reloaded");
793
794        } else {
795            $STATS_FOLDER = $temp ;
796        }
797    }
798
799    # Check to do last commits
800    &check_commit($factor);
801
802    $factor = 1 unless ($factor);
803
804    &TIMESTAT('MainLoop');
805    usleep $factor * $USLEEP ;
806    &TIMESTAT('MainLoop');
807}
808
809# We can safely activate debugging when quitting is requested
810$NO_SYSLOG_DEBUG = 0 if $SERVICE_DEBUG ;
811
812&LogSigMessage ;
813
814if ( $MASTER ) {
815    &Info("$Progname service is stopping");
816    &CheckThreads(); # This will kill sons with SIGTERM
817
818} else {
819    # Remove unix socket
820    close($UNIXSOCK);
821    unlink $FILES{'SOCKET'} ;
822
823    &a2p_db_disconnect();
824
825    # Free DBM file and statistics folder
826    untie %FILES ;
827    flock($LCK, LOCK_UN);
828    close($LCK);
829}
830
831# Wait until every child has quit
832while ( $pid = wait ) {
833    last if ( $pid < 0 );
834    &Debug("T$pid has terminated");
835}
836
837&LogSigMessage ;
838
839if ($MASTER) {
840    if (defined($argument)) {
841        &Debug("PID file = '$argument'");
842        # Delete our PID in PID file
843        if (open RET , ">$argument") {
844            print RET "0" ;
845            close(RET);
846
847        } else {
848            &Error("Can't open PID file '$argument': $!");
849        }
850    }
851
852    &Info("$Progname service stopped");
853
854} else {
855    &Info("Synchronization of statistics from '$STATS_FOLDER' stopped");
856}
857
858exit(0);
859
860END {
861    # Output statistics when quitting from a disgnostic service
862    A2P::Thread::self_TEST() if ($Progname =~ /^diagnostics/);
863
864    $MASTER ?
865    &Debug("=============================QUIT===============================")
866    :
867    &Debug($0 . "[$$] =====QUIT=====");
868    &LogSigMessage ;
869}
Note: See TracBrowser for help on using the repository browser.