WebSVN – DevTools – Diff – /dpkg_blat/trunk/src/blat/blatDaemon.pl

+#
 my $logger = StdLogger->new();                  # Stdout logger. Only during config
 my $name = basename( $ARGV[0]);
    $name =~ s~.conf$~~;
 my $now = 0;
+my $startTime = 0;
 my $tar = 'tar';
 my $gzip = 'gzip';
 my $tagDirTime = 0;
 my $lastDirScan = 0;
 my $lastReleaseScan = 0;
 my $conf;
 my $extraPkgs;
 my $excludePkgs;
 my %releaseData;
 my $comError = 0;
+my $yday = -1;
+#
+#   Contain statisics maintained while operating
+#       Can be dumped with a kill -USR2
+#       List here for documentation
+#
+my %statistics = (
+    SeqNum => 0,                        # Bumped when $statistics are dumped
+    timeStamp => 0,                     # DateTime when statistics are dumped
+    upTime => 0,                        # Seconds since program start
+    Cycle => 0,                         # Major process loop counter
+    phase => 'Init',                    # Current phase of operation
+    state => 'OK',                      # Nagios state
+                                        #
+                                        # The following are reset each day
+    dayStart => 0,                      # DateTime when daily data was reset
+    txCount => 0,                       # Packages Transferred
+    delCount => 0,                      # Packages marked for deletion
+    staleTags => 0,                     # Stale Tags
+    linkErrors => 0,                    # Transfer errors
+                                        #
+                                        # Per Cycle Data - Calculated each processing Cycle
+    total    => 0,                      # Packages on target machine
+    delete   => 0,                      # Packages to delete
+    excluded => 0,                      # Packages excluded
+    filtered => 0,                      # Packages filtered out
+    missing  => 0,                      # Packages missing
+    transfer => 0,                      # Packages to transfer
+    writable => 0,                      # Packages still writable - thus not transferred
+    tagCount => 0,                      # Packages tagged to be transferred
+);
+#
-#   Describe config uration parameters
+#   Describe configuration parameters
+#
 my %cdata = (
     '.ignore'         => {'pkg\.(.+)' => 'pkgs' },
     'piddir'          => {'mandatory' => 1      , 'fmt' => 'dir'},
     'sleep'           => {'default'   => 5      , 'fmt' => 'period'},
 #       Write a pidfile - thats not used
 readConfig();
 Utils::writepid($conf);
 $logger->logmsg("Starting...");
 sighandlers($conf);
+$startTime = time();
+#
 #   Main processing loop
 #   Will exit when terminated by parent
+#
 while (1 )
+{
     $logger->verbose3("Processing");
+    $statistics{Cycle}++;
     $now = time();
     $transferred = {};
+    $statistics{phase} = 'ReadConfig';
     readConfig();
     if ( $conf->{'active'} )
+    {
+        $statistics{phase} = 'ProcessReleaseList';
         processReleaseList();
+        $statistics{phase} = 'processTags';
         processTags();
+        $statistics{phase} = 'maintainTagList';
         maintainTagList();
+    }
     %releaseData = ();
+    $statistics{phase} = 'Sleep';
     sleep( $conf->{'sleep'} );
+    #
     #   Reap any and all dead children
+    #
+    $statistics{phase} = 'Reaping';
     my $kid;
     do {
         $kid = waitpid(-1, WNOHANG);
     } while ( $kid > 0 );
+    {
         $logger->logmsg("Terminate. Pid file removed");
         last;
+    }
+}
+$statistics{phase} = 'Terminated';
 $logger->logmsg("Child End");
 exit 0;
 #-------------------------------------------------------------------------------
 # Function        : readConfig
         $conf->{logger} = $logger;
         $conf->{'pidfile'} = $conf->{'piddir'} . '/' . $name . '.pid';
         $logger->verbose("Log Levl: $conf->{verbose}");
+        #
+        #   Setup statistics filename
+        $conf->{'statsfile'} = $conf->{'piddir'} . '/' . $name . '.stats';
+        $conf->{'statsfiletmp'} = $conf->{'piddir'} . '/' . $name . '.stats.tmp';
+        #
         #   Extract extra package config
+        #
         $extraPkgs = {};
         $excludePkgs = {};
         while (my($key, $data) = each ( %{$conf->{pkgs}} ))
     $logger->verbose("processReleaseList:End: $?");
     LogTxError ($?);
     if ( $? != 0 )
+    {
         $logger->warn("Cannot retrieve package list: $?");
+        $statistics{state} = 'No Remote Package List';
         return;
+    }
 #Utils::DebugDumpData ("remotePkgList", $remotePkgList);
+        #
         my @rlist = getReleaseList();
         unless ( @rlist )
+        {
             $logger->verbose2("No Releases to Process");
+            $statistics{state} = 'No Releases found';
             return;
+        }
         $pkgList = getPkgList(@rlist);
+    }
+    #
     unless ( keys %{$pkgList} )
