Subversion Repositories DevTools

Rev

Rev 7423 | Rev 7469 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 7423 Rev 7460
Line 70... Line 70...
70
my $targetBinDir = "$FindBin::Bin/targetBin";
70
my $targetBinDir = "$FindBin::Bin/targetBin";
71
my $server_id;
71
my $server_id;
72
my @projectList;
72
my @projectList;
73
my @releaseList;
73
my @releaseList;
74
my $isS3Target;
74
my $isS3Target;
75
my $wedgedCount = 0;
-
 
76
 
75
 
77
#
76
#
78
#   Contain statisics maintained while operating
77
#   Contain statisics maintained while operating
79
#       Can be dumped with a kill -USR2
78
#       Can be dumped with a kill -USR2
80
#       List here for documentation
79
#       List here for documentation
Line 161... Line 160...
161
    'active'          => {'default'   => 1      , 'fmt' => 'bool'},
160
    'active'          => {'default'   => 1      , 'fmt' => 'bool'},
162
    'debug'           => {'default'   => 0      , 'fmt' => 'bool'},                 # Log to screen
161
    'debug'           => {'default'   => 0      , 'fmt' => 'bool'},                 # Log to screen
163
    'txdetail'        => {'default'   => 0      , 'fmt' => 'bool'},
162
    'txdetail'        => {'default'   => 0      , 'fmt' => 'bool'},
164
    'noTransfers'     => {'default'   => 0      , 'fmt' => 'bool'},                 # Debugging option to prevent transfers
163
    'noTransfers'     => {'default'   => 0      , 'fmt' => 'bool'},                 # Debugging option to prevent transfers
165
    'maxTarZips'      => {'default'   => 5      , 'fmt' => 'int'},
164
    'maxTarZips'      => {'default'   => 5      , 'fmt' => 'int'},
-
 
165
    'wedgeTime'       => {'default'   => '30m'  , 'fmt' => 'period'},
166
 
166
 
167
    #
167
    #
168
    #   Transfer via ssh
168
    #   Transfer via ssh
169
    #   Cannot be used in conjunction with S3Bucket
169
    #   Cannot be used in conjunction with S3Bucket
170
    #    
170
    #    
171
    'hostname'        => {'fmt' => 'text', requires => 'user,identity,bindir'},
171
    'hostname'        => {'fmt' => 'text', 'requires' => 'user,identity,bindir'},
172
    'user'            => {'fmt' => 'text', requires => 'hostname'},
172
    'user'            => {'fmt' => 'text', 'requires' => 'hostname'},
173
    'identity'        => {'fmt' => 'file'},
173
    'identity'        => {'fmt' => 'file'},
174
    'bindir'          => {'fmt' => 'text'},
174
    'bindir'          => {'fmt' => 'text'},
175
 
175
 
176
    #
176
    #
177
    #   Transfer to S3 configuration items
177
    #   Transfer to S3 configuration items
178
    #       Cannot be used in conjunction with hostname
178
    #       Cannot be used in conjunction with hostname
179
    #       Many other options will be ignored 
179
    #       Many other options will be ignored 
180
    #
180
    #
181
    'S3Bucket'        => {'fmt' => 'text', requires => 'S3Profile'},
181
    'S3Bucket'        => {'fmt' => 'text', 'requires' => 'S3Profile,S3Profile,S3Region'},
182
    'S3Profile'       => {'fmt' => 'text', requires => 'S3Bucket' },
182
    'S3Profile'       => {'fmt' => 'text', 'requires' => 'S3Bucket' },
-
 
183
    'S3Region'        => {'fmt' => 'text', 'requires' => 'S3Bucket' },
-
 
184
    'S3AllowDelete'   => {'default' => 0 , 'fmt' => 'bool'},
183
);
185
);
184
 
186
 
185
 
187
 
