Subversion Repositories DevTools

Rev

Rev 5568 | Rev 5582 | 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
587
    #
5568 dpurdie 588
    Message("Cleanup processing($?)");
589
    local $?;
5527 dpurdie 590
 
591
    #
592
    #   Delete input package fragments
593
    #   These will be deleted on error as well as on good exits
594
    #   Reason: This tool is used by the build system
595
    #           If a build fails it will be tried again
596
    #           
597
    unless ($opt_keepFragments)
598
    {
599
        Message ("Delete package fragments");
600
        foreach my $fragment ( @packageFragments)
601
        {
602
            Verbose ("Delete fragment: " . $fragment);
603
            RmDirTree ($fragment) && Warning("$fragment not deleted");
604
        }
605
    }
606
    else
607
    {
608
        Message ("Keeping package fragments");
609
    }
610
 
611
    #
612
    #   Delete everything in the temp directory
613
    #   It was a directory created by this instance for the use of this instance
614
    #
615
    if ($tmpDirInfo)
616
    {
617
        chdir($startDir);
618
        RmDirTree($workDir);
619
        if (-d $workDir)
620
        {
621
            Warning("TMPDIR still exists: $workDir");
622
        }
623
    } 
624
    elsif ($workDir)
625
    {
626
        Message ("Retaining workdir: $workDir");
627
    }
628
 
629
    #
630
    #   Delete the package target dir
631
    #   We must have created it - as we error if it exists.
632
    #   
633
    #   Remove the packageName and packageVersion directories fi possible
634
    #   
635
    if ($deleteTargetDir)
636
    {
637
        Message("Remove partially created package");
638
        RmDirTree($pkgTargetDir);
639
 
640
        my $pkgDir = StripFileExt($pkgTargetDir);
641
        rmdir($pkgDir) && Message("Remove package dir: $pkgDir");
642
    }
643
 
5568 dpurdie 644
    # Note: $? has been localised and should not be reflected back to the user
645
    Message("End Cleanup processing($?)");
5527 dpurdie 646
}
647
 
648
#-------------------------------------------------------------------------------
649
# Function        : writeFileInfo 
650
#
651
# Description     : Write out an XML file that contains this processes
652
#                   contribution to the output package 
653
#
654
# Inputs          : $targetFile             - File to write XML into
655
#                   $fileList               - Ref to an array of file data 
656
#
657
# Returns         : 
658
#
659
sub writeFileInfo
660
{
661
    my ($targetFile, $fileList) = @_;
662
 
663
    my $data;
664
    $data->{file} = $fileList;
665
 
666
    #
667
    #   Write out sections of XML
668
    #       Want control over the output order
669
    #       Use lots of attributes and only elements for arrays
670
    #       Save as one attribute per line - for readability
671
    #
672
    my $xs = XML::Simple->new( NoAttr =>0, AttrIndent => 1 );
673
 
674
    open (my $XML, '>', $targetFile) || Error ("Cannot create output file: $targetFile", $!);
675
    $xs->XMLout($data, 
676
                'RootName' => 'files', 
677
                'XMLDecl'  => '<?xml version="1.0" encoding="UTF-8"?>',
678
                'OutputFile' => $XML);
679
    close $XML;
680
 
681
}
682
 
683
 
684
#-------------------------------------------------------------------------------
685
# Function        : reportMergeError 
686
#
687
# Description     : Report an error or a warning
688
#
689
# Inputs          : All arguments passed to ReportError or Warning
690
#
691
# Returns         : Nothing 
692
#
693
sub reportMergeError
694
{
695
    $opt_MergeErrors ? Warning(@_) : ReportError(@_);
696
}
697
 
698
#-------------------------------------------------------------------------------
699
#   Documentation
700
#
701
 
702
=pod
703
 
704
=for htmltoc    SYSUTIL::
705
 
706
=head1 NAME
707
 
708
assemble_dpkg - Assemble a dpkg_archive entry from a set of tar files
709
 
710
=head1 SYNOPSIS
711
 
712
 jats assemble_dpkg [options]
713
 
714
 Options:
715
    -help              - Brief help message
716
    -help -help        - Detailed help message
717
    -man               - Full documentation
718
    -verbose           - Display additional progress messages
719
    -pname=name        - Ensure package is named correctly
720
    -pversion=version  - Ensure package version is correct
721
    -srcdir=path       - Location of the package fragments
5568 dpurdie 722
    -DeleteVersion     - Alternate Mode. Delete package-version
5527 dpurdie 723
 
724
  Debug and Testing:
725
    -[no]mergeErrors   - Allow merge errors
726
    -[no]preDelete     - Predelete generated package
727
    -[no]keepFragments - Delete input package fragments
728
    -[no]testArchive   - Perform operations within a test archive
729
    -output=path       - Base of test package archive
730
 
731
=head1 OPTIONS
732
 
