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



    'debug'           => {'default'   => 0      , 'fmt' => 'bool'},                 # Log to screen
    'txdetail'        => {'default'   => 0      , 'fmt' => 'bool'},
    'noTransfers'     => {'default'   => 0      , 'fmt' => 'bool'},                 # Debugging option to prevent transfers
    'maxTarZips'      => {'default'   => 5      , 'fmt' => 'int'},
    'wedgeTime'       => {'default'   => '30m'  , 'fmt' => 'period'},
    'allNewPkgs'      => {'default'   => 0      , 'fmt' => 'bool'},
 
    #
    #   Transfer via ssh
    #   Cannot be used in conjunction with S3Bucket
    #    

    #   Is Tag Processing active
    #   Can configure blat to disable tag sync
    #
    if ( $conf->{'tagMaxPackages'} > 0 )
    {
        if ($conf->{'allNewPkgs'} ) {
            $config{allNewPkgs} = 1
        }
 
        if ($conf->{'allArchive'} )
        {
            $config{allArchive} = 1
        }

        $statistics{tagCount} = $tagCount;
        $statistics{tagDelCount} = $delCount;
 
        #
        #   Process delete requests after all transfers have occured
        #
        my $showDel = $delCount;  
        my $showSend = $tagCount;
         
        unless ($tagCount) {
            delete_pkgs:
            while ( (my ($pname, $pvers)) = each %deleteTags )
            {
                while ( (my ($pver, $pdata) ) = each %{$pvers} )
                {
                    if ( --$txcount <= 0 )
                    {
 
                        $tagDirTime = 0;
                        last delete_pkgs;
                    }
 
                    if ( readConfig() )

        foreach my $entry ( @tagPkgList )
        {
            my ($package, $version, $file) = split ($;, $entry);
            if ( --$txcount <= 0 )
            {
 
 
                $tagDirTime = 0;
                last send_tags;
            }
 
            if ( readConfig() )

#               {
#                   $logger->warn ("Delete excess package tag: $package::$version");
#                   unlink $file;
#
#               } else
            my ($txDone, $workDone) = transferPackage( $package, $version );
            $txcount++ unless $workDone;
            if ($txDone ) {
                unlink $file;
            }
            else
            {
                if ($conf->{'tagage'} > 0) {

 
            $tagCount--;
            reapChildren();
            Utils::resetWedge();
        }
 
        # Nice output
        if ($showSend) {
            $logger->warn("Max tag transfer count exceeded: $tagCount transfer remaining");
            $logger->warn("Max tag transfer count exceeded: $delCount deletion remaining");
        }
        elsif ($showDel) {
            $logger->warn("Max tag transfer count exceeded: $delCount deletion remaining");
        }
    }
}
 
#-------------------------------------------------------------------------------
# Function        : transferBlatBin 

#                   If a symlink, then a symlink will be transferred
#
# Inputs          : $pname          - Name of the package
#                   $pver           - Package version
#
# Returns         : Two items
#                       txDone          - True package transferred. False Not transferred
#                       workDone        - True: work done. Flase: No work done
# 
# true    - Package transferred
#                   false   - Package not transferred
#                   
#
#                   PackageExcluded         - Assume that its been transferred
#                   PackageAtTarget         - Package known to be on the target

    #   Do not transfer excluded files
    #
    if ( exists $excludePkgs->{$pname} )
    {
        $logger->warn("transferPackage: Excluded package not transferred: $pname, $pver");
        return 1, 0;
    }
 
    #
    #   Apply package filter
    #
    if ( defined $conf->{'packageFilter'} )
    {
        unless ( $pname =~ m~$conf->{'packageFilter'}~ )
        {
            $logger->warn("transferPackage: Filtered out package not transferred: $pname, $pver");
            return 1, 0;
        }
    }
 
    #
    #   If its known to be in the target archive, then we don't need to transfer it again

    #       It may have been in the archive anyway
    #
    if ( exists($RemotePkgList->{$pname}) && exists ($RemotePkgList->{$pname}{$pver})) {
        $logger->verbose("transferPackage: Already in archive");
        #$logger->logmsg("transferPackage: $pname, $pver : Already in archive");
        return 1, 0;
    }
 
    my $sdir = catfile( $conf->{'dpkg_archive'} , $pname );
    my $sfile = catfile( $sdir, $pver );
    unless ( -d $sfile )
    {
        $logger->warn("transferPackage:Package not found: $pname, $pver");
        return 0, 0;
    }
 
    my $tzdir = catfile( $conf->{'dpkg_archive'} , '.dpkg_archive', 'tarStore' );
    my $tzfile = $pname . '__' . $pver . '.tgz';
    my $tzpath = catfile($tzdir, $tzfile);

                Utils::TouchFile($conf, $zipTag);
            } else {
                $logger->verbose("transferPackage: Max outstanding tarZip Requests");
            }
        }
        return 0, 0;
    }
 
 
    ###########################################################################
    #   Transfer the package / symlink

    } else {
        $logger->warn("transferPackage:Transfer Error: $pname, $pver, $?");
    }
 
    LogTxError ($?);
    return $rv, 1;
}
 
