WebSVN – DevTools – Diff – /core_devl/trunk/TOOLS/create_dpkgFromTar.pl

 use JatsError;
 use JatsEnv;
 use FileUtils;
 use JatsSystem;
+use ArrayHashUtils;
 # define Global variables
+#
 my $VERSION = "1.0.0";
 my $PROGNAME = "create_dpkgFromTar.pl";
 our $USER;
 our $GBE_ABT;
 # Global variables
+#
-my $tmpDir;
+my $tmpDirInfo;
 my $workDir;
 my $startDir;
 my $maxHostNameLength = 8;
+my $pkgTargetDir;
+my $deleteTargetDir;
+#
 #   Option variables
+#
 my $opt_help = 0;
 my $opt_manual = 0;
 my $opt_verbose = 0;
 my $opt_pname;
 my $opt_pversion;
 my $opt_srcPath;
-my $opt_MergeErrors = 1;
+my $opt_MergeErrors = 0;
 my $opt_outputPath;
+my $opt_preDelete;
+my $opt_tmpDir;
 #-------------------------------------------------------------------------------
 # Function        : main entry point
+#
 # Description     : Main Entry point
                 'pname=s'       => \$opt_pname,             # string
                 'pversion=s'    => \$opt_pversion,          # string
                 'srcpath=s'     => \$opt_srcPath,           # string
                 'mergeErrors!'  => \$opt_MergeErrors,       # [no]flag
                 'output=s'      => \$opt_outputPath,        # String
+                'tmpdir=s'      => \$opt_tmpDir,            # String
+                'predelete!'    => \$opt_preDelete,         # [no]flag
                 );
+    #
     #   Process help and manual options
+    #
     EnvImport ('GBE_HOSTNAME');
     EnvImport ('USER' );
     EnvImport ('GBE_DPKG' );
     EnvImportOptional ('GBE_ABT', '');
+    # Defaults
+    InitFileUtils();
+    $startDir = Getcwd;
+    $opt_outputPath = $::GBE_DPKG unless defined $opt_outputPath;
+    $opt_srcPath = AbsPath($opt_srcPath) if defined $opt_srcPath;
+    $opt_tmpDir = AbsPath($opt_tmpDir) if defined $opt_tmpDir;
+    #
     #   Basic sanity testing
+    #
     Error ("Path for package fragments not specified") unless defined $opt_srcPath;
     Error ("Package fragment path not found", $opt_srcPath) unless -d $opt_srcPath;
     Error ("DPKG_ARCHIVE not found", $GBE_DPKG) unless -d $GBE_DPKG;
     Error ("Package name not specified") unless defined $opt_pname;
     Error ("Package version not specified") unless defined $opt_pversion;
+    Error ("Output path not specified" ) unless defined $opt_outputPath;
-    Error ("Output path does not exist", $opt_outputPath) if (defined $opt_outputPath && ! -d $opt_outputPath);
+    Error ("Output path does not exist", $opt_outputPath) unless -d $opt_outputPath;
+    Error ("TmpDir does not exist:", $opt_tmpDir) if (defined($opt_tmpDir) && ! -d ($opt_tmpDir));
+    #
     #   Create a temp work directory for this
     #       This will be removed on program exit
     #       Not by File:Temp as it doesn't handle the case where we have chdir'd to the temp area
+    #
-    InitFileUtils();
+    if ($opt_tmpDir)
+    {
-    $startDir = Getcwd;
+        $workDir = $opt_tmpDir;
+    }
+    else
+    {
-    $tmpDir = File::Temp->newdir( 'dpkgFromTar_XXXX', CLEANUP => 0, DIR => '/tmp' );
+        $tmpDirInfo = File::Temp->newdir( 'dpkgFromTar_XXXX', CLEANUP => 0, DIR => '/tmp' );
-    $workDir = $tmpDir->dirname;
+        $workDir = $tmpDirInfo->dirname;
+    }
     Verbose("WorkDir", $workDir);
     chdir($workDir)|| Error ("Cannot chdir to working directory: $workDir");
