Subversion Repositories DevTools

Rev

Rev 5527 | Rev 5578 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
5527 dpurdie 1
########################################################################
2
# Copyright (c) VIX TECHNOLOGY (AUST) LTD
3
#
4
# Module name   : assemble_dpkg.pl
5
# Module type   : JATS Utility
6
# Compiler(s)   : Perl
7
# Environment(s): jats
8
#
9
# Description   : This JATS utility is used by the build system to merge
10
#                 build artifacts from multiple build machines into one
11
#                 package.
12
#                 
13
#                 It complements the 'tarmode' provided by create_dpkg
14
#                 
15
#                 It is not intended to be run by a user.
16
#                 It is not intended to be run directly by the build system
17
#                 It is intended to be run from the build daemons via a shh session
18
#                       Progress is reported via stdout
19
#                       Exit code indicates success or error
20
#
21
# Usage         : See POD at the end of this file
22
#
23
#......................................................................#
24
 
25
require 5.008_002;
26
 
27
# Include Standard Perl Functions
28
#
29
use strict;
30
use warnings;
31
use Cwd;
32
use Getopt::Long;
33
use File::Basename;
34
use File::Find;
35
use File::Path;
36
use File::Copy;
37
use Pod::Usage;
38
use XML::Simple;
39
use Encode qw(decode encode);
40
use File::Temp qw/ tempfile tempdir /;
41
 
42
use JatsError;
43
use JatsEnv;
44
use FileUtils;
45
use JatsSystem;
46
use ArrayHashUtils;
47
 
48
# define Global variables
49
#
50
my $VERSION = "1.0.0";
51
my $PROGNAME = "assemble_dpkg.pl";
52
 
53
# Globals imported from environment
54
#
55
our $USER;
56
our $GBE_ABT;
57
our $GBE_DPKG;
58
 
59
 
60
# Global variables
61
#
62
my $tmpDirInfo;
63
my $workDir;
64
my $startDir;
65
my $maxHostNameLength = 8;
66
my $maxTypeLength = 8;
67
my $pkgTargetDir;
68
my $deleteTargetDir;
69
my @packageFragments;
70
 
71
#
72
#   Option variables
73
#
74
my $opt_help = 0;
75
my $opt_manual = 0;
76
my $opt_verbose = 0;
77
my $opt_pname;
78
my $opt_pversion;
79
my $opt_srcPath;
80
my $opt_MergeErrors = 0;
81
my $opt_outputPath;
82
my $opt_preDelete;
83
my $opt_tmpDir;
84
my $opt_keepFragments;
85
my $opt_testArchive;
5568 dpurdie 86
my $opt_DeleteVersion;
5527 dpurdie 87
 
88
#-------------------------------------------------------------------------------
89
# Function        : main entry point 
90
#
91
# Description     : Main Entry point
92
#
93
# Inputs          : 
94
#
95
# Returns         : 
96
#
97
    # Process any command line arguements...
98
    my $result = GetOptions (
99
                'help:+'            => \$opt_help,              # flag, multiple use allowed
100
                'manual:3'          => \$opt_help,              # flag
101
                'verbose:+'         => \$opt_verbose,           # flag, multiple use allowed
102
                'pname=s'           => \$opt_pname,             # string
103
                'pversion=s'        => \$opt_pversion,          # string
104
                'srcpath=s'         => \$opt_srcPath,           # string
105
                'mergeErrors!'      => \$opt_MergeErrors,       # [no]flag
106
                'output=s'          => \$opt_outputPath,        # String
107
                'tmpdir=s'          => \$opt_tmpDir,            # String
108
                'predelete!'        => \$opt_preDelete,         # [no]flag
109
                'keepFragments!'    => \$opt_keepFragments ,    # [no]flag
110
                'testArchive'       => \$opt_testArchive,       # [no]flag
5568 dpurdie 111
                'DeleteVersion'     => \$opt_DeleteVersion,     # flag
5527 dpurdie 112
                );              
113
 
114
    #
115
    #   Process help and manual options
116
    #
117
    pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result);