#-------------------------------------------------------------------------------
# Function        : transferPackageSsh
#

Rev 7460	Rev 7469
Line 161...	Line 161...
161	`'debug' => {'default' => 0 , 'fmt' => 'bool'}, # Log to screen`	161	`'debug' => {'default' => 0 , 'fmt' => 'bool'}, # Log to screen`
162	`'txdetail' => {'default' => 0 , 'fmt' => 'bool'},`	162	`'txdetail' => {'default' => 0 , 'fmt' => 'bool'},`
163	`'noTransfers' => {'default' => 0 , 'fmt' => 'bool'}, # Debugging option to prevent transfers`	163	`'noTransfers' => {'default' => 0 , 'fmt' => 'bool'}, # Debugging option to prevent transfers`
164	`'maxTarZips' => {'default' => 5 , 'fmt' => 'int'},`	164	`'maxTarZips' => {'default' => 5 , 'fmt' => 'int'},`
165	`'wedgeTime' => {'default' => '30m' , 'fmt' => 'period'},`	165	`'wedgeTime' => {'default' => '30m' , 'fmt' => 'period'},`
-		166	`'allNewPkgs' => {'default' => 0 , 'fmt' => 'bool'},`
166		167
167	`#`	168	`#`
168	`# Transfer via ssh`	169	`# Transfer via ssh`
169	`# Cannot be used in conjunction with S3Bucket`	170	`# Cannot be used in conjunction with S3Bucket`
170	`#`	171	`#`
Line 1650...	Line 1651...
1650	`# Is Tag Processing active`	1651	`# Is Tag Processing active`
1651	`# Can configure blat to disable tag sync`	1652	`# Can configure blat to disable tag sync`
1652	`#`	1653	`#`
1653	`if ( $conf->{'tagMaxPackages'} > 0 )`	1654	`if ( $conf->{'tagMaxPackages'} > 0 )`
1654	`{`	1655	`{`
-		1656	`if ($conf->{'allNewPkgs'} ) {`
-		1657	`$config{allNewPkgs} = 1`
-		1658	`}`
1655		1659
1656	`if ($conf->{'allArchive'} )`	1660	`if ($conf->{'allArchive'} )`
1657	`{`	1661	`{`
1658	`$config{allArchive} = 1`	1662	`$config{allArchive} = 1`
1659	`}`	1663	`}`
Line 1768...	Line 1772...
1768	`$statistics{tagCount} = $tagCount;`	1772	`$statistics{tagCount} = $tagCount;`
1769	`$statistics{tagDelCount} = $delCount;`	1773	`$statistics{tagDelCount} = $delCount;`
1770		1774
1771	`#`	1775	`#`
1772	`# Process delete requests after all transfers have occured`	1776	`# Process delete requests after all transfers have occured`
-		1777	`#`
-		1778	`my $showDel = $delCount;`
-		1779	`my $showSend = $tagCount;`
1773	`#`	1780
1774	`unless ($tagCount) {`	1781	`unless ($tagCount) {`
1775	`delete_pkgs:`	1782	`delete_pkgs:`
1776	`while ( (my ($pname, $pvers)) = each %deleteTags )`	1783	`while ( (my ($pname, $pvers)) = each %deleteTags )`
1777	`{`	1784	`{`
1778	`while ( (my ($pver, $pdata) ) = each %{$pvers} )`	1785	`while ( (my ($pver, $pdata) ) = each %{$pvers} )`
1779	`{`	1786	`{`
1780	`if ( --$txcount <= 0 )`	1787	`if ( --$txcount <= 0 )`
1781	`{`	1788	`{`
1782	`$logger->warn("Max tag transfer count exceeded: $delCount deletion remaining");`	-
1783	`$tagDirTime = 0;`	1789	`$tagDirTime = 0;`
1784	`last delete_pkgs;`	1790	`last delete_pkgs;`
1785	`}`	1791	`}`
1786		1792
1787	`if ( readConfig() )`	1793	`if ( readConfig() )`
Line 1809...	Line 1815...
1809	`foreach my $entry ( @tagPkgList )`	1815	`foreach my $entry ( @tagPkgList )`
1810	`{`	1816	`{`
1811	`my ($package, $version, $file) = split ($;, $entry);`	1817	`my ($package, $version, $file) = split ($;, $entry);`
1812	`if ( --$txcount <= 0 )`	1818	`if ( --$txcount <= 0 )`
1813	`{`	1819	`{`
1814	`$logger->warn("Max tag transfer count exceeded: $tagCount transfer remaining");`	-
1815	`$logger->warn("Max tag transfer count exceeded: $delCount deletion remaining");`	-
1816	`$tagDirTime = 0;`	1820	`$tagDirTime = 0;`
1817	`last send_tags;`	1821	`last send_tags;`
1818	`}`	1822	`}`
1819		1823
1820	`if ( readConfig() )`	1824	`if ( readConfig() )`
Line 1833...	Line 1837...
1833	`# {`	1837	`# {`
1834	`# $logger->warn ("Delete excess package tag: $package::$version");`	1838	`# $logger->warn ("Delete excess package tag: $package::$version");`
1835	`# unlink $file;`	1839	`# unlink $file;`
1836	`#`	1840	`#`
1837	`# } else`	1841	`# } else`
1838	`if ( transferPackage( $package, $version )) {`	1842	`my ($txDone, $workDone) = transferPackage( $package, $version );`
-		1843	`$txcount++ unless $workDone;`
-		1844	`if ($txDone ) {`
1839	`unlink $file;`	1845	`unlink $file;`
1840	`}`	1846	`}`
1841	`else`	1847	`else`
1842	`{`	1848	`{`
1843	`if ($conf->{'tagage'} > 0) {`	1849	`if ($conf->{'tagage'} > 0) {`
Line 1853...	Line 1859...
1853		1859
1854	`$tagCount--;`	1860	`$tagCount--;`
1855	`reapChildren();`	1861	`reapChildren();`
1856	`Utils::resetWedge();`	1862	`Utils::resetWedge();`
1857	`}`	1863	`}`
-		1864
-		1865	`# Nice output`
-		1866	`if ($showSend) {`
-		1867	`$logger->warn("Max tag transfer count exceeded: $tagCount transfer remaining");`
-		1868	`$logger->warn("Max tag transfer count exceeded: $delCount deletion remaining");`
-		1869	`}`
-		1870	`elsif ($showDel) {`
-		1871	`$logger->warn("Max tag transfer count exceeded: $delCount deletion remaining");`
-		1872	`}`
1858	`}`	1873	`}`
1859	`}`	1874	`}`
1860		1875
1861	`#-------------------------------------------------------------------------------`	1876	`#-------------------------------------------------------------------------------`
1862	`# Function : transferBlatBin`	1877	`# Function : transferBlatBin`
Line 1969...	Line 1984...
1969	`# If a symlink, then a symlink will be transferred`	1984	`# If a symlink, then a symlink will be transferred`
1970	`#`	1985	`#`
1971	`# Inputs : $pname - Name of the package`	1986	`# Inputs : $pname - Name of the package`
1972	`# $pver - Package version`	1987	`# $pver - Package version`
1973	`#`	1988	`#`
-		1989	`# Returns : Two items`
-		1990	`# txDone - True package transferred. False Not transferred`
-		1991	`# workDone - True: work done. Flase: No work done`
-		1992	`#`
1974	`# Returns : true - Package transferred`	1993	`# true - Package transferred`
1975	`# false - Package not transferred`	1994	`# false - Package not transferred`
1976	`#`	1995	`#`
1977	`#`	1996	`#`
1978	`# PackageExcluded - Assume that its been transferred`	1997	`# PackageExcluded - Assume that its been transferred`
1979	`# PackageAtTarget - Package known to be on the target`	1998	`# PackageAtTarget - Package known to be on the target`
Line 1997...	Line 2016...
1997	`# Do not transfer excluded files`	2016	`# Do not transfer excluded files`
1998	`#`	2017	`#`
1999	`if ( exists $excludePkgs->{$pname} )`	2018	`if ( exists $excludePkgs->{$pname} )`
2000	`{`	2019	`{`
2001	`$logger->warn("transferPackage: Excluded package not transferred: $pname, $pver");`	2020	`$logger->warn("transferPackage: Excluded package not transferred: $pname, $pver");`
2002	`return 1;`	2021	`return 1, 0;`
2003	`}`	2022	`}`
2004		2023
2005	`#`	2024	`#`
2006	`# Apply package filter`	2025	`# Apply package filter`
2007	`#`	2026	`#`
2008	`if ( defined $conf->{'packageFilter'} )`	2027	`if ( defined $conf->{'packageFilter'} )`
2009	`{`	2028	`{`
2010	`unless ( $pname =~ m~$conf->{'packageFilter'}~ )`	2029	`unless ( $pname =~ m~$conf->{'packageFilter'}~ )`
2011	`{`	2030	`{`
2012	`$logger->warn("transferPackage: Filtered out package not transferred: $pname, $pver");`	2031	`$logger->warn("transferPackage: Filtered out package not transferred: $pname, $pver");`
2013	`return 1;`	2032	`return 1, 0;`
2014	`}`	2033	`}`
2015	`}`	2034	`}`
2016		2035
2017	`#`	2036	`#`
2018	`# If its known to be in the target archive, then we don't need to transfer it again`	2037	`# If its known to be in the target archive, then we don't need to transfer it again`
Line 2020...	Line 2039...
2020	`# It may have been in the archive anyway`	2039	`# It may have been in the archive anyway`
2021	`#`	2040	`#`
2022	`if ( exists($RemotePkgList->{$pname}) && exists ($RemotePkgList->{$pname}{$pver})) {`	2041	`if ( exists($RemotePkgList->{$pname}) && exists ($RemotePkgList->{$pname}{$pver})) {`
2023	`$logger->verbose("transferPackage: Already in archive");`	2042	`$logger->verbose("transferPackage: Already in archive");`
2024	`#$logger->logmsg("transferPackage: $pname, $pver : Already in archive");`	2043	`#$logger->logmsg("transferPackage: $pname, $pver : Already in archive");`
2025	`return 1;`	2044	`return 1, 0;`
2026	`}`	2045	`}`
2027		2046
2028	`my $sdir = catfile( $conf->{'dpkg_archive'} , $pname );`	2047	`my $sdir = catfile( $conf->{'dpkg_archive'} , $pname );`
2029	`my $sfile = catfile( $sdir, $pver );`	2048	`my $sfile = catfile( $sdir, $pver );`
2030	`unless ( -d $sfile )`	2049	`unless ( -d $sfile )`
2031	`{`	2050	`{`
2032	`$logger->warn("transferPackage:Package not found: $pname, $pver");`	2051	`$logger->warn("transferPackage:Package not found: $pname, $pver");`
2033	`return $rv;`	2052	`return 0, 0;`
2034	`}`	2053	`}`
2035		2054
2036	`my $tzdir = catfile( $conf->{'dpkg_archive'} , '.dpkg_archive', 'tarStore' );`	2055	`my $tzdir = catfile( $conf->{'dpkg_archive'} , '.dpkg_archive', 'tarStore' );`
2037	`my $tzfile = $pname . '__' . $pver . '.tgz';`	2056	`my $tzfile = $pname . '__' . $pver . '.tgz';`
2038	`my $tzpath = catfile($tzdir, $tzfile);`	2057	`my $tzpath = catfile($tzdir, $tzfile);`
Line 2054...	Line 2073...
2054	`Utils::TouchFile($conf, $zipTag);`	2073	`Utils::TouchFile($conf, $zipTag);`
2055	`} else {`	2074	`} else {`
2056	`$logger->verbose("transferPackage: Max outstanding tarZip Requests");`	2075	`$logger->verbose("transferPackage: Max outstanding tarZip Requests");`
2057	`}`	2076	`}`
2058	`}`	2077	`}`
2059	`return 0;`	2078	`return 0, 0;`
2060	`}`	2079	`}`
2061		2080
2062		2081
2063	`###########################################################################`	2082	`###########################################################################`
2064	`# Transfer the package / symlink`	2083	`# Transfer the package / symlink`
Line 2092...	Line 2111...
2092	`} else {`	2111	`} else {`
2093	`$logger->warn("transferPackage:Transfer Error: $pname, $pver, $?");`	2112	`$logger->warn("transferPackage:Transfer Error: $pname, $pver, $?");`
2094	`}`	2113	`}`
2095		2114
2096	`LogTxError ($?);`	2115	`LogTxError ($?);`
2097	`return $rv;`	2116	`return $rv, 1;`
2098	`}`	2117	`}`
2099		2118
2100	`#-------------------------------------------------------------------------------`	2119	`#-------------------------------------------------------------------------------`
2101	`# Function : transferPackageSsh`	2120	`# Function : transferPackageSsh`
2102	`#`	2121	`#`

Subversion Repositories DevTools

(root)/dpkg_blat/trunk/src/blat/blatDaemon.pl – Rev 7460 → 7469