733
=over 8
734
 
735
=item B<-help>
736
 
737
Print a brief help message and exits.
738
 
739
=item B<-help -help>
740
 
741
Print a detailed help message with an explanation for each option.
742
 
743
=item B<-man>
744
 
745
Prints the manual page and exits.
746
 
747
=item B<-srcdir=path>
748
 
749
This option specifies the path of the packages fragments. The fragments will be
750
located using the package name and package version.
751
 
752
=item B<-pname=name>
753
 
754
The name of the target package
755
 
756
=item B<-pversion=version>
757
 
758
The version of the target package.
759
 
5568 dpurdie 760
=item B<-DeleteVersion>
761
 
762
This option invokes an alternate mode of operation. In this mode the specified package version
763
will be deleted from the package archive.
764
 
765
This mode is used by the 'buildtool' while cleaning up failed builds.
766
 
767
Is is not an error for the named package versio to not exist.
768
 
5527 dpurdie 769
=item B<-[no]mergeErrors>
770
 
771
This option allows the merging process to continue if merge errors are located.
772
The default is -noMergeErrors
773
 
774
This option is intended for testing use only.
775
 
776
=item B<-[no]preDelete>
777
 
778
This option will delete the target package instance before the package is assembled.
779
The default is -noPreDelete
780
 
781
This option is intended for testing use only.
782
 
783
=item B<-[no]keepFragments>
784
 
785
This option will prevents the package fragments from being deleted.
786
The default is to -noKeepFragments - the source apckage fragmenst will be deleted.
787
 
788
This option is intended for testing use only.
789
 
790
=item B<-[no]testArchive>
791
 
792
If this option is enabled then the assembly operation is performed within a test area within
793
the currently configured dpkg_archive. The test area is a subdirectory 
794
called C<.dpkg_archive/test_dpkg>
795
 
796
This option is intended for testing use only.
797
 
798
=item B<-output=path>
799
 
800
This option allows the user to specify to root of a test package archive.
801
The dafualt is to use the value provided by GBE_DPKG - the main package archive.
802
 
803
This option is intended for testing use only.
804
 
805
=back
806
 
807
=head1 DESCRIPTION
808
 
809
This utility program is used by the build system to assemble (merge) build artifacts from several
810
build machines into one package.
811
 
812
The build artifacts have been delivered to the package store as a collection
813
of zipped tar files (.tar.gz). There will be one tar file from each machine in the build set.
814
 
815
The process has been designed to overcome several problems:
816
 
817
=over 4
818
 
819
=item Speed
820
 
821
If some of the build machines are not co-located with the master package server, then 
822
the process of transferring a package with a large number of files can be very slow.
823
 
824
ie: > 1 second per file to transfer a file from AWS(Sydney) to PCC(Perth). 
825
If a package has several thousand files then this can take an hour.
826
 
827
If the packaged files are compressed into a single file, then the file creation overhead is eliminated.
828
 
829
=item Atomic File Creation
830
 
831
For package fragments to be transferred from multiple machines without error some form of 
832
multi-machine mutex is required. This has not been successfully implemented - after many attempts.
833
 
834
If the merge operation is done by the package server, then there is no need for a mutex.
835
 
836
=back
837
 
838
The process of transferring tarballs and then merging then in one location solves these two problems.
839
 
840
The reconstruction process is performed by a daemon on the package archive server to address the following issues:
841
 
842
=over 4
843
 
844
=item * Windows handling of symlinks
845
 
846
Symbolic links will be handled correctly on the package server as the file system is native.
847
 
848
=item * Network Speed
849
 
850
By running the merge on the package server the contents of the package are not dragged to and 
851
from the build server. If the build server is not co-located with the package archive then there
852
will be a major speed penalty.
853
 
854
=back
855
 
856
The basic process performed by this utility is:
857
 
858
=over 4
859
 
860
=item * 
861
 
862
Locate all parts of the package. There should be one from each build machine that is a part 
863
of the build set, unless the build was generic. For each package fragment:
864
 
865
=over 4
866
 
867
=item * 
868
 
869
Extract a 'built.files.<machname>' file - the file must exist.
870
 
871
=item *
872
 
873
Read all 'built.files.<machname>' files and in the process determine if there are any conflicts.
874
A conflict is deemed to exist if the files have different MD5 digests. This allows the same file
875
to be provided by different builds - as long as the content is the same. Line endings are handled
876
in a machine independent manner. 
877
 
878
=item *
879
 
880
Detect dead symbolic links.
881
 
882
=back
883
 
884
=item *
885
 
886
If there are no file conflicts or other detected errors, then all parts of the package will be 
887
extracted into a single directory.
888
 
889
=item *
890
 
891
File permisions will be adjusted. All directories will be made world readable and all files will be made world executable.
892
 
893
=back
894
 
895
=cut
896