118
    pod2usage(-verbose => 1)  if ($opt_help == 2 );
119
    pod2usage(-verbose => 2)  if ($opt_help > 2);
120
 
121
    #
122
    #   Init the error and message subsystem
123
    #
124
    ErrorConfig( 'name'    =>'CREATE_DPKG',
125
                 'verbose' => $opt_verbose );
126
 
127
    if ($opt_verbose)
128
    {
129
       Verbose ("Program: $PROGNAME");
130
       Verbose ("Version: $VERSION");
131
    }
132
 
133
    #
134
    #   Needed EnvVars
135
    #
136
    EnvImport ('GBE_DPKG' );
137
    EnvImportOptional ('GBE_ABT', '');
138
 
139
    # Defaults
140
    InitFileUtils();
141
    $startDir = Getcwd;
142
    $::GBE_DPKG = catdir ($::GBE_DPKG, '.dpkg_archive', 'test_dpkg') if $opt_testArchive;
143
    $opt_outputPath = $::GBE_DPKG unless defined $opt_outputPath;
144
    $opt_tmpDir = AbsPath($opt_tmpDir) if defined $opt_tmpDir;
145
    $opt_srcPath = catdir($::GBE_DPKG, '.dpkg_archive', 'fragments') unless ($opt_srcPath);
146
    $opt_srcPath = AbsPath($opt_srcPath) if defined $opt_srcPath;
147
    $pkgTargetDir = catdir($opt_outputPath, $opt_pname, $opt_pversion);
148
 
149
    #
150
    #   Basic sanity testing
151
    #
152
    Error ("Path for package fragments not specified") unless defined $opt_srcPath;
153
    Error ("Package fragment path not found", $opt_srcPath) unless -d $opt_srcPath;
154
    Error ("DPKG_ARCHIVE not found", $GBE_DPKG) unless -d $GBE_DPKG;
155
    Error ("Package name not specified") unless defined $opt_pname;
156
    Error ("Package version not specified") unless defined $opt_pversion;
157
    Error ("Output path not specified" ) unless defined $opt_outputPath;
158
    Error ("Output path does not exist", $opt_outputPath) unless -d $opt_outputPath;
159
    Error ("TmpDir does not exist:", $opt_tmpDir) if (defined($opt_tmpDir) && ! -d ($opt_tmpDir));
160
 
161
    #
5568 dpurdie 162
    #   Alternate Modes
163
    #   These will not return, but will exis the utility
164
    #   
165
    if ($opt_DeleteVersion)
166
    {
167
        DeletePackageVersion();
168
        exit 1;
169
    }
170
 
171
 
172
    #
5527 dpurdie 173
    #   Create a temp work directory for this
174
    #       This will be removed on program exit 
175
    #       Not by File:Temp as it doesn't handle the case where we have chdir'd to the temp area
176
    #
177
    if ($opt_tmpDir)
178
    {
179
        $workDir = $opt_tmpDir;
180
    }
181
    else
182
    {
183
        $tmpDirInfo = File::Temp->newdir( 'assembleDpkg_XXXX', CLEANUP => 0, DIR => '/tmp' );
184
        $workDir = $tmpDirInfo->dirname;
185
    }
186
    Verbose("WorkDir", $workDir);
187
    chdir($workDir)|| Error ("Cannot chdir to working directory: $workDir");
188
 
189
    #
190
    #   Information for the user
191
    #
192
    Information ("---------------------------------------------------------------");
193
    Information ("Dpkg fragment assembly tool");
194
    Information ("Version: $VERSION");
195
    Information ("");
196
    Information ("Information:");
197
    Information ("Working dir   = [$workDir]");
198
    Information ("Fragment dir  = [$opt_srcPath]");
199
    Information ("Repository    = [$GBE_DPKG]");
200
    Information ("Target dir    = [$pkgTargetDir]");
201
    Information ("DPKG_NAME     = [$opt_pname]");
202
    Information ("DPKG_VERSION  = [$opt_pversion]");
203
    Information ("GBE_ABT       = [$GBE_ABT]");
