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

     'verbose'         => {'default'   => 0      , 'fmt' => 'int'},                  # Debug ...
     'active'          => {'default'   => 1      , 'fmt' => 'bool'},                 # Disable alltogether
     'debug'           => {'default'   => 0      , 'fmt' => 'bool'},                 # Log to screen
     'txdetail'        => {'default'   => 0      , 'fmt' => 'bool'},                 # Show transfer times
     'noTransfers'     => {'default'   => 0      , 'fmt' => 'bool'},                 # Debugging option to prevent transfers
-    'transferDir'     => {'default'   => 'pkg/S3TRANSFER' , 'fmt' => 'text'},
+    's3File'          => {'default'   => 's3Transfer.json', 'fmt' => 'text'},       # Undocumented - debug only
     'tagdir'          => {'mandatory' => 1      , 'fmt' => 'mkdir'},
     'workdir'         => {'mandatory' => 1      , 'fmt' => 'mkdir'},
     'forcedirscan'    => {'default'   => 100    , 'fmt' => 'period'},
     'forces3update'   => {'default'   => '30m'  , 'fmt' => 'period'},
         $reason = 'NoS3Data';
     } elsif (! exists $activeReleases->{$rtag_id}{depsig}) {
         $reason = 'NoSavedData';
-    } elsif ($activeReleases->{$rtag_id}{depsig} ne $depsig ) {
+    } elsif ( $activeReleases->{$rtag_id}{depsig} ne $depsig ) {
         $reason = "Mismatch: $activeReleases->{$rtag_id}{depsig} ne $depsig";
     } else {
         $logger->verbose("Dependencies unchanged - upload skipped");
         $activeReleases->{$rtag_id}{seqnum} = $seqnum;
     #       Update the manifest entries
+    #
     my $startTime = time;
     my $zip = Archive::Zip->new();
     foreach my $entry (@{$curData}) {
+        #
+        #   The TxList will contain information on every file to be transferred
+        #   The data is an array of entries
+        #   Each entry is a hash of name, version, an array of files
+        #   Each file entry will be of the form
+        #       srcFilePath [targetFilePath]
+        #       The [targetFilePath] is optional. If not present, then the target is the same as the source
+        #
-        my $src = getPackageBase($entry->[0], $entry->[1]);
+        my $pkgList = getPackageTxList($entry->[0], $entry->[1]);
-        if (defined $src) {
+        if ($pkgList) {
-            $logger->verbose("Zip addTree Src: $src");
             my %data;
             $data{name} = $entry->[0];
             $data{version} = $entry->[1];
             $data{pvid} = $entry->[2];
             push @{$manifest->{Packages}}, \%data;
+            foreach my $pentry (@{$pkgList->{packages}}) {
+                my $pkgBase = getPackageBase($pentry->{name}, $pentry->{version});
+                if ($pkgBase) {
+                    my @txList = @{$pentry->{files}};
-            if ( $zip->addTree( $src, '' ) != AZ_OK ) {
+                    foreach my $fileEntry (@txList) {
+                        my ($src,$dst);
+                        if ($fileEntry =~ m~(.*) \[(.*)\]$~) {
+                            $src = $1;
+                            $dst = $2;
+                            $logger->verbose("Zip add: $pentry->{name}:$pentry->{version}:$src as $dst");
+                        } else {
+                            $dst = $src = $fileEntry;
+                            $logger->verbose("Zip add: $pentry->{name}:$pentry->{version}:$src");
+                        }
+                        $src = catdir($pkgBase, $src);
+                        unless (-f $src) {
-                $logger->warn("Zip addTree Error: $rtag_id");
+                            $logger->warn("Cannot find file: $src");
+                            return;
+                        }
+                        $zip->addFile($src, $dst);
-                return;
+                    }
+                }
+            }
+        }
+    }
     #   Add the manifest into the zip
+    #       Set its modifiedTime to a fixed value, so that it doesn't keep changing
+    #       Must use a time >= 1980.
+    #
-    my $jsonText = to_json( $manifest, { ascii => 1, pretty => 1 });
+    my $jsonText = to_json( $manifest, { ascii => 1, pretty => 1, canonical => 1 });
+    $logger->verbose("Zip add: ReleaseManifest.json" );
-    $zip->addString( $jsonText, 'ReleaseManifest.json' );
+    my $member = $zip->addString( $jsonText, 'ReleaseManifest.json' );
+    $member->setLastModFileDateTimeFromUnix( 900000000 );
-    $logger->verbose("ManfestJson: $jsonText");
+    $logger->verbose2("ManifestJson: $jsonText");
     #   Generate the zip file
     my $zipFile = catdir( $conf->{'workdir'} , 'Images-' . $rtag_id . '.zip');
     if ( $zip->writeToFileNamed($zipFile) != AZ_OK ) {
         $logger->warn("Zip write Error: $rtag_id");
         $activeReleases->{$rtag_id}{s3}{sent} = 1;
+    }
+}
 #-------------------------------------------------------------------------------
+# Function        : getPackageTxList
+#
+# Description     : Locate and read in the s3Transfer.json file found with
+#                   the specified package
+#
+# Inputs          : $pname      - Package name
+#                   $pver       - Package version
+#
+#
+# Returns         : undef - bad
+#                   Ref to a hash of data
+sub getPackageTxList {
+    my ($pname, $pver) = @_;
+    #
+    #   Locate package
+    #
+    my $pkgBase = getPackageBase($pname, $pver);
+    return undef unless $pkgBase;
+    my $src = catdir( $pkgBase, $conf->{s3File});
+    unless ( -f $src ) {
+        $logger->verbose("getPackageTxList: Package has no $conf->{s3File}: $pname, $pver");
+        return undef;
+    }
+    #
+    #   Read the entire file into a string
+    #
+    my $fh;
+    unless (open ( $fh, '<', $src) ) {
+        $logger->verbose("getPackageTxList: Cannot open s3Transfer.json: $pname, $pver, $!");
+        return undef;
+    }
+    my $jsontext = do { local $/; <$fh> };
+    close $fh;
+    my $json = from_json($jsontext);
+    unless ( exists $json->{format}) {
+        $logger->verbose("getPackageTxList: s3Transfer.json has no format: $pname, $pver");
+        return undef;
+    }
+    unless ( exists $json->{packages}) {
+        $logger->verbose("getPackageTxList: s3Transfer.json has no packages: $pname, $pver");
+        return undef;
+    }
+    return $json;
+}
+#-------------------------------------------------------------------------------
 # Function        : getPackageBase
+#
 # Description     : Calculate the base of a package in dpkg_archive
 #                   With errors and wanings
+#
 # Inputs          : $pname      - Package name
 #                   $pver       - Package version
+#
+#
 # Returns         : undef - bad
-#                   Path to the S3TRANSFER section within the archive
+#                   Path to root of the package in dpkg_archive
 sub getPackageBase {
     my ($pname, $pver) = @_;
+    #
     #   Locate package
+    #
     unless ( -d $conf->{'dpkg_archive'}) {
-        $logger->warn("addPartsToImage: dpkg_archive not found");
+        $logger->warn("getPackageBase: dpkg_archive not found");
         return undef;
+    }
     my $src = catdir($conf->{'dpkg_archive'}, $pname, $pver);
     unless ( -d $src ) {
-        $logger->warn("addPartsToImage: Package not found: $pname, $pver");
+        $logger->warn("getPackageBase: Package not found: $pname, $pver");
         return undef;
+    }
-    $src = catdir( $src, $conf->{'transferDir'});
-    unless ( -d $src ) {
-        $logger->verbose("addPartsToImage: Package has no $conf->{'transferDir'}: $pname, $pver");
-        return undef;
-    }
     return $src;
+}
 #-------------------------------------------------------------------------------
 # Function        : generateBucketZipName

Subversion Repositories DevTools

(root)/dpkg_blat/trunk/src/blat/blatS3Sync.pl @ 7413 – Rev 7410 → 7413