+    #
     #   Locate all package fragements
     $basename .= '_*.tar.gz';
     my @packageFragments = glob (catfile($opt_srcPath, $basename ));
     Error ("No package fragments found.", "Path: $opt_srcPath", "Glob: $basename" ) unless @packageFragments;
     Message("Package Fragmnets found:", @packageFragments);
-#   my %data;
-#   my $dataref;
-#   my $ee;
-#   $data{bbbb}{count}++;
-#   $dataref = $data{bbbb};
-#
-#   DebugDumpData("dataref:" . ref($dataref), $dataref);
-#   $dataref->{aaaa} = 'AAAA';
-#
-#   DebugDumpData("dataRef", $dataref);
-#   DebugDumpData("data", \%data);
-#   Error("Just Testing");
+    #
     #   Extract the built.files.<hostname>.xml and descpkg from each of package fragments
+    #   Note: Use of -m flag to tar is to overcome issues with the bsdtar used under windows
+    #         to create the tar.gz files. It appears to insert localtime and not GMT into
+    #         the file.
+    #
     my %pkgData;
     foreach my $srcfile ( @packageFragments)
+    {
-        Message ("Extacting metadata from $srcfile");
+        Message ("Extracting metadata from " . StripDir($srcfile));
         my $basename = $srcfile;
         $basename =~ s~^.*/~~;
         $basename =~ s~\.gz$~~;
         $basename =~ s~\.tar$~~;
         $basename = substr($basename, $basenameLen);
         $pkgData{$srcfile}{basename} = $basename;
         mkpath ($basename);
         Error ("Temp subdir $basename not created: $!") unless -d $basename;
-        my $rv = System ('tar', '-xzf', $srcfile,
+        my $rv = System ('tar', '-xzmf', $srcfile,
                             IsVerbose(1) ? '-v' : undef,
                             '-C', $basename,
-                            '--wildcards', './built.files.*.xml', './descpkg' );
+                            '--wildcards', './built.files.*.xml' );
         Error("Tar extraction error: $srcfile") if ($rv);
+    }
+    #
     #   Read in the XML from each of the files
+    #
     my %fileData;
     foreach my $srcfile ( keys %pkgData )
+    {
         my @extracted = glob(catfile($pkgData{$srcfile}{basename}, 'built.files.*.xml'));
-        foreach my $srcfile (@extracted)
+        foreach my $srcfile ( @extracted)
+        {
-            my $ref = XML::Simple::XMLin($srcfile);
+            my $ref = XML::Simple::XMLin($srcfile, ForceArray => 1, KeyAttr => []);
-#           DebugDumpData("REF", $ref);
+            #DebugDumpData("REF - $srcfile, " .ref($ref), $ref);
             foreach my $entry (@{$ref->{file}})
+            {
+                #   directory - no processing required
                 next if $entry->{type} eq 'dir';
+                #   link - no processing reqiuired
+                next if $entry->{type} eq 'link';
+                #   file - ensure there is no clash
                 if ($entry->{type} eq 'file')
+                {
                     # Calc max host name length for pretty printing
                     my $hostnameLen = length $entry->{host};
                     $maxHostNameLength = $hostnameLen if ($hostnameLen > $maxHostNameLength);
                         # Create new entry
                         $store->{md5sum} = $entry->{md5sum};
+                    }
                 next;
+                }
+                #   Unknown - just a warning for now
-Warning( "Unknown type:" . $entry->{fullname} . ':' . $entry->{type} );
+                Warning( "Unknown type:" . $entry->{fullname} . ':' . $entry->{type} );
+            }
+        }
+    }
+    #
         #   Some entries are allowed to differ
         #       descpkg
         #       version_*.h
         #           files as these are generated and may contain different dates and line endings
+        #
-        if ($entry eq 'aadescpkg')
+        if ($entry eq 'descpkg')
+        {
             delete $fileData{$entry};
             next;
+        }
             next;