204
    Information ("")                                      if ( $opt_keepFragments || $opt_preDelete || $opt_MergeErrors || $opt_testArchive);
205
    Information ("Opt:mergeErrors     = Allowed")         if ( $opt_MergeErrors );
206
    Information ("Opt:keepFragments   = Enabled")         if ( $opt_keepFragments );
207
    Information ("Opt:preDelete       = Enabled")         if ( $opt_preDelete );
208
    Information ("Opt:testArchive     = Enabled")         if ( $opt_testArchive );
209
    Information ("---------------------------------------------------------------");
210
 
211
    #
212
    #   Locate all package fragements
213
    #   There must be at least one
214
    #   Package fragments are named after the package name and version and have a .tar.gz suffix
215
    #
216
    my $basename = join('_', $opt_pname, $opt_pversion);
217
    my $basenameLen = 1 + length $basename;
218
    $basename .= '_*.tar.gz';
219
    @packageFragments = glob (catfile($opt_srcPath, $basename ));
220
    Error ("No package fragments found.", "Path: $opt_srcPath", "Glob: $basename" ) unless @packageFragments;
221
    Message("Package fragments found:", @packageFragments);
222
 
223
    #
224
    #   Extract the built.files.<hostname>.xml and descpkg from each of package fragments
225
    #   Note: Use of -m flag to tar is to overcome issues with the bsdtar used under windows
226
    #         to create the tar.gz files. It appears to insert localtime and not GMT into 
227
    #         the file.
228
    #
229
    my %pkgData;   
230
    foreach my $srcfile ( @packageFragments)
231
    {
232
        Message ("Extracting metadata from " . StripDir($srcfile));
233
        my $basename = $srcfile;
234
        $basename =~ s~^.*/~~;
235
        $basename =~ s~\.gz$~~;
236
        $basename =~ s~\.tar$~~;
237
        $basename = substr($basename, $basenameLen);
238
        $pkgData{$srcfile}{basename} = $basename;
239
        mkpath ($basename);
240
        Error ("Temp subdir $basename not created: $!") unless -d $basename;
241
        my $rv = System ('tar', '-xzmf', $srcfile, 
242
                            IsVerbose(1) ? '-v' : undef, 
243
                            '-C', $basename, 
244
                            '--wildcards', './built.files.*.xml' );
245
        Error("Tar extraction error: $srcfile") if ($rv);
246
    }
247
 
248
    #
249
    #   Read in the XML from each of the files
250
    #   Process the XML
251
    #       Detect merge clashes
252
    #       Create new XML - assuming the extraction will NOT overwrite existing files
253
    #
254
    my %fileData;
255
    my @newXml;
256
    foreach my $srcfile ( keys %pkgData )
