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



my $gzip = 'gzip';
my $tagDirTime = 0;
my $lastDirScan = 0;
my $lastReleaseScan = 0;
my $releaseScanMode = 0;
my $lastTagListUpdate = 0;
my $lastRmConfRead = 0;
my $lastRmConfFullRead = 0;
my $lastRmSeqNum = 0;
my $mtimeConfig = 0;
my $conf;

    'bindir'          => {'mandatory' => 1      , 'fmt' => 'text'},
    'tagdir'          => {'mandatory' => 1      , 'fmt' => 'dir'},
    'forcedirscan'    => {'default'   => 100    , 'fmt' => 'period'},
    'tagage'          => {'default'   => '10m'  , 'fmt' => 'period'},
    'tagListUpdate'   => {'default'   => '1h'   , 'fmt' => 'period'},
    'tagMaxPackages'  => {'default'   => 10      , 'fmt' => 'int'},
    'rmConfigCheck'   => {'default'   => '60'   , 'fmt' => 'period'},
    'rmConfFullRead'  => {'default'   => '1h'   , 'fmt' => 'period'},
    'synctime'        => {'default'   => '2h'   , 'fmt' => 'period'},
    'syncretry'       => {'default'   => '5m'   , 'fmt' => 'period'},
    'allProjects'     => {'default'   => 0      , 'fmt' => 'bool'},

 
#
#   Main processing loop
#   Will exit when terminated by parent
#
while (1)
{
    $logger->verbose3("Processing");
    $statistics{Cycle}++;
    $now = time();
 

    }
    %releaseData = ();
 
    $statistics{phase} = 'Sleep';
    sleep( $conf->{'sleep'} );
 
 
 
 
 
    reapChildren();
 
 
 
 
    #   If my PID file ceases to be, then exit the daemon
    #   Used to force daemon to restart
    #
    unless ( -f $conf->{'pidfile'} )

$statistics{phase} = 'Terminated';
$logger->logmsg("Child End");
exit 0;
 
#-------------------------------------------------------------------------------
# Function        : reapChildren 
#
# Description     : Reap any and all dead children
#                   Call in major loops to prevent zombies accumulating 
#
# Inputs          : None
#
# Returns         : 
#
sub reapChildren
{
    my $currentPhase = $statistics{phase};
    $statistics{phase} = 'Reaping';
 
    my $kid;
    do {
        $kid = waitpid(-1, WNOHANG);
    } while ( $kid > 0 );
 
    $statistics{phase} = $currentPhase;
}
 
 
#-------------------------------------------------------------------------------
# Function        : readConfig
#
# Description     : Re read the config file if it modification time has changed
#
# Inputs          : Nothing

    #
    #   When config is read force some actions
    #       - Force tagList to be created
    #       - Force release scan
    if ($rv) {
        $lastTagListUpdate = 0;
        $lastReleaseScan = 0;
 
        #
        #   Update global Project/Release list - only on change
        @projectList = split /[,\s]+/, $conf->{'project'} || '';

            }
 
            if ( readConfig() )
            {
                $logger->warn("Config file changed");
 
                $txcount = 0;
                last send_pkgs;
            }
 
            transferPackage ($pname, $pver);
            $needPkgListCount--;
            reapChildren();
        }
    }
 
    #
    #   Delete packages that have been identified as excess

            }
 
            if ( readConfig() )
            {
                $logger->warn("Config file changed");
 
                $txcount = 0;
                last delete_pkgs;
            }
            
            deletePackage ($pname, $pver, $pdata);
            $excessPkgListCount--;
            reapChildren();
        }
    }
 
    #
    #   Send package list to the target

