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

+#
 # Returns         :
+#
 sub transferTargetBin
+{
+    return if $isS3Target;
     my ($blatBinData) = @_;
     my $blatBinList = getBlatBin();
     foreach my $file ( keys %{$blatBinList} )
+    {
+    #
     #   Is Release List Processing active
     #   Can configure blat to disable release sync
     #   This will then allow 'new' packages to be sent
+    #
-    if ( $conf->{maxpackages} == 0 || $conf->{'synctime'} <= 0 || $isS3Target )
+    if ( $conf->{maxpackages} == 0 || $conf->{'synctime'} <= 0 )
+    {
         $logger->verbose2("processReleaseList disabled");
         $RemotePkgList = {};
         return;
+    }
+    #
     checkForBasicTools();
+    #
     #   Get list of packages from Remote site
-    #   Invoke a program on the remote site and parse the results
-    #
-    #   Returned data looks like:
-    #       Metadata avail="140100452"
-    #       BlatBin MD5="9e2c6e45af600a20a01dbcb7570da1f1" file="stat.pl"
-    #       time="1497586865" GMT="Fri Jun 16 04:21:05 2017" pname="ERGissaccounts" pver="1.0.7169.mas"
-    #       time="1497586865" GMT="Fri Jun 16 04:21:05 2017" pname="ERGissaccounts" pver="1.0.7169.mas" "link=latest"
-    #       time="1497954104" GMT="Tue Jun 20 10:21:44 2017" pname="ERGissaccounts" pver="1.0.7178.mas" deleted="0"
+    #
     my $remotePkgList;
     my $remoteData;
     my $blatBinData;
-    my $ph;
-    my $tgt_cmd = "$conf->{'bindir'}/get_plist.pl";
-    my $ssh_cmd = sshCmd($tgt_cmd);
-    $logger->verbose2("processReleaseList:ssh_cmd:$ssh_cmd");
-    open ($ph, "$ssh_cmd |");
-    while ( <$ph> )
-    {
+    #
+    #   Get Data from an S3 bucket
+    #   Can only get a part of the full data set. The timestamp can't be processed, so set it to -1
-        chomp;
+    #
-        if ($_ =~ m~^Metadata\s+~)
+    if ($isS3Target ) {
-        {
+        my $ph;
-            parsePkgMetaData($_, \%{$remoteData});
+        my $tgt_cmd = "aws s3 ls $conf->{'S3Bucket'}/";
+        $logger->verbose2("processReleaseList:s3_cmd:$tgt_cmd");
-        }
+        open ($ph, "$tgt_cmd |");
-        elsif ($_ =~ m~^BlatBin\s+~)
+        while ( <$ph> )
+        {
+            chomp;
+            m~.*\s(.*)__(.*).tgz$~;
-            parseBlatBinData($_, \%{$blatBinData})
+            $remotePkgList->{$1}{$2}{s3} = 1;
+        }
+        close ($ph);
+    } else {
+        # Get Data from a dpkg_archive maintained via ssh
+        #   Invoke a program on the remote site and parse the results
-        else
+        #
+        #   Returned data looks like:
+        #       Metadata avail="140100452"
+        #       BlatBin MD5="9e2c6e45af600a20a01dbcb7570da1f1" file="stat.pl"
+        #       time="1497586865" GMT="Fri Jun 16 04:21:05 2017" pname="ERGissaccounts" pver="1.0.7169.mas"
+        #       time="1497586865" GMT="Fri Jun 16 04:21:05 2017" pname="ERGissaccounts" pver="1.0.7169.mas" "link=latest"
+        #       time="1497954104" GMT="Tue Jun 20 10:21:44 2017" pname="ERGissaccounts" pver="1.0.7178.mas" deleted="0"
+        my $ph;
+        my $tgt_cmd = "$conf->{'bindir'}/get_plist.pl";
+        my $ssh_cmd = sshCmd($tgt_cmd);
+        $logger->verbose2("processReleaseList:ssh_cmd:$ssh_cmd");
+        open ($ph, "$ssh_cmd |");
+        while ( <$ph> )
+        {
+            chomp;
-            if ( parsePkgList($_, \%{$remotePkgList} ) )
+            if ($_ =~ m~^Metadata\s+~)
+            {
-                $logger->verbose2("processReleaseList:Data: $_");
+                parsePkgMetaData($_, \%{$remoteData});
+            }
+            elsif ($_ =~ m~^BlatBin\s+~)
+            {
+                parseBlatBinData($_, \%{$blatBinData})
+            }
             else
+            {
+                if ( parsePkgList($_, \%{$remotePkgList} ) )
+                {
+                    $logger->verbose2("processReleaseList:Data: $_");
+                }
+                else
+                {
-                $logger->warn("processReleaseList:Bad Data: $_");
+                    $logger->warn("processReleaseList:Bad Data: $_");
+                }
+            }
+        }
+        close ($ph);
+    }
-    close ($ph);
     $logger->verbose("processReleaseList:End: $?");
     $RemotePkgList = $remotePkgList;
     LogTxError ($?);
     if ( $? != 0 )
+                #
                 #   Add the package the link points to
+                #
                 $logger->verbose2("Add linked package: $pname, $lver, $pdata");
                 $pkgList->{$pname}{$lver} = $pdata;
+                if ($isS3Target) {
+                    $logger->verbose2("Won't send symlink to S3: $pname, $pver, $lver");
+                    next;
+                }
+            }
             $logger->verbose2("Add extra package: $pname, $pver, $pdata");
             $pkgList->{$pname}{$pver} = $pdata;
+        }
+    }
 #Utils::DebugDumpData ("parsePkgList", $rv);