257
    {
258
        my @extracted = glob(catfile($pkgData{$srcfile}{basename}, 'built.files.*.xml'));
259
        foreach my $srcfile ( @extracted)
260
        {
261
            my $ref = XML::Simple::XMLin($srcfile, ForceArray => 1, KeyAttr => []);
262
            #DebugDumpData("REF - $srcfile, " .ref($ref), $ref);
263
 
264
            my $entryExists;
265
            my $keepEntry;
266
            foreach my $entry (@{$ref->{file}})
267
            {
268
                #
269
                #   Calculate some common data items
270
                #       Calc max host name length for pretty printing
271
                my $hostnameLen = length ($entry->{host} || '');
272
                $maxHostNameLength = $hostnameLen if ($hostnameLen > $maxHostNameLength);
273
 
274
                my $typeLen = length ($entry->{type} || '');
275
                $maxTypeLength = $typeLen if ($typeLen > $maxTypeLength);
276
 
277
                my $hostEntry = {host => $entry->{host}, md5sum => $entry->{md5sum}, type => $entry->{type}};
278
                push @{$fileData{$entry->{fullname}}{hosts}}, $hostEntry;
279
                my $store = $fileData{$entry->{fullname}};
280
 
281
                #
282
                #   Determine if we have seen this file before
283
                #   If so then we need to:
284
                #       Perform a merge clash
285
                #       Ensure that its of the same type
286
                #       Mark the new XML as 'merge'
287
                #
288
                $entryExists = 0;
289
                $keepEntry = 1;
290
                if (exists $store->{type})
291
                {
292
                    $entryExists = 1;
293
                    if ($store->{type} ne $entry->{type})
294
                    {
295
                        $store->{bad} = 1;
296
                        $store->{badType} = 1;
297
                    }
298
                }
299
                else
300
                {
301
                    $store->{type} = $entry->{type};
302
                }
303
 
304
                #   directory - no processing required
305
                if ($entry->{type} eq 'dir')
306
                {
307
                    $keepEntry = 0 if $entryExists;
308
                    next;
309
                }
310
 
311
                #   link - no processing reqiuired
312
                if ($entry->{type} eq 'link')
313
                {
314
                    $keepEntry = 0 if $entryExists;
315
                    next;
316
                }
317
 
318
                #   file - ensure there is no clash
319
                if ($entry->{type} eq 'file')
320
                {
321
                    if (exists $store->{md5sum})
322
                    {
323
                        $store->{bad} = 1 unless ($store->{md5sum} eq $entry->{md5sum});
324
                    }
325
                    else
326
                    {
327
                        $store->{md5sum} = $entry->{md5sum};
328
                    }
329
                next;
330
                }
331
                #   Unknown - just a warning for now
332
                Warning( "Unknown type: " . $entry->{type} , "    Path: ". $entry->{fullname} );
333
            }
334
            continue
335
            {
336
                #
337
                #   This block is always executed
338
                #   It is used to maintain the entry and the rewrite the XML file list
339
                #   Do not include the build.files.xxx.xml
340
                #       They are about to be deleted
341
                #       Not detailed in the non-tar package merge process
342
                #
343
                if ($keepEntry)
344
                {
345
                    unless ($entry->{fullname} =~ m~^built\.files\..*\.xml$~ )
346
                    {
347
                        if ($entryExists)
348
                        {
349
                            delete $entry->{md5sum};
350
                            delete $entry->{size};
351
                            $entry->{type} = 'merge';
352
                        }
353
                        push @newXml, $entry;
354
                    }
355
                }
356
            }
357
        }
358
    }
359
    #DebugDumpData("newXml",\@newXml);
360
 
361
    #
362
    #   Cleanout the non-bad entries
363
    #   Report on merge errors
364
    #
365
    my $headerReported;
366
    foreach my $entry (keys %fileData)