{
    #
    #   Time to perform the scan
    #   Will do at startup and every time period there after
    #
    return unless ( $now > ($lastTagListUpdate + $conf->{tagListUpdate} ));
    $logger->verbose("maintainTagList");
    $lastTagListUpdate = $now;
 
    #
    #   Get list of things
    #
    my %config;

#
# Returns         : Nothing
#
sub processTags
{
 
    #
    #   Is Tag Processing active
    #   Can configure blat to disable tag sync
    #
    if ( $conf->{'tagMaxPackages'} == 0 )
    {
        $logger->verbose2("processTags disabled");
        return;
    }
 
    #
    #   Determine if new tags are present by examining the time
    #   that the directory was last modified.
    #
    #   Allow for a forced scan to catch packages that did not transfer

    if ( ($mtime > $tagDirTime) || ($now > ($lastDirScan + $conf->{'forcedirscan'})) )
    {
        $logger->verbose2("processTags: ",$conf->{'tagdir'}, $mtime - $tagDirTime, $now - $lastDirScan);
        $tagDirTime = $mtime;
        $lastDirScan = $now;
        my $txcount = $conf->{'tagMaxPackages'};
 
 
        my $dh;
        unless (opendir($dh, $conf->{'tagdir'}))
        {
            $logger->warn ("can't opendir $conf->{'tagdir'}: $!");

 
        #
        #   Process each entry
        #   Ignore those that start with a .
        #
        my %tagPkgList;
        while (my $tag = readdir($dh) )
        {
            next if ( $tag =~ m~^\.~ );
            my $file = "$conf->{'tagdir'}/$tag";
            $logger->verbose3("processTags: $file");

            if ( $tag =~ m~(.+)::(.+)~  )
            {
                my $package = $1;
                my $version = $2;
                $tagCount++;
                $tagPkgList{$package}{$version} = $file;
            }
        }
        $statistics{tagCount} = $tagCount;
        closedir $dh;
 
        #
        #   Process the packages located in the tags area
        #
        send_tags:
        while ( (my ($package, $pvers)) = each %{tagPkgList} )
        {
            while ( (my ($version, $file) ) = each %{$pvers} )
            {
                if ( --$txcount <= 0 )
                {
                    $logger->warn("Max tag transfer count exceeded: $tagCount transfer remaining");
                    $tagDirTime = 0;
                    last send_tags;
                }
 
                if ( readConfig() )
                {
                    $logger->warn("Config file changed");
                    $txcount = 0;
                    $tagDirTime = 0;
                    last send_tags;
                }
 
 
                #
                #   Don't transfer 'extra' packages
                #
                if (exists ($extraPkgs->{$package}) ) 
                {
                    $logger->warn ("Delete excess package tag: $package::$version");
                    unlink $file;
 
 
                } elsif ( transferPackage( $package, $version )) {
 
                    unlink $file;
                }
                else
                {
                    my ($mtime) = Utils::mtime( $file );
                    if ( $now - $mtime > $conf->{'tagage'} )
                    {
                        $logger->warn ("Delete unsatisfied tag: $package::$version");
                        unlink $file;
                        $statistics{staleTags}++;
                    }
                }
 
                $tagCount--;
                reapChildren();
            }
        }
 
    }
 
}
 
#-------------------------------------------------------------------------------
# Function        : transferBlatBin 
#

 
    $SIG{USR1} = sub {
        # On Force Archive Sync
        $logger->logmsg('Received SIGUSR1.');
        $lastReleaseScan = 0;
        $lastTagListUpdate = 0;
        $lastRmConfRead = 0;
    };
 
    alarm 60;
    $SIG{ALRM} = sub {

Rev 6776	Rev 6779
Line 52...	Line 52...
52	`my $gzip = 'gzip';`	52	`my $gzip = 'gzip';`
53	`my $tagDirTime = 0;`	53	`my $tagDirTime = 0;`
54	`my $lastDirScan = 0;`	54	`my $lastDirScan = 0;`
55	`my $lastReleaseScan = 0;`	55	`my $lastReleaseScan = 0;`
56	`my $releaseScanMode = 0;`	56	`my $releaseScanMode = 0;`
57	`my $lastTagListScan = 0;`	57	`my $lastTagListUpdate = 0;`
58	`my $lastRmConfRead = 0;`	58	`my $lastRmConfRead = 0;`
59	`my $lastRmConfFullRead = 0;`	59	`my $lastRmConfFullRead = 0;`
60	`my $lastRmSeqNum = 0;`	60	`my $lastRmSeqNum = 0;`
61	`my $mtimeConfig = 0;`	61	`my $mtimeConfig = 0;`
62	`my $conf;`	62	`my $conf;`
Line 138...	Line 138...
138	`'bindir' => {'mandatory' => 1 , 'fmt' => 'text'},`	138	`'bindir' => {'mandatory' => 1 , 'fmt' => 'text'},`
139	`'tagdir' => {'mandatory' => 1 , 'fmt' => 'dir'},`	139	`'tagdir' => {'mandatory' => 1 , 'fmt' => 'dir'},`
140	`'forcedirscan' => {'default' => 100 , 'fmt' => 'period'},`	140	`'forcedirscan' => {'default' => 100 , 'fmt' => 'period'},`
141	`'tagage' => {'default' => '10m' , 'fmt' => 'period'},`	141	`'tagage' => {'default' => '10m' , 'fmt' => 'period'},`
142	`'tagListUpdate' => {'default' => '1h' , 'fmt' => 'period'},`	142	`'tagListUpdate' => {'default' => '1h' , 'fmt' => 'period'},`
-		143	`'tagMaxPackages' => {'default' => 10 , 'fmt' => 'int'},`
143	`'rmConfigCheck' => {'default' => '60' , 'fmt' => 'period'},`	144	`'rmConfigCheck' => {'default' => '60' , 'fmt' => 'period'},`
144	`'rmConfFullRead' => {'default' => '1h' , 'fmt' => 'period'},`	145	`'rmConfFullRead' => {'default' => '1h' , 'fmt' => 'period'},`
145	`'synctime' => {'default' => '2h' , 'fmt' => 'period'},`	146	`'synctime' => {'default' => '2h' , 'fmt' => 'period'},`
146	`'syncretry' => {'default' => '5m' , 'fmt' => 'period'},`	147	`'syncretry' => {'default' => '5m' , 'fmt' => 'period'},`
147	`'allProjects' => {'default' => 0 , 'fmt' => 'bool'},`	148	`'allProjects' => {'default' => 0 , 'fmt' => 'bool'},`
Line 175...	Line 176...
175		176
176	`#`	177	`#`
177	`# Main processing loop`	178	`# Main processing loop`
178	`# Will exit when terminated by parent`	179	`# Will exit when terminated by parent`
179	`#`	180	`#`
180	`while (1 )`	181	`while (1)`
181	`{`	182	`{`
182	`$logger->verbose3("Processing");`	183	`$logger->verbose3("Processing");`
183	`$statistics{Cycle}++;`	184	`$statistics{Cycle}++;`
184	`$now = time();`	185	`$now = time();`
185		186
Line 196...	Line 197...
196	`}`	197	`}`
197	`%releaseData = ();`	198	`%releaseData = ();`
198		199
199	`$statistics{phase} = 'Sleep';`	200	`$statistics{phase} = 'Sleep';`
200	`sleep( $conf->{'sleep'} );`	201	`sleep( $conf->{'sleep'} );`
201		-
202	`#`	-
203	`# Reap any and all dead children`	-
204	`#`	-
205	`$statistics{phase} = 'Reaping';`	-
206	`my $kid;`	202	`reapChildren();`
207	`do {`	-
208	`$kid = waitpid(-1, WNOHANG);`	-
209	`} while ( $kid > 0 );`	-
210		203
211	`# If my PID file ceases to be, then exit the daemon`	204	`# If my PID file ceases to be, then exit the daemon`
212	`# Used to force daemon to restart`	205	`# Used to force daemon to restart`
213	`#`	206	`#`
214	`unless ( -f $conf->{'pidfile'} )`	207	`unless ( -f $conf->{'pidfile'} )`
Line 220...	Line 213...
220	`$statistics{phase} = 'Terminated';`	213	`$statistics{phase} = 'Terminated';`
221	`$logger->logmsg("Child End");`	214	`$logger->logmsg("Child End");`
222	`exit 0;`	215	`exit 0;`
223		216
224	`#-------------------------------------------------------------------------------`	217	`#-------------------------------------------------------------------------------`
-		218	`# Function : reapChildren`
-		219	`#`
-		220	`# Description : Reap any and all dead children`
-		221	`# Call in major loops to prevent zombies accumulating`
-		222	`#`
-		223	`# Inputs : None`
-		224	`#`
-		225	`# Returns :`
-		226	`#`
-		227	`sub reapChildren`
-		228	`{`
-		229	`my $currentPhase = $statistics{phase};`
-		230	`$statistics{phase} = 'Reaping';`
-		231
-		232	`my $kid;`
-		233	`do {`
-		234	`$kid = waitpid(-1, WNOHANG);`
-		235	`} while ( $kid > 0 );`
-		236
-		237	`$statistics{phase} = $currentPhase;`
-		238	`}`
-		239
-		240
-		241	`#-------------------------------------------------------------------------------`
225	`# Function : readConfig`	242	`# Function : readConfig`
226	`#`	243	`#`
227	`# Description : Re read the config file if it modification time has changed`	244	`# Description : Re read the config file if it modification time has changed`
228	`#`	245	`#`
229	`# Inputs : Nothing`	246	`# Inputs : Nothing`
Line 321...	Line 338...
321	`#`	338	`#`
322	`# When config is read force some actions`	339	`# When config is read force some actions`
323	`# - Force tagList to be created`	340	`# - Force tagList to be created`
324	`# - Force release scan`	341	`# - Force release scan`
325	`if ($rv) {`	342	`if ($rv) {`
326	`$lastTagListScan = 0;`	343	`$lastTagListUpdate = 0;`
327	`$lastReleaseScan = 0;`	344	`$lastReleaseScan = 0;`
328		345
329	`#`	346	`#`
330	`# Update global Project/Release list - only on change`	347	`# Update global Project/Release list - only on change`
331	`@projectList = split /[,\s]+/, $conf->{'project'} \|\| '';`	348	`@projectList = split /[,\s]+/, $conf->{'project'} \|\| '';`
Line 1030...	Line 1047...
1030	`}`	1047	`}`
1031		1048
1032	`if ( readConfig() )`	1049	`if ( readConfig() )`
1033	`{`	1050	`{`
1034	`$logger->warn("Config file changed");`	1051	`$logger->warn("Config file changed");`
1035	`$lastReleaseScan = 0;`	-
1036	`$txcount = 0;`	1052	`$txcount = 0;`
1037	`last send_pkgs;`	1053	`last send_pkgs;`
1038	`}`	1054	`}`
1039		1055
1040	`transferPackage ($pname, $pver);`	1056	`transferPackage ($pname, $pver);`
1041	`$needPkgListCount--;`	1057	`$needPkgListCount--;`
-		1058	`reapChildren();`
1042	`}`	1059	`}`
1043	`}`	1060	`}`
1044		1061
1045	`#`	1062	`#`
1046	`# Delete packages that have been identified as excess`	1063	`# Delete packages that have been identified as excess`
Line 1058...	Line 1075...
1058	`}`	1075	`}`
1059		1076
1060	`if ( readConfig() )`	1077	`if ( readConfig() )`
1061	`{`	1078	`{`
1062	`$logger->warn("Config file changed");`	1079	`$logger->warn("Config file changed");`
1063	`$lastReleaseScan = 0;`	-
1064	`$txcount = 0;`	1080	`$txcount = 0;`
1065	`last send_pkgs;`	1081	`last delete_pkgs;`
1066	`}`	1082	`}`
1067		1083
1068	`deletePackage ($pname, $pver, $pdata);`	1084	`deletePackage ($pname, $pver, $pdata);`
1069	`$excessPkgListCount--;`	1085	`$excessPkgListCount--;`
-		1086	`reapChildren();`
1070	`}`	1087	`}`
1071	`}`	1088	`}`
1072		1089
1073	`#`	1090	`#`
1074	`# Send package list to the target`	1091	`# Send package list to the target`
Line 1439...	Line 1456...
1439	`{`	1456	`{`
1440	`#`	1457	`#`
1441	`# Time to perform the scan`	1458	`# Time to perform the scan`
1442	`# Will do at startup and every time period there after`	1459	`# Will do at startup and every time period there after`
1443	`#`	1460	`#`
1444	`return unless ( $now > ($lastTagListScan + $conf->{tagListUpdate} ));`	1461	`return unless ( $now > ($lastTagListUpdate + $conf->{tagListUpdate} ));`
1445	`$logger->verbose("maintainTagList");`	1462	`$logger->verbose("maintainTagList");`
1446	`$lastTagListScan = $now;`	1463	`$lastTagListUpdate = $now;`
1447		1464
1448	`#`	1465	`#`
1449	`# Get list of things`	1466	`# Get list of things`
1450	`#`	1467	`#`
1451	`my %config;`	1468	`my %config;`
Line 1494...	Line 1511...
1494	`#`	1511	`#`
1495	`# Returns : Nothing`	1512	`# Returns : Nothing`
1496	`#`	1513	`#`
1497	`sub processTags`	1514	`sub processTags`
1498	`{`	1515	`{`
-		1516
-		1517	`#`
-		1518	`# Is Tag Processing active`
-		1519	`# Can configure blat to disable tag sync`
-		1520	`#`
-		1521	`if ( $conf->{'tagMaxPackages'} == 0 )`
-		1522	`{`
-		1523	`$logger->verbose2("processTags disabled");`
-		1524	`return;`
-		1525	`}`
-		1526
1499	`#`	1527	`#`
1500	`# Determine if new tags are present by examining the time`	1528	`# Determine if new tags are present by examining the time`
1501	`# that the directory was last modified.`	1529	`# that the directory was last modified.`
1502	`#`	1530	`#`
1503	`# Allow for a forced scan to catch packages that did not transfer`	1531	`# Allow for a forced scan to catch packages that did not transfer`
Line 1508...	Line 1536...
1508	`if ( ($mtime > $tagDirTime) \|\| ($now > ($lastDirScan + $conf->{'forcedirscan'})) )`	1536	`if ( ($mtime > $tagDirTime) \|\| ($now > ($lastDirScan + $conf->{'forcedirscan'})) )`
1509	`{`	1537	`{`
1510	`$logger->verbose2("processTags: ",$conf->{'tagdir'}, $mtime - $tagDirTime, $now - $lastDirScan);`	1538	`$logger->verbose2("processTags: ",$conf->{'tagdir'}, $mtime - $tagDirTime, $now - $lastDirScan);`
1511	`$tagDirTime = $mtime;`	1539	`$tagDirTime = $mtime;`
1512	`$lastDirScan = $now;`	1540	`$lastDirScan = $now;`
-		1541	`my $txcount = $conf->{'tagMaxPackages'};`
-		1542
1513		1543
1514	`my $dh;`	1544	`my $dh;`
1515	`unless (opendir($dh, $conf->{'tagdir'}))`	1545	`unless (opendir($dh, $conf->{'tagdir'}))`
1516	`{`	1546	`{`
1517	`$logger->warn ("can't opendir $conf->{'tagdir'}: $!");`	1547	`$logger->warn ("can't opendir $conf->{'tagdir'}: $!");`
Line 1520...	Line 1550...
1520		1550
1521	`#`	1551	`#`
1522	`# Process each entry`	1552	`# Process each entry`
1523	`# Ignore those that start with a .`	1553	`# Ignore those that start with a .`
1524	`#`	1554	`#`
-		1555	`my %tagPkgList;`
1525	`while (my $tag = readdir($dh) )`	1556	`while (my $tag = readdir($dh) )`
1526	`{`	1557	`{`
1527	`next if ( $tag =~ m~^\.~ );`	1558	`next if ( $tag =~ m~^\.~ );`
1528	`my $file = "$conf->{'tagdir'}/$tag";`	1559	`my $file = "$conf->{'tagdir'}/$tag";`
1529	`$logger->verbose3("processTags: $file");`	1560	`$logger->verbose3("processTags: $file");`
Line 1534...	Line 1565...
1534	`if ( $tag =~ m~(.+)::(.+)~ )`	1565	`if ( $tag =~ m~(.+)::(.+)~ )`
1535	`{`	1566	`{`
1536	`my $package = $1;`	1567	`my $package = $1;`
1537	`my $version = $2;`	1568	`my $version = $2;`
1538	`$tagCount++;`	1569	`$tagCount++;`
-		1570	`$tagPkgList{$package}{$version} = $file;`
-		1571	`}`
-		1572	`}`
-		1573	`$statistics{tagCount} = $tagCount;`
-		1574	`closedir $dh;`
-		1575
-		1576	`#`
-		1577	`# Process the packages located in the tags area`
-		1578	`#`
-		1579	`send_tags:`
-		1580	`while ( (my ($package, $pvers)) = each %{tagPkgList} )`
-		1581	`{`
-		1582	`while ( (my ($version, $file) ) = each %{$pvers} )`
-		1583	`{`
-		1584	`if ( --$txcount <= 0 )`
-		1585	`{`
-		1586	`$logger->warn("Max tag transfer count exceeded: $tagCount transfer remaining");`
-		1587	`$tagDirTime = 0;`
-		1588	`last send_tags;`
-		1589	`}`
-		1590
-		1591	`if ( readConfig() )`
-		1592	`{`
-		1593	`$logger->warn("Config file changed");`
-		1594	`$txcount = 0;`
-		1595	`$tagDirTime = 0;`
-		1596	`last send_tags;`
-		1597	`}`
-		1598
1539		1599
1540	`#`	1600	`#`
1541	`# Don't transfer 'extra' packages`	1601	`# Don't transfer 'extra' packages`
1542	`#`	1602	`#`
1543	`if (exists ($extraPkgs->{$package}) )`	1603	`if (exists ($extraPkgs->{$package}) )`
1544	`{`	1604	`{`
1545	`$logger->warn ("Delete excess package tag: $tag");`	1605	`$logger->warn ("Delete excess package tag: $package::$version");`
1546	`unlink $file;`	1606	`unlink $file;`
1547	`}`	-
-		1607
1548	`elsif ( transferPackage( $package, $version ))`	1608	`} elsif ( transferPackage( $package, $version )) {`
1549	`{`	-
1550	`unlink $file;`	1609	`unlink $file;`
1551	`}`	1610	`}`
1552	`else`	1611	`else`
1553	`{`	1612	`{`
1554	`my ($mtime) = Utils::mtime( $file );`	1613	`my ($mtime) = Utils::mtime( $file );`
1555	`if ( $now - $mtime > $conf->{'tagage'} )`	1614	`if ( $now - $mtime > $conf->{'tagage'} )`
1556	`{`	1615	`{`
1557	`$logger->warn ("Delete unsatisfied tag: $tag");`	1616	`$logger->warn ("Delete unsatisfied tag: $package::$version");`
1558	`unlink $file;`	1617	`unlink $file;`
1559	`$statistics{staleTags}++;`	1618	`$statistics{staleTags}++;`
1560	`}`	1619	`}`
1561	`}`	1620	`}`
-		1621
-		1622	`$tagCount--;`
-		1623	`reapChildren();`
1562	`}`	1624	`}`
1563	`}`	1625	`}`
1564	`closedir $dh;`	-
1565	`}`	1626	`}`
1566	`$statistics{tagCount} = $tagCount;`	-
1567	`}`	1627	`}`
1568		1628
1569	`#-------------------------------------------------------------------------------`	1629	`#-------------------------------------------------------------------------------`
1570	`# Function : transferBlatBin`	1630	`# Function : transferBlatBin`
1571	`#`	1631	`#`
Line 2096...	Line 2156...
2096		2156
2097	`$SIG{USR1} = sub {`	2157	`$SIG{USR1} = sub {`
2098	`# On Force Archive Sync`	2158	`# On Force Archive Sync`
2099	`$logger->logmsg('Received SIGUSR1.');`	2159	`$logger->logmsg('Received SIGUSR1.');`
2100	`$lastReleaseScan = 0;`	2160	`$lastReleaseScan = 0;`
2101	`$lastTagListScan = 0;`	2161	`$lastTagListUpdate = 0;`
2102	`$lastRmConfRead = 0;`	2162	`$lastRmConfRead = 0;`
2103	`};`	2163	`};`
2104		2164
2105	`alarm 60;`	2165	`alarm 60;`
2106	`$SIG{ALRM} = sub {`	2166	`$SIG{ALRM} = sub {`

Subversion Repositories DevTools

(root)/dpkg_blat/trunk/src/blat/blatDaemon.pl – Rev 6776 → 6779