+        }
+        #
         #   Delete entry if its not marked as bad
-        unless (exists $fileData{$entry}{bad} ) {
+        unless (exists $fileData{$entry}{bad} )
+        {
             delete $fileData{$entry};
             next;
+        }
+        #
         #   Have a merge error
-        #   Detail what has happened
+        #       Detail what has happened
+        #       Generate pretty output showning on which machines that are command.
+        #
         unless ($headerReported)
+        {
             $headerReported = 1;
             reportMergeError('Package Merge Error. File provided by different builds are not identical');
             reportMergeError('This prevents the build from being reproducible.');
+        }
         reportMergeError('File Name:  ' . $entry);
+#       foreach my $e ( @{$fileData{$entry}{hosts}} )
+#       {
+#           reportMergeError('    Provided by:  ' . sprintf('%-*s',$maxHostNameLength,$e->{host}) . '  Signature: ' . $e->{md5sum});
+#       }
+        my %md5List;
+        foreach my $e ( @{$fileData{$entry}{hosts}} ) {
+            UniquePush (\@{$md5List{$e->{md5sum}}}, $e->{host});
+        }
         foreach my $e ( @{$fileData{$entry}{hosts}} )
+        {
+            my $hostList;
+            my @sameHosts = @{$md5List{$e->{md5sum}}};
+            ArrayDelete (\@sameHosts, $e->{host});
+            if (@sameHosts) {
+                $hostList = ' Same as: ' . join(', ', @sameHosts);
+            } else {
+                $hostList = ' Unique to: '. $e->{host};
+            }
-            reportMergeError('    Provided by:  ' . sprintf('%-*s',$maxHostNameLength,$e->{host}) . '  Signature: ' . $e->{md5sum});
+            reportMergeError('    Provided by:  ' . sprintf('%-*s',$maxHostNameLength,$e->{host}) . $hostList );
+        }
+    }
     ErrorDoExit();
+    #
+    #   Calculate target package location
+    #
+    $pkgTargetDir = catdir($opt_outputPath, $opt_pname, $opt_pversion);
+    Verbose("Package Target: $pkgTargetDir");
+    RmDirTree($pkgTargetDir) if $opt_preDelete;
+    Error ("Target package directory exists") if -d $pkgTargetDir;
+    mkpath ($pkgTargetDir);
+    Error ("Package target not created: $!", $pkgTargetDir) unless -d $pkgTargetDir;
+    $deleteTargetDir = 1;
+    #
     #   Extract the archive contents and merge them into one directory
     #       If there are overlaps - don't replace them
-    #       Work in a temp directory so that partial packages are not seen
+    #
-    my $pkgDir = 'pkg';
-    mkpath ($pkgDir);
-    Error ("Temp subdir $basename not created: $!") unless -d $pkgDir;
     foreach my $srcfile ( keys %pkgData )
+    {
-        Message ("Extacting all files from $srcfile");
+        Message ("Extracting all files from " . StripDir($srcfile));
-        my $rv = System ('tar', '-xzf', $srcfile, IsVerbose(1) ? '-v' : undef, '-C', $pkgDir );
+        my $rv = System ('tar', '-xzmf', $srcfile, IsVerbose(1) ? '-v' : undef, '-C', $pkgTargetDir );
         Error("Tar extraction error: $srcfile") if ($rv);
+    }
+    #
     #   Fix file permissions
     #   We know we are running under unix so we will use a unix command
+    #
     Message('Setting file permissions');
-    System('chmod', '-R', 'a+rx', $pkgDir);
+    System('chmod', '-R', 'a+rx', $pkgTargetDir);
+    #
     #   Fix descpkg file
     #   Original create_dpkg uses the CopyDescpkg function. This is a bit wonky
     #   All it appears to do is:
     #       Force build machine name
     #       Force user name
     #       Force build time into the descpkg file
     #  If a package was built on multiple machines then the build machine names were lost
     #