367
    {
368
        #
369
        #   Some entries are allowed to differ
370
        #       descpkg
371
        #       version_*.h 
372
        #           files as these are generated and may contain different dates and line endings
373
        #
374
        if ($entry eq 'descpkg')
375
        {
376
            delete $fileData{$entry};
377
            next;
378
        }
379
 
380
        if ($entry =~ m~/version[^/]*\.h$~)
381
        {
382
            Verbose("Ignore merge error on: $entry");
383
            delete $fileData{$entry};
384
            next;
385
        }
386
 
387
        #
388
        #   Delete entry if its not marked as bad
389
        unless (exists $fileData{$entry}{bad} )
390
        {
391
            delete $fileData{$entry};
392
            next;
393
        }
394
 
395
        unless ($headerReported)
396
        {
397
            $headerReported = 1;
398
            reportMergeError('Package Merge Error. File provided by different builds are not identical');
399
            reportMergeError('This prevents the build from being reproducible.');
400
        }
401
 
402
        if ($fileData{$entry}{badType})
403
        {
404
            #
405
            #   Have a TYPE merge error
406
            #       Detail what has happened
407
            #       Generate pretty output showning on which machines that are command.
408
            #
409
            my %typeList;
410
            foreach my $e ( @{$fileData{$entry}{hosts}} ) {
411
                UniquePush (\@{$typeList{$e->{type}}}, $e->{host});
412
            }
413
 
414
            reportMergeError('Entry Path: ' . $entry);
415
            foreach my $e ( @{$fileData{$entry}{hosts}} )
416
            {
417
                my $hostList;
418
                my @sameHosts = @{$typeList{$e->{type}}};
419
                ArrayDelete (\@sameHosts, $e->{host});
420
                if (@sameHosts) {
421
                    $hostList = ' Same as: ' . join(', ', @sameHosts);
422
                } else {
423
                    $hostList = ' Unique to: '. $e->{host};
424
                }
425
 
426
                reportMergeError('    Provided by: ' . sprintf('%-*s',$maxHostNameLength,$e->{host}) . ' Type: ' . sprintf('%-*s',$maxTypeLength,$e->{type}) . $hostList );
427
            }
428
 
429
        }
430
        else
431
        {
432
            #
433
            #   Have a FILE merge error
434
            #       Detail what has happened
435
            #       Generate pretty output showning on which machines that are common.
436
            #
437
            my %md5List;
438
            foreach my $e ( @{$fileData{$entry}{hosts}} ) {
439
                UniquePush (\@{$md5List{$e->{md5sum}}}, $e->{host});
440
            }
441
 
442
            reportMergeError('File Name: ' . $entry);
443
            foreach my $e ( @{$fileData{$entry}{hosts}} )
444
            {
445
                my $hostList;
446
                my @sameHosts = @{$md5List{$e->{md5sum}}};
447
                ArrayDelete (\@sameHosts, $e->{host});
448
                if (@sameHosts) {
449
                    $hostList = ' Same as: ' . join(', ', @sameHosts);
450
                } else {
451
                    $hostList = ' Unique to: '. $e->{host};
452
                }
453
 
454
                reportMergeError('    Provided by: ' . sprintf('%-*s',$maxHostNameLength,$e->{host}) . $hostList );
455
            }
456
        }
457
    }
458
    ErrorDoExit();
459
 
460
    #
461
    #   Calculate target package location
462
    #   
463
    Verbose("Package Target: $pkgTargetDir");
464
    RmDirTree($pkgTargetDir) if $opt_preDelete;
465
    Error ("Target package directory exists") if -d $pkgTargetDir;
466
    mkpath ($pkgTargetDir);
467
    Error ("Package target not created: $!", $pkgTargetDir) unless -d $pkgTargetDir;
468
    $deleteTargetDir = 1;
469
 
470
    #
471
    #   Extract the archive contents and merge them into one directory
472
    #       If there are overlaps - don't replace them
473
    #
474
    foreach my $srcfile ( keys %pkgData )
475
    {
476
        Message ("Extracting all files from " . StripDir($srcfile));
477
        my $rv = System ('tar', '-xzmf', $srcfile, IsVerbose(1) ? '-v' : undef, '-C', $pkgTargetDir );
478
        Error("Tar extraction error: $srcfile") if ($rv);
479
    }
480
 
481
    #
482
    #   Replace the built.files.xxx.xml files that came with each package fragment
483
    #   with a new one caclulated as we merged the fragemnts. The new one will not
484
    #   have duplicate files - they will be merked as merged.
485
    #   
486
    #   Delete existing built.files.xxx.xml
487
    #   Write out file meta data for the assembled package
488
    #
489
    foreach my $item (glob(catdir($pkgTargetDir, 'built.files.*.xml')))
490
    {
491
        Verbose("Delete metadata file: $item");
492
        unlink $item;
493
    }
494
 
495
    Message("Write new archive metadata");
496
    writeFileInfo(catfile($pkgTargetDir, 'built.files.packageAssembly.xml'),\@newXml);
497
 
498
    #
499
    #   Fix file permissions
500
    #   We know we are running under unix so we will use a unix command
501
    #
502
    Message('Setting file permissions');
503
    System('chmod', '-R', 'a+rx', $pkgTargetDir);
504
 
505
    #
506
    #   Fix descpkg file
507
    #   Original create_dpkg uses the CopyDescpkg function. This is a bit wonky
508
    #   All it appears to do is:
509
    #       Force build machine name
510
    #       Force user name
511
    #       Force build time into the descpkg file
512
    #  If a package was built on multiple machines then the build machine names were lost