186
#
188
#
187
#   Read in the configuration
189
#   Read in the configuration
Line 200... Line 202...
200
#
202
#
201
while (1)
203
while (1)
202
{
204
{
203
    $logger->verbose3("Processing");
205
    $logger->verbose3("Processing");
204
    $statistics{Cycle}++;
206
    $statistics{Cycle}++;
205
    $wedgedCount = 0;
-
 
206
    $now = time();
207
    $now = time();
-
 
208
    Utils::resetWedge();
207
 
209
 
208
    $statistics{phase} = 'ReadConfig';
210
    $statistics{phase} = 'ReadConfig';
209
    readConfig();
211
    readConfig();
210
    if ( $conf->{'active'} )
212
    if ( $conf->{'active'} )
211
    {
213
    {
Line 285... Line 287...
285
        {
287
        {
286
            warn "$_\n" foreach (@{$errors});
288
            warn "$_\n" foreach (@{$errors});
287
            die ("Config contained errors\n");
289
            die ("Config contained errors\n");
288
        }
290
        }
289
        $isS3Target = defined $conf->{'S3Bucket'};
291
        $isS3Target = defined $conf->{'S3Bucket'};
-
 
292
        if ($isS3Target) {
-
 
293
            if (!$conf->{'S3AllowDelete'}) {
-
 
294
                    $conf->{deletePackages} = 0;
-
 
295
            }
-
 
296
        }
290
 
297
 
291
        #
298
        #
292
        #   Reset some information
299
        #   Reset some information
293
        #   Create a new logger
300
        #   Create a new logger
294
        #
301
        #
Line 672... Line 679...
672
    #   Get Data from an S3 bucket
679
    #   Get Data from an S3 bucket
673
    #   Can only get a part of the full data set. The timestamp can't be processed, so set it to -1
680
    #   Can only get a part of the full data set. The timestamp can't be processed, so set it to -1
674
    #   
681
    #   
675
    if ($isS3Target ) {
682
    if ($isS3Target ) {
676
        my $ph;
683
        my $ph;
-
 
684
        my $tgt_cmd = "aws --profile $conf->{'S3Profile'}";
-
 
685
        $tgt_cmd .= " --region $conf->{'S3Region'}" if (defined $conf->{'S3Region'});
677
        my $tgt_cmd = "aws s3 ls $conf->{'S3Bucket'}/";
686
        $tgt_cmd .= " s3 ls $conf->{'S3Bucket'}/";
678
 
687
 
679
        $logger->verbose2("processReleaseList:s3_cmd:$tgt_cmd");
688
        $logger->verbose2("processReleaseList:s3_cmd:$tgt_cmd");
680
        open ($ph, "$tgt_cmd |");
689
        open ($ph, "$tgt_cmd |");
681
        while ( <$ph> )
690
        while ( <$ph> )
682
        {
691
        {
683
            chomp;
692
            chomp;
684
            m~.*\s(.*)__(.*).tgz$~;
693
            if (m~.*\s(.*)__(.*).tgz$~ ) {
685
            $remotePkgList->{$1}{$2}{s3} = 1;
694
                $remotePkgList->{$1}{$2}{s3} = 1;
-
 
695
            }
686
        }
696
        }
687
        close ($ph);
697
        close ($ph);
688
 
698
 
689
    } else {
699
    } else {
690
        # Get Data from a dpkg_archive maintained via ssh
700
        # Get Data from a dpkg_archive maintained via ssh
Line 1725... Line 1735...
1725
        }
1735
        }
1726
 
1736
 
1727
        #
1737
        #
1728
        #   Process each entry
1738
        #   Process each entry
1729
        #   Ignore those that start with a .
1739
        #   Ignore those that start with a .
-
 
1740
        #   Attempt to keep the entries in time of creation order.
1730
        #
1741
        #
1731
        my %tagPkgList;
1742
        my @tagPkgList;
1732
        my %deleteTags;
1743
        my %deleteTags;
-
 
1744
        my @sortedFiles = sort {(stat($conf->{'tagdir'} .'/'. $a))[10] <=> (stat($conf->{'tagdir'} .'/'. $b))[10]} readdir($dh);
-
 
1745
        closedir $dh;
-
 
1746
 
1733
        while (my $tag = readdir($dh) )
1747
        foreach my $tag (@sortedFiles)
1734
        {
1748
        {
1735
            next if ( $tag =~ m~^\.~ );
1749
            next if ( $tag =~ m~^\.~ );
1736
            my $file = "$conf->{'tagdir'}/$tag";
1750
            my $file = "$conf->{'tagdir'}/$tag";
1737
            $logger->verbose3("processTags: $file");
1751
            $logger->verbose3("processTags: $file");
1738
 
1752
 
Line 1745... Line 1759...
1745
                $delCount++;
1759
                $delCount++;
1746
            }
1760
            }
1747
 
1761
 
1748
            if ( $tag =~ m~(.+)::(.+)~  )
1762
            if ( $tag =~ m~(.+)::(.+)~  )
1749
            {
1763
            {
1750
                $tagPkgList{$1}{$2} = $file;
1764
                push @tagPkgList, join($;,  $1, $2, $file);
1751
                $tagCount++;
1765
                $tagCount++;
1752
            }
1766
            }
1753
        }
1767
        }
1754
        $statistics{tagCount} = $tagCount;
1768
        $statistics{tagCount} = $tagCount;
1755
        $statistics{tagDelCount} = $delCount;
1769
        $statistics{tagDelCount} = $delCount;
1756
        closedir $dh;
-
 
1757
 
1770
 
1758
        #
1771
        #
1759
        #   Process delete requests after all transfers have occured
1772
        #   Process delete requests after all transfers have occured
1760
        #   
1773
        #   
1761
        unless ($tagCount) {
1774
        unless ($tagCount) {
Line 1781... Line 1794...
1781
                    
1794
                    
1782
                    deletePackage ($pname, $pver, $pdata->{mode});
1795
                    deletePackage ($pname, $pver, $pdata->{mode});
1783
                    unlink $pdata->{file};
1796
                    unlink $pdata->{file};
1784
                    $delCount--;
1797
                    $delCount--;
1785
                    reapChildren();
1798
                    reapChildren();
1786
                    $wedgedCount = 0;
1799
                    Utils::resetWedge();
1787
                }
1800
                }
1788
            }
1801
            }