+    #   This implementation
+    #       Use the descpkg file in the first package fragment
+    #       There is enough other information in the build system to track where the package
+    #       was built. This was not available when CopyDescpkg was implemented
-    #
-    #   Move the package to its final resting place within the target archive
-    #
-    my $pkgTargetDir = catdir($opt_outputPath, 'MergedPackage');
-    Message('Move assembled package to:' . $pkgTargetDir);
-    Message('Move from:' . $pkgDir);
-    mkpath ($pkgTargetDir);
-    RmDirTree($pkgTargetDir);
-    System('mv', $pkgDir, $pkgTargetDir ) && Error('Cannot move assembled package into archive');
+    #
     #   All Done
+    #       Flag  - don't cleanup generated dierctory
     #
+    Information("Package Target: $pkgTargetDir");
+    $deleteTargetDir = 0;
     exit 0;
 #-------------------------------------------------------------------------------
 # Function        : END
+#
+{
+    #
     #   Delete everything in the temp directory
     #   It was a directory created by this instance for the use of this instance
+    #
-    if ($startDir)
+    if ($tmpDirInfo)
+    {
         Message("Cleanup processing");
         chdir($startDir);
-        Warning("TMPDIR exists: $tmpDir") if (-d $tmpDir);
-        #RmDirTree($tmpDir);
+        RmDirTree($workDir);
-        if (-d $tmpDir)
+        if (-d $workDir)
+        {
-            Warning("TMPDIR still exists: $tmpDir");
+            Warning("TMPDIR still exists: $workDir");
+        }
+    }
+    elsif ($workDir)
+    {
+        Message ("Retaining workdir: $workDir");
+    }
+    #
+    #   Delete the package target dir
+    #   We must have created it - as we error if it exists.
+    #
+    #   Remove the packageName and packageVersion directories fi possible
+    #
+    if ($deleteTargetDir)
+    {
+        Message("Remove partially created package");
+        RmDirTree($pkgTargetDir);
+        my $pkgDir = StripFileExt($pkgTargetDir);
+        rmdir($pkgDir) && Message("Remove package dir: $pkgDir");
+    }
+}
 #-------------------------------------------------------------------------------
 # Function        : reportMergeError
+#
 # Returns         : Nothing
+#
 sub reportMergeError
+{
-    $opt_MergeErrors ? ReportError(@_) : Warning(@_);
+    $opt_MergeErrors ? Warning(@_) : ReportError(@_);
+}
 #-------------------------------------------------------------------------------
 #   Documentation
+#
     -verbose           - Display additional progress messages
     -pname=name        - Ensure package is named correctly
     -pversion=version  - Ensure package version is correct
     -srcdir=path       - Location of the package fragments
+  Debug and Testing:
+    -[no]mergeErrors   - Allow merge errors
+    -[no]predelete     - Predelete generated package
+    -output=path       - Base of test package archive
 =head1 OPTIONS
 =over 8
 =item B<-help>
 =item B<-pversion=version>
 The version of the target package.
+=item B<-[no]mergeErrors>
+This option allows the merging process to continue if merge errors are located.
+The default is -noMergeErrors
+This option is  intended for testing use only.
+=item B<-[no]predelete>
+This option will delete the target package instance before the package is assembled.
+The default is -noPreDelete
+This option is  intended for testing use only.
+=item B<-output=path>
+This option allows the user to specify to root of a test package archive.
+The dafualt is to use the value provided by GBE_DPKG - the main package archive.
+This option is  intended for testing use only.
 =back
 =head1 DESCRIPTION
 This utility program is used by the build system to merge build artifacts from several
 =item *
 File permisions will be adjusted. All directories will be made world readable and all files will be made world executable.
-=item *
-The assembled package is then moved to its final location within the pakage archive.
-This will prevent partial packages being available to users. The creation will be atomic.
 =back
 =cut

Subversion Repositories DevTools

(root)/core_devl/trunk/TOOLS/create_dpkgFromTar.pl @ 5486 – Rev 5485 → 5486