513
    #  
514
    #   This implementation
515
    #       Use the descpkg file in the first package fragment
516
    #       There is enough other information in the build system to track where the package
517
    #       was built. This was not available when CopyDescpkg was implemented
518
 
519
 
520
    #
521
    #   All Done
522
    #       Flag  - don't cleanup generated dierctory
523
    #       
524
    Information("Package Target: $pkgTargetDir");
525
    $deleteTargetDir = 0;
526
    exit 0;
527
 
528
#-------------------------------------------------------------------------------
5568 dpurdie 529
# Function        : DeletePackageVersion 
530
#
531
# Description     : Delete the named package version from the package archive
532
#                   Used by the 'buildtool' to clean up failed or test builds
533
#
534
# Inputs          : 
535
#
536
# Returns         : Does not return. Must exit the utility 
537
#
538
sub DeletePackageVersion
539
{
540
    #
541
    #   Information for the user
542
    #
543
    Information ("---------------------------------------------------------------");
544
    Information ("Dpkg fragment assembly tool");
545
    Information ("Version: $VERSION");
546
    Information ("");
547
    Information ("Information:");
548
    Information ("Repository    = [$GBE_DPKG]");
549
    Information ("Target dir    = [$pkgTargetDir]");
550
    Information ("DPKG_NAME     = [$opt_pname]");
551
    Information ("DPKG_VERSION  = [$opt_pversion]");
552
    Information ("GBE_ABT       = [$GBE_ABT]");
553
    Information ("");
554
    Information ("Mode          - DeleteVersion");
555
    Information ("Package       - " . (-d $pkgTargetDir ? "Exists" : "Does Not exist"));
556
    Information ("---------------------------------------------------------------");
557
 
558
    Verbose("Package Target: $pkgTargetDir");
559
 
560
    if (-d $pkgTargetDir)
561
    {
562
        if (RmDirTree($pkgTargetDir))
563
        {
564
            Error ("Package-Version not deleted");
565
        }
566
    }
567
 
568
    exit 0;
569
}
570
 
571
 
572
#-------------------------------------------------------------------------------
5527 dpurdie 573
# Function        : END 
574
#
575
# Description     : Cleanup process 
576
#
577
# Inputs          : 
578
#
579
# Returns         : 
580
#
581
END
582
{
583
    #
584
    #   Save the programs exit code
585
    #   This END block may use the 'system' call and this will clobber the value in $?
586
    #   which is the systems exit code
5568 dpurdie 587
    #   
588
    #   Limit exist codes to 16 bits
5527 dpurdie 589
    #
5568 dpurdie 590
    Message("Cleanup processing($?)");
591
    local $?;
5527 dpurdie 592
 
593
    #
594
    #   Delete input package fragments
595
    #   These will be deleted on error as well as on good exits
596
    #   Reason: This tool is used by the build system
597
    #           If a build fails it will be tried again
598
    #           
599
    unless ($opt_keepFragments)
600
    {
601
        Message ("Delete package fragments");
602
        foreach my $fragment ( @packageFragments)
603
        {
604
            Verbose ("Delete fragment: " . $fragment);
605
            RmDirTree ($fragment) && Warning("$fragment not deleted");
606
        }
607
    }
608
    else
609
    {
610
        Message ("Keeping package fragments");
611
    }
612
 
613
    #
614
    #   Delete everything in the temp directory
615
    #   It was a directory created by this instance for the use of this instance
616
    #
617
    if ($tmpDirInfo)
618
    {
619
        chdir($startDir);
620
        RmDirTree($workDir);
621
        if (-d $workDir)
622
        {
623
            Warning("TMPDIR still exists: $workDir");
624
        }
625
    } 
626
    elsif ($workDir)
627
    {
628
        Message ("Retaining workdir: $workDir");
629
    }
630
 
631
    #
632
    #   Delete the package target dir
633
    #   We must have created it - as we error if it exists.
634
    #   
635
    #   Remove the packageName and packageVersion directories fi possible
636
    #   
637
    if ($deleteTargetDir)
638
    {
639
        Message("Remove partially created package");
640
        RmDirTree($pkgTargetDir);
641
 
642
        my $pkgDir = StripFileExt($pkgTargetDir);
643
        rmdir($pkgDir) && Message("Remove package dir: $pkgDir");
644
    }
645
 
5568 dpurdie 646
    # Note: $? has been localised and should not be reflected back to the user
647
    Message("End Cleanup processing($?)");
5527 dpurdie 648
}
649
 