1789
        }
1802
        }
1790
 
1803
 
1791
        #
1804
        #
1792
        #   Process the packages located in the tags area
1805
        #   Process the packages located in the tags area
-
 
1806
        #   Have attempted to keep them in creation order
1793
        #
1807
        #
1794
        send_tags:
1808
        send_tags:
1795
        while ( (my ($package, $pvers)) = each %{tagPkgList} )
1809
        foreach my $entry ( @tagPkgList )
1796
        {
1810
        {
1797
            while ( (my ($version, $file) ) = each %{$pvers} )
1811
            my ($package, $version, $file) = split ($;, $entry);
-
 
1812
            if ( --$txcount <= 0 )
1798
            {
1813
            {
1799
                if ( --$txcount <= 0 )
-
 
1800
                {
-
 
1801
                    $logger->warn("Max tag transfer count exceeded: $tagCount transfer remaining");
1814
                $logger->warn("Max tag transfer count exceeded: $tagCount transfer remaining");
1802
                    $logger->warn("Max tag transfer count exceeded: $delCount deletion remaining");
1815
                $logger->warn("Max tag transfer count exceeded: $delCount deletion remaining");
1803
                    $tagDirTime = 0;
1816
                $tagDirTime = 0;
1804
                    last send_tags;
1817
                last send_tags;
1805
                }
1818
            }
1806
 
1819
 
1807
                if ( readConfig() )
1820
            if ( readConfig() )
1808
                {
1821
            {
1809
                    $logger->warn("Config file changed");
1822
                $logger->warn("Config file changed");
1810
                    $txcount = 0;
1823
                $txcount = 0;
1811
                    $tagDirTime = 0;
1824
                $tagDirTime = 0;
1812
                    last send_tags;
1825
                last send_tags;
1813
                }
1826
            }
1814
 
1827
 
1815
#               #
1828
#               #
1816
#               #   Don't transfer 'extra' packages
1829
#               #   Don't transfer 'extra' packages
1817
#               #   Removed. It was casuing a tarZip to be triggered, but never transferred
1830
#               #   Removed. It was casuing a tarZip to be triggered, but never transferred
1818
#               #
1831
#               #
Line 1820... Line 1833...
1820
#               {
1833
#               {
1821
#                   $logger->warn ("Delete excess package tag: $package::$version");
1834
#                   $logger->warn ("Delete excess package tag: $package::$version");
1822
#                   unlink $file;
1835
#                   unlink $file;
1823
#
1836
#
1824
#               } else
1837
#               } else
1825
                if ( transferPackage( $package, $version )) {
1838
            if ( transferPackage( $package, $version )) {
1826
                    unlink $file;
1839
                unlink $file;
1827
                }
1840
            }
1828
                else
1841
            else
1829
                {
1842
            {
1830
                    if ($conf->{'tagage'} > 0) {
1843
                if ($conf->{'tagage'} > 0) {
1831
                        my ($mtime) = Utils::mtime( $file );
1844
                    my ($mtime) = Utils::mtime( $file );
1832
                        if ( $now - $mtime > $conf->{'tagage'} )
1845
                    if ( $now - $mtime > $conf->{'tagage'} )
1833
                        {
1846
                    {
1834
                            $logger->warn ("Delete unsatisfied tag: $package::$version after $conf->{'tagage'}" );
1847
                        $logger->warn ("Delete unsatisfied tag: $package::$version after $conf->{'tagage'}" );
1835
                            unlink $file;
1848
                        unlink $file;
1836
                            $statistics{staleTags}++;
1849
                        $statistics{staleTags}++;
1837
                        }
-
 
1838
                    }
1850
                    }
1839
                }
1851
                }
1840
 
-
 
1841
                $tagCount--;
-
 
1842
                reapChildren();
-
 
1843
                $wedgedCount = 0;
-
 
1844
            }
1852
            }
-
 
1853
 
-
 
1854
            $tagCount--;
-
 
1855
            reapChildren();
-
 
1856
            Utils::resetWedge();
1845
        }
1857
        }