+#Utils::DebugDumpData ("remotePkgList", $remotePkgList);
+    #
     #   If there are no packages to process, then assume that this is an error
     #   condition. Retry the operation soon.
+            #
             #   Take care not to create an entry into $remotePkgList->{$pname}{$pver}
             #   if it does not exist. Existence of {$pname}{$pver} is used later
+            #
-            my $tmtime = 0;
+            my $tmtime = undef;
             if ($existsRemote && exists ($remotePkgList->{$pname}{$pver}{time})) {
                 $tmtime = $remotePkgList->{$pname}{$pver}{time};
+            }
             $packageVersionCount++;
                     $writableCount++;
                     next;
+                }
+            }
-            if ( $mtime != $tmtime ) {
+            if (! $existsRemote ) {
+                #
+                #   Package does not exist in the remote, and is eligible for transfer
+                #
+                $logger->verbose("Package Needs to be transferred: $pname, $pver");
+                $must_transfer = 1;
+            } elsif ( defined $tmtime && ($mtime != $tmtime) ) {
+                #
+                #   Package exists in both source and target
+                #   If the package-time is known, then ensure that they are the same
+                #
                 $logger->verbose("Package Needs to be transferred: $pname, $pver, $mtime, $tmtime");
                 $must_transfer = 1;
+            }
-            elsif ($existsRemote)
+            else
+            {
+                #
                 #   Package exists in both source and target
                 #   Symlink test: Ensure symlinks are the same
+                #
 #                   Don't really care about any errors from this process
 #                   Its not essential
+#
 sub sendPackageList
+{
+    return if $isS3Target;
     my ($pkgList) = @_;
     my ($fh, $filename) = tempfile( "/tmp/blat.$$.XXXX", SUFFIX => '.txt');
     $logger->verbose("sendPackageList:TmpFile: $filename");
     return if $conf->{'noTransfers'};
                     $txcount = 0;
                     $tagDirTime = 0;
                     last send_tags;
+                }
-                #
+#               #
-                #   Don't transfer 'extra' packages
+#               #   Don't transfer 'extra' packages
+#               #   Removed. It was casuing a tarZip to be triggered, but never transferred
-                #
+#               #
-                if (exists ($extraPkgs->{$package}) )
+#               if (exists ($extraPkgs->{$package}) )
-                {
+#               {
-                    $logger->warn ("Delete excess package tag: $package::$version");
+#                   $logger->warn ("Delete excess package tag: $package::$version");
-                    unlink $file;
+#                   unlink $file;
+#
+#               } else
-                } elsif ( transferPackage( $package, $version )) {
+                if ( transferPackage( $package, $version )) {
                     unlink $file;
+                }
                 else
+                {
                     if ($conf->{'tagage'} > 0) {
 sub transferPackage
+{
     my ($pname, $pver ) = @_;
     my $rv = 0;
     my $cmdRv = 0;
-    $logger->logmsg("transferPackage: @_");
+    $logger->verbose("Enter transferPackage: @_");
     my $startTime = time;
+    #
     #   Do not transfer excluded files
+    #
         $logger->verbose("transferPackage: tarZip not found - $tzpath");
         $conf->{'tagdir'} =~ m~^(.*)/~;
         my $tagRoot = $1;
         my $tag = "$pname::$pver";
-        Utils::TouchFile($conf, catfile($tagRoot, 'tarZip', $tag));
+        my $zipTag = catfile($tagRoot, 'tarZip', $tag);
+        my $myTag =  catfile($conf->{'tagdir'} , $tag);
+        $logger->logmsg("transferPackage. Request Zip: @_") unless ( -f $zipTag && -f $myTag );
+        Utils::TouchFile($conf, $myTag) unless -f $myTag;
+        Utils::TouchFile($conf, $zipTag) unless -f $zipTag;
         return 0;
+    }
     ###########################################################################
     #   Transfer the package / symlink
+    #
+    $logger->logmsg("transferPackage: @_");
+    my $tzfsize = -s $tzpath;
     if ($isS3Target) {
         $cmdRv = transferPackageS3($tzdir, $tzfile, $pname, $pver);
     } else {
         $cmdRv = transferPackageSsh($tzdir, $tzfile, $sfile, $pname, $pver);
+    }
+    #
-    #   Display the size of the package
+    #   Display the size of the package (tarZipped)
     #       Diagnostic use
+    #
     if ($conf->{txdetail}) {
-        my $ph;
-        open ( $ph, "du -bs $sfile 2>/dev/null |" );
-        my $line = <$ph>;
-        $line =~ m/^([0-9]+)/;
-        $line = $1 || 0;
-        my $size = sprintf "%.3f", $line / 1024 / 1024 / 1024 ;
+        my $size = sprintf "%.3f", $tzfsize / 1024 / 1024 / 1024 ;
-        close $ph;
         my $duration = time - $startTime;
         $logger->logmsg("transferPackage: Stats: $pname, $pver, $size Gb, $duration Secs");
+    }
     if ( $cmdRv == 0 ) {
+#
 # Inputs          : $pname          - Name of the package
 #                   $pver           - Package version
 #                   $pdata          - Hash of extra data
+#
-# Returns         : true    - Package transferred
+# Returns         : true    - Package deleted
-#                   false   - Package not transferred
+#                   false   - Package not deleted
+#
 sub deletePackage
+{
     my ($pname, $pver, $pdata ) = @_;
     my $rv = 0;
     my $cmdRv = 0;
     $logger->logmsg("deletePackage: $pname, $pver");
-    #
+    if ($isS3Target) {
-    #   Create the process pipe to delete the package
+        #   Create the process pipe to delete the package
-    #   ssh  ... "./delete_package ${rx_opts} \"$pname\" \"$pver\""
-    #
-    unless ($conf->{'noTransfers'}) {
-        my $ph;
-        my $flags = $pdata->{FORCEDELETE}  ? '' : ' -T';
-        my $tgt_cmd = "$conf->{'bindir'}/delete_package $flags \"$pname\" \"$pver\"";
-        my $ssh_cmd = sshCmd($tgt_cmd);
-        $logger->verbose2("deletePackage:tgt_cmd:$tgt_cmd");
+        my $tzfile = $pname . '__' . $pver . '.tgz';
+        my $s3_cmd = "aws --profile $conf->{'S3Profile'} s3 rm s3://$conf->{'S3Bucket'}/$tzfile";
-        $logger->verbose2("deletePackage:ssh_cmd:$ssh_cmd");
+        $logger->verbose2("deletePackage:s3_cmd:$s3_cmd");
+        my $ph;
-        open ($ph, "$ssh_cmd |");
+        open ($ph, "$s3_cmd |");
         while ( <$ph> )
+        {
             chomp;
             $logger->verbose2("deletePackage:Data: $_");
+        }
         close ($ph);
         $cmdRv = $?;
+    } else {
+        #
+        #   Create the process pipe to delete the package
+        #   ssh  ... "./delete_package ${rx_opts} \"$pname\" \"$pver\""
+        #
+        unless ($conf->{'noTransfers'}) {
+            my $ph;
+            my $flags = $pdata->{FORCEDELETE}  ? '' : ' -T';
+            my $tgt_cmd = "$conf->{'bindir'}/delete_package $flags \"$pname\" \"$pver\"";
+            my $ssh_cmd = sshCmd($tgt_cmd);
+            $logger->verbose2("deletePackage:tgt_cmd:$tgt_cmd");
+            $logger->verbose2("deletePackage:ssh_cmd:$ssh_cmd");
+            open ($ph, "$ssh_cmd |");
+            while ( <$ph> )
+            {
+                chomp;
-        $logger->verbose("deletePackage:End: $?");
+                $logger->verbose2("deletePackage:Data: $_");
+            }
+            close ($ph);
+            $cmdRv = $?;
+        }
+    }
+    #
+    #   Common code
+    #
+    $logger->verbose("deletePackage:End: $cmdRv");
     if ( $cmdRv == 0 )
+    {
         $rv = 1;
         $statistics{delCount}++;
         delete $RemotePkgList->{$pname}{$pver};

Subversion Repositories DevTools

(root)/dpkg_blat/trunk/src/blat/blatDaemon.pl – Rev 7387 → 7389