650
#-------------------------------------------------------------------------------
651
# Function        : writeFileInfo 
652
#
653
# Description     : Write out an XML file that contains this processes
654
#                   contribution to the output package 
655
#
656
# Inputs          : $targetFile             - File to write XML into
657
#                   $fileList               - Ref to an array of file data 
658
#
659
# Returns         : 
660
#
661
sub writeFileInfo
662
{
663
    my ($targetFile, $fileList) = @_;
664
 
665
    my $data;
666
    $data->{file} = $fileList;
667
 
668
    #
669
    #   Write out sections of XML
670
    #       Want control over the output order
671
    #       Use lots of attributes and only elements for arrays
672
    #       Save as one attribute per line - for readability
673
    #
674
    my $xs = XML::Simple->new( NoAttr =>0, AttrIndent => 1 );
675
 
676
    open (my $XML, '>', $targetFile) || Error ("Cannot create output file: $targetFile", $!);
677
    $xs->XMLout($data, 
678
                'RootName' => 'files', 
679
                'XMLDecl'  => '<?xml version="1.0" encoding="UTF-8"?>',
680
                'OutputFile' => $XML);
681
    close $XML;
682
 
683
}
684
 
685
 
686
#-------------------------------------------------------------------------------
687
# Function        : reportMergeError 
688
#
689
# Description     : Report an error or a warning
690
#
691
# Inputs          : All arguments passed to ReportError or Warning
692
#
693
# Returns         : Nothing 
694
#
695
sub reportMergeError
696
{
697
    $opt_MergeErrors ? Warning(@_) : ReportError(@_);
698
}
699
 
700
#-------------------------------------------------------------------------------
701
#   Documentation
702
#
703
 
704
=pod
705
 
706
=for htmltoc    SYSUTIL::
707
 
708
=head1 NAME
709
 
710
assemble_dpkg - Assemble a dpkg_archive entry from a set of tar files
711
 
712
=head1 SYNOPSIS
713
 
714
 jats assemble_dpkg [options]
715
 
716
 Options:
717
    -help              - Brief help message
718
    -help -help        - Detailed help message
719
    -man               - Full documentation
720
    -verbose           - Display additional progress messages
721
    -pname=name        - Ensure package is named correctly
722
    -pversion=version  - Ensure package version is correct
723
    -srcdir=path       - Location of the package fragments
5568 dpurdie 724
    -DeleteVersion     - Alternate Mode. Delete package-version
5527 dpurdie 725
 
726
  Debug and Testing:
727
    -[no]mergeErrors   - Allow merge errors
728
    -[no]preDelete     - Predelete generated package
729
    -[no]keepFragments - Delete input package fragments
730
    -[no]testArchive   - Perform operations within a test archive
731
    -output=path       - Base of test package archive
732
 
733
=head1 OPTIONS
734
 
735
=over 8
736
 
737
=item B<-help>
738
 
739
Print a brief help message and exits.
740
 
741
=item B<-help -help>
742
 
743
Print a detailed help message with an explanation for each option.
744
 
745
=item B<-man>
746
 
747
Prints the manual page and exits.
748
 
749
=item B<-srcdir=path>
750
 
751
This option specifies the path of the packages fragments. The fragments will be
752
located using the package name and package version.
753
 
754
=item B<-pname=name>
755
 
756
The name of the target package
757
 
758
=item B<-pversion=version>
759
 
760
The version of the target package.
761
 
5568 dpurdie 762
=item B<-DeleteVersion>
763
 
764
This option invokes an alternate mode of operation. In this mode the specified package version
765
will be deleted from the package archive.
766
 