1846
    }
1858
    }
1847
}
1859
}
1848
 
1860
 
1849
#-------------------------------------------------------------------------------
1861
#-------------------------------------------------------------------------------
Line 1959... Line 1971...
1959
# Inputs          : $pname          - Name of the package
1971
# Inputs          : $pname          - Name of the package
1960
#                   $pver           - Package version
1972
#                   $pver           - Package version
1961
#
1973
#
1962
# Returns         : true    - Package transferred
1974
# Returns         : true    - Package transferred
1963
#                   false   - Package not transferred
1975
#                   false   - Package not transferred
-
 
1976
#                   
-
 
1977
#
-
 
1978
#                   PackageExcluded         - Assume that its been transferred
-
 
1979
#                   PackageAtTarget         - Package known to be on the target
-
 
1980
#                   PackageNotInArchive     - Package not found in dpkg_archive
-
 
1981
#                   PackageZipRequested     - Requested a Zipped version of the package
-
 
1982
#                   PackageZipNotRequested  - Need a Zipped version, but I have too many requests outstanding
-
 
1983
#                   PackageTransferOK       - Package has been transferred
-
 
1984
#                   PackageTransferError    - Error in the package transfer
-
 
1985
#                   
-
 
1986
#
1964
#
1987
#
1965
sub transferPackage
1988
sub transferPackage
1966
{
1989
{
1967
    my ($pname, $pver ) = @_;
1990
    my ($pname, $pver ) = @_;
1968
    my $rv = 0;
1991
    my $rv = 0;
Line 2020... Line 2043...
2020
        my $tagRoot = $1;
2043
        my $tagRoot = $1;
2021
        my $tag = "$pname::$pver";
2044
        my $tag = "$pname::$pver";
2022
        my $zipTag = catfile($tagRoot, 'tarZip', $tag);
2045
        my $zipTag = catfile($tagRoot, 'tarZip', $tag);
2023
        my $myTag =  catfile($conf->{'tagdir'} , $tag);
2046
        my $myTag =  catfile($conf->{'tagdir'} , $tag);
2024
 
2047
 
2025
        $logger->logmsg("transferPackage. Request Zip: @_") unless ( -f $zipTag && -f $myTag );
2048
        # Ensure I have an outstanding request, so that the tarZip process can notify me
2026
        Utils::TouchFile($conf, $myTag) unless -f $myTag;
2049
        Utils::TouchFile($conf, $myTag) unless -f $myTag;
2027
 
2050
 
2028
        unless (-f $zipTag) {
2051
        unless (-f $zipTag) {
2029
            if (calcZipRequests() < $conf->{maxTarZips} ) {
2052
            if (calcZipRequests() < $conf->{maxTarZips} ) {
-
 
2053
                $logger->logmsg("transferPackage. Request Zip: @_");
2030
                Utils::TouchFile($conf, $zipTag);
2054
                Utils::TouchFile($conf, $zipTag);
2031
            } else {
2055
            } else {
2032
                $logger->verbose("transferPackage: Max outstanding tarZip Requests");
2056
                $logger->verbose("transferPackage: Max outstanding tarZip Requests");
2033
            }
2057
            }
2034
        }
2058
        }
Line 2180... Line 2204...
2180
    #
2204
    #
2181
    #   Create a command to transfer the file to AWS use the cli tools
2205
    #   Create a command to transfer the file to AWS use the cli tools
2182
    #   Note: Ive seen problem with this when used from Perth to AWS (Sydney)
2206
    #   Note: Ive seen problem with this when used from Perth to AWS (Sydney)
2183
    #         If this is an issue use curl - see the savePkgToS3.sh for an implementation
2207
    #         If this is an issue use curl - see the savePkgToS3.sh for an implementation
2184
    #   
2208
    #   
-
 
2209
    my $s3_cmd = "aws --profile $conf->{'S3Profile'}";
-
 
2210
    $s3_cmd .= " --region $conf->{'S3Region'}" if (defined $conf->{'S3Region'});
2185
    my $s3_cmd = "aws --profile $conf->{'S3Profile'} s3 cp $sfile s3://$conf->{'S3Bucket'}/$tzfile";
2211
    $s3_cmd .= " s3 cp $sfile s3://$conf->{'S3Bucket'}/$tzfile";
2186
    $logger->verbose2("transferPackage:s3_cmd:$s3_cmd");
2212
    $logger->verbose2("transferPackage:s3_cmd:$s3_cmd");
2187
 
2213
 
2188
    unless ($conf->{'noTransfers'}) {
2214
    unless ($conf->{'noTransfers'}) {
2189
        my $ph;
2215
        my $ph;
2190
        open ($ph, "$s3_cmd |");
2216
        open ($ph, "$s3_cmd |");
Line 2220... Line 2246...
2220
    my $rv = 0;
2246
    my $rv = 0;
2221
    my $cmdRv = 0;
2247
    my $cmdRv = 0;
2222
    $logger->logmsg("deletePackage: $pname, $pver");
2248
    $logger->logmsg("deletePackage: $pname, $pver");
2223
 
2249
 
2224
    if ($isS3Target) {
2250
    if ($isS3Target) {
-
 
2251
        #
-
 
2252
        #   S3 Transfer is being used to store packages forever
-
 
2253
        #   Don't normally want to be able to delete such packages, so the default
-
 
2254
        #   is to prevent deletion of S3 transferred packages.
-
 
2255
        if ($conf->{'S3AllowDelete'}) {
-
 
2256
 
2225
        #   Create the process pipe to delete the package
2257
            #   Create the process pipe to delete the package
-
 
2258
            my $tzfile = $pname . '__' . $pver . '.tgz';
-
 
2259
            my $s3_cmd = "aws --profile $conf->{'S3Profile'}";
-
 
2260
            $s3_cmd .= " --region $conf->{'S3Region'}" if (defined $conf->{'S3Region'});
-
 
2261
            $s3_cmd .=   " s3 rm s3://$conf->{'S3Bucket'}/$tzfile";
-
 
2262
            $logger->verbose2("deletePackage:s3_cmd:$s3_cmd");
2226
 
2263
 
-
 
2264
            my $ph;
2227
        my $tzfile = $pname . '__' . $pver . '.tgz';
2265
            open ($ph, "$s3_cmd |");
2228
        my $s3_cmd = "aws --profile $conf->{'S3Profile'} s3 rm s3://$conf->{'S3Bucket'}/$tzfile";
2266
            while ( <$ph> )
-
 
2267
            {
-
 
2268
                chomp;
2229
        $logger->verbose2("deletePackage:s3_cmd:$s3_cmd");
2269
                $logger->verbose2("deletePackage:Data: $_");
-
 
2270
            }
-
 
2271
            close ($ph);
-
 
2272
            $cmdRv = $?;
2230
 
2273
 
2231
        my $ph;
2274
        } else {
2232
        open ($ph, "$s3_cmd |");
-
 
2233
        while ( <$ph> )
-
 
2234
        {
-
 
2235
            chomp;
-
 
2236
            $logger->verbose2("deletePackage:Data: $_");
2275
            $logger->warn("deletePackage: S3Deletion disabled: $pname, $pver");
2237
        }
2276
        }
2238
        close ($ph);
-
 
2239
        $cmdRv = $?;
-
 
2240
 
2277
 
2241
    } else {
2278
    } else {
2242
        #
2279
        #
2243
        #   Create the process pipe to delete the package
2280
        #   Create the process pipe to delete the package
2244
        #   ssh  ... "./delete_package ${rx_opts} \"$pname\" \"$pver\""
2281
        #   ssh  ... "./delete_package ${rx_opts} \"$pname\" \"$pver\""
Line 2480... Line 2517...
2480
    #   A few local stats
2517
    #   A few local stats
2481
    #
2518
    #
2482
    $statistics{SeqNum}++;
2519
    $statistics{SeqNum}++;
2483
    $statistics{timeStamp} = time();
2520
    $statistics{timeStamp} = time();
2484
    $statistics{upTime} = $statistics{timeStamp} - $startTime;
2521
    $statistics{upTime} = $statistics{timeStamp} - $startTime;
2485
    $statistics{wedged} = $wedgedCount++ > 30  ? 1 : 0;
2522
    $statistics{wedged} = Utils::isWedged($conf);
2486
    $statistics{state} = $statistics{wedged} ? 'Wedged' : $statistics{state}; 
2523
    $statistics{state} = $statistics{wedged} ? 'Wedged' : $statistics{state}; 
2487
    
2524
    
2488
 
2525
 
2489
    #   Reset daily accumulations - on first use each day
2526
    #   Reset daily accumulations - on first use each day
2490
    resetDailyStatistics($statistics{timeStamp});
2527
    resetDailyStatistics($statistics{timeStamp});