+    {
         $logger->verbose2("No packages to process");
+        $statistics{state} = 'No Packages found';
         return;
+    }
 #    while ( (my ($pname, $pvers)) = each %{$pkgList} )
 #    {
         $logger->verbose("Packages still writable: $writableCount");
         $logger->verbose("Packages excluded: $excludeCount");
+    }
+    #
+    #   Update stats
+    #   At this point we are looking pretty good
+    #
+    $statistics{state} = 'OK';
+    $statistics{total} = scalar keys(%{$remotePkgList});
+    $statistics{transfer} = $needPkgListCount;
+    $statistics{delete} = $excessPkgListCount;
+    $statistics{filtered} = $filteredCount;
+    $statistics{missing} = $missingCount;
+    $statistics{writable} = $writableCount;
+    $statistics{excluded} = $excludeCount;
+    #
     #   Time to do the real work
     #   Transfer packages and delete excess packages
     #   Note: Perform the transfers first
     #         Limit the number of packages processed in one pass
+    #
     #   that the directory was last modified.
+    #
     #   Allow for a forced scan to catch packages that did not transfer
     #   on the first attempt
+    #
+    my $tagCount = 0;
     my ($mtime) = Utils::mtime($conf->{'tagdir'} );
     if ( ($mtime > $tagDirTime) || ($now > ($lastDirScan + $conf->{'forcedirscan'})) )
+    {
         $logger->verbose2("processTags: ",$conf->{'tagdir'}, $mtime - $tagDirTime, $now - $lastDirScan);
         $tagDirTime = $mtime;
             if ( $tag =~ m~(.+)::(.+)~  )
+            {
                 my $package = $1;
                 my $version = $2;
+                $tagCount++;
                 if ( transferPackage( $package, $version ))
+                {
                     unlink $file;
+                }
                 else
                     my ($mtime) = Utils::mtime( $file );
                     if ( $now - $mtime > $conf->{'tagage'} )
+                    {
                         $logger->warn ("Delete unsatisfied tag: $tag");
                         unlink $file;
+                        $statistics{staleTags}++;
+                    }
+                }
+            }
+        }
         closedir $dh;
+    }
+    $statistics{tagCount} = $tagCount;
+}
 #-------------------------------------------------------------------------------
 # Function        : transferPackage
+#
+        #
         #   Mark has having been transferred in the current cycle
+        #
         $transferred->{$pname}{$pver} = 1;
         $rv = 1;
+        $statistics{txCount}++;
+    }
     else
+    {
         $logger->warn("transferPackage:Transfer Error: $pname, $pver, $?");
+    }
     close ($ph);
     $logger->verbose("deletePackage:End: $?");
     if ( $? == 0 )
+    {
         $rv = 1;
+        $statistics{delCount}++;
+    }
     else
+    {
         $logger->warn("deletePackage:Error: $pname, $pver, $?");
+    }
     $hashp->{$pname}{$pver} = $rv;
     return $hashp;