767
This mode is used by the 'buildtool' while cleaning up failed builds.
768
 
769
Is is not an error for the named package versio to not exist.
770
 
5527 dpurdie 771
=item B<-[no]mergeErrors>
772
 
773
This option allows the merging process to continue if merge errors are located.
774
The default is -noMergeErrors
775
 
776
This option is intended for testing use only.
777
 
778
=item B<-[no]preDelete>
779
 
780
This option will delete the target package instance before the package is assembled.
781
The default is -noPreDelete
782
 
783
This option is intended for testing use only.
784
 
785
=item B<-[no]keepFragments>
786
 
787
This option will prevents the package fragments from being deleted.
788
The default is to -noKeepFragments - the source apckage fragmenst will be deleted.
789
 
790
This option is intended for testing use only.
791
 
792
=item B<-[no]testArchive>
793
 
794
If this option is enabled then the assembly operation is performed within a test area within
795
the currently configured dpkg_archive. The test area is a subdirectory 
796
called C<.dpkg_archive/test_dpkg>
797
 
798
This option is intended for testing use only.
799
 
800
=item B<-output=path>
801
 
802
This option allows the user to specify to root of a test package archive.
803
The dafualt is to use the value provided by GBE_DPKG - the main package archive.
804
 
805
This option is intended for testing use only.
806
 
807
=back
808
 
809
=head1 DESCRIPTION
810
 
811
This utility program is used by the build system to assemble (merge) build artifacts from several
812
build machines into one package.
813
 
814
The build artifacts have been delivered to the package store as a collection
815
of zipped tar files (.tar.gz). There will be one tar file from each machine in the build set.
816
 
817
The process has been designed to overcome several problems:
818
 
819
=over 4
820
 
821
=item Speed
822
 
823
If some of the build machines are not co-located with the master package server, then 
824
the process of transferring a package with a large number of files can be very slow.
825
 
826
ie: > 1 second per file to transfer a file from AWS(Sydney) to PCC(Perth). 
827
If a package has several thousand files then this can take an hour.
828
 
829
If the packaged files are compressed into a single file, then the file creation overhead is eliminated.
830
 
831
=item Atomic File Creation
832
 
833
For package fragments to be transferred from multiple machines without error some form of 
834
multi-machine mutex is required. This has not been successfully implemented - after many attempts.
835
 
836
If the merge operation is done by the package server, then there is no need for a mutex.
837
 
838
=back
839
 
840
The process of transferring tarballs and then merging then in one location solves these two problems.
841
 
842
The reconstruction process is performed by a daemon on the package archive server to address the following issues:
843
 
844
=over 4
845
 
846
=item * Windows handling of symlinks
847
 
848
Symbolic links will be handled correctly on the package server as the file system is native.
849
 
850
=item * Network Speed
851
 
852
By running the merge on the package server the contents of the package are not dragged to and 
853
from the build server. If the build server is not co-located with the package archive then there
854
will be a major speed penalty.
855
 
856
=back
857
 
858
The basic process performed by this utility is:
859
 
860
=over 4
861
 
862
=item * 
863
 
864
Locate all parts of the package. There should be one from each build machine that is a part 
865
of the build set, unless the build was generic. For each package fragment:
866
 
867
=over 4
868
 
869
=item * 
870
 
871
Extract a 'built.files.<machname>' file - the file must exist.
872
 
873
=item *
874
 
875
Read all 'built.files.<machname>' files and in the process determine if there are any conflicts.
876
A conflict is deemed to exist if the files have different MD5 digests. This allows the same file
877
to be provided by different builds - as long as the content is the same. Line endings are handled
878
in a machine independent manner. 
879
 
880
=item *
881
 
882
Detect dead symbolic links.
883
 
884
=back
885
 
886
=item *
887
 
888
If there are no file conflicts or other detected errors, then all parts of the package will be 
889
extracted into a single directory.
890
 
891
=item *
892
 
893
File permisions will be adjusted. All directories will be made world readable and all files will be made world executable.
894
 
895
=back
896
 
897
=cut
898