+}
+#-------------------------------------------------------------------------------
+# Function        : resetDailyStatistics
+#
+# Description     : Called periodically to reset the daily statistics
+#
+# Inputs          : $time       - Current time
+#
+# Returns         :
+#
+sub resetDailyStatistics
+{
+    my ($time) = @_;
+    #
+    #   Detect a new day
+    #
+    my $today = (localtime($time))[7];
+    if ($yday != $today)
+    {
+        $yday = $today;
+        $logger->logmsg('Resetting daily statistics' );
+        $statistics{dayStart} = $time;
+        $statistics{txCount} = 0;
+        $statistics{delCount} = 0;
+        $statistics{staleTags} = 0;
+        $statistics{linkErrors} = 0;
+    }
+}
+#-------------------------------------------------------------------------------
+# Function        : periodicStatistics
+#
+# Description     : Called on a regular basis to write out statistics
+#                   Used to feed information into Nagios
+#
+#                   This function is called via an alarm and may be outside the normal
+#                   processing loop. Don't make assumptions on the value of $now
+#
+# Inputs          :
+#
+# Returns         :
+#
+sub periodicStatistics
+{
+    #
+    #   A few local stats
+    #
+    $statistics{SeqNum}++;
+    $statistics{timeStamp} = time();
+    $statistics{upTime} = $statistics{timeStamp} - $startTime;
+    #   Reset daily accumulations - on first use each day
+    resetDailyStatistics($statistics{timeStamp});
+    #
+    #   Write statistics to a file
+    #       Write to a tmp file, then rename.
+    #       Attempt to make the operation atomic - so that the file consumer
+    #       doesn't get a badly formed file.
+    #
+    if ($conf->{'statsfiletmp'})
+    {
+        my $fh;
+        unless (open ($fh, '>', $conf->{'statsfiletmp'}))
+        {
+            $fh = undef;
+            $logger->warn("Cannot create temp stats file: $!");
+        }
+        else
+        {
+            foreach my $key ( keys %statistics)
+            {
+                print $fh $key . ':' . $statistics{$key} . "\n";
+                $logger->verbose2('Statistics:'. $key . ':' . $statistics{$key});
+            }
+            close $fh;
+            # Rename temp to real file
+            rename  $conf->{'statsfiletmp'},  $conf->{'statsfile'} ;
+        }
+    }
+}
 #-------------------------------------------------------------------------------
 # Function        : sighandlers
+#
 # Description     : Install signal handlers
+#
 # Returns         : Nothing
+#
 sub sighandlers
+{
-	my $conf = shift;
+    my $conf = shift;
-	my $logger = $conf->{logger};
+    my $logger = $conf->{logger};
-	$SIG{TERM} = sub {
+    $SIG{TERM} = sub {
-		# On shutdown
+        # On shutdown
-		$logger->logmsg('Received SIGTERM. Shutting down....' );
+        $logger->logmsg('Received SIGTERM. Shutting down....' );
-		unlink $conf->{'pidfile'} if (-f $conf->{'pidfile'});
+        unlink $conf->{'pidfile'} if (-f $conf->{'pidfile'});
+        unlink $conf->{'statsfile'} if (-f $conf->{'statsfile'});
+        unlink $conf->{'statsfiletmp'} if (-f $conf->{'statsfiletmp'});
-		exit 0;
+        exit 0;
-	};
+    };
-	$SIG{HUP} = sub {
+    $SIG{HUP} = sub {
-		# On logrotate
+        # On logrotate
-		$logger->logmsg('Received SIGHUP.');
+        $logger->logmsg('Received SIGHUP.');
-		$logger->rotatelog();
+        $logger->rotatelog();
-	};
+    };
-	$SIG{USR1} = sub {
+    $SIG{USR1} = sub {
-		# On Force Archive Sync
+        # On Force Archive Sync
-		$logger->logmsg('Received SIGUSR1.');
+        $logger->logmsg('Received SIGUSR1.');
         $lastReleaseScan = 0;
         $lastTagListScan = 0;
-	};
+    };
+    alarm 60;
+    $SIG{ALRM} = sub {
+        # On Dump Statistics
+        $logger->verbose2('Received SIGUSR2.');
+        periodicStatistics();
+        alarm 60;
+    };
     $SIG{__WARN__} = sub { $logger->warn("@_") };
     $SIG{__DIE__} = sub { $logger->err("@_") };
+}
 sub LogTxError
+{
     my ($state) = $@;
     if ( $state )
+    {
+        $statistics{linkErrors}++ unless($comError);
         $comError++;
+        $statistics{state} = 'No Communication';
+    }
     elsif ( $comError )
+    {
         $logger->warn("Communication Restored");
         $comError = 0;
+        $statistics{state} = 'OK';
+    }
+}
 #-------------------------------------------------------------------------------

Subversion Repositories DevTools

(root)/dpkg_blat/trunk/src/blat/blatDaemon.pl – Rev 5300 → 5398