Subversion Repositories DevTools

Rev

Rev 5578 | Rev 5726 | 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, 
5582 dpurdie 243
                            '-C', $basename,
244
                            '--no-anchored', 
245
                            '--wildcards', 'built.files.*.xml' );
5527 dpurdie 246
        Error("Tar extraction error: $srcfile") if ($rv);
247
    }
248
 
249
    #
250
    #   Read in the XML from each of the files
251
    #   Process the XML
252
    #       Detect merge clashes
253
    #       Create new XML - assuming the extraction will NOT overwrite existing files
254
    #
255
    my %fileData;
256
    my @newXml;
257
    foreach my $srcfile ( keys %pkgData )
258
    {
259
        my @extracted = glob(catfile($pkgData{$srcfile}{basename}, 'built.files.*.xml'));
5582 dpurdie 260
        Error("built.files.*.xml not found in root of extracted package") unless @extracted;
261
        Warning("Multiple built.files.*.xml files", @extracted) if (scalar @extracted > 1);
5527 dpurdie 262
        foreach my $srcfile ( @extracted)
263
        {
5582 dpurdie 264
            Verbose3("Parse XML in: $srcfile");
5527 dpurdie 265
            my $ref = XML::Simple::XMLin($srcfile, ForceArray => 1, KeyAttr => []);
266
            #DebugDumpData("REF - $srcfile, " .ref($ref), $ref);
267
 
268
            my $entryExists;
269
            my $keepEntry;
270
            foreach my $entry (@{$ref->{file}})
271
            {
272
                #
273
                #   Calculate some common data items
274
                #       Calc max host name length for pretty printing
275
                my $hostnameLen = length ($entry->{host} || '');
276
                $maxHostNameLength = $hostnameLen if ($hostnameLen > $maxHostNameLength);
277
 
278
                my $typeLen = length ($entry->{type} || '');
279
                $maxTypeLength = $typeLen if ($typeLen > $maxTypeLength);
280
 
281
                my $hostEntry = {host => $entry->{host}, md5sum => $entry->{md5sum}, type => $entry->{type}};
282
                push @{$fileData{$entry->{fullname}}{hosts}}, $hostEntry;
283
                my $store = $fileData{$entry->{fullname}};
284
 
285
                #
286
                #   Determine if we have seen this file before
287
                #   If so then we need to:
288
                #       Perform a merge clash
289
                #       Ensure that its of the same type
290
                #       Mark the new XML as 'merge'
291
                #
292
                $entryExists = 0;
293
                $keepEntry = 1;
294
                if (exists $store->{type})
295
                {
296
                    $entryExists = 1;
297
                    if ($store->{type} ne $entry->{type})
298
                    {
299
                        $store->{bad} = 1;
300
                        $store->{badType} = 1;
301
                    }
302
                }
303
                else
304
                {
305
                    $store->{type} = $entry->{type};
306
                }
307
 
308
                #   directory - no processing required
309
                if ($entry->{type} eq 'dir')
310
                {
311
                    $keepEntry = 0 if $entryExists;
312
                    next;
313
                }
314
 
315
                #   link - no processing reqiuired
316
                if ($entry->{type} eq 'link')
317
                {
318
                    $keepEntry = 0 if $entryExists;
319
                    next;
320
                }
321
 
322
                #   file - ensure there is no clash
323
                if ($entry->{type} eq 'file')
324
                {
325
                    if (exists $store->{md5sum})
326
                    {
327
                        $store->{bad} = 1 unless ($store->{md5sum} eq $entry->{md5sum});
328
                    }
329
                    else
330
                    {
331
                        $store->{md5sum} = $entry->{md5sum};
332
                    }
333
                next;
334
                }
335
                #   Unknown - just a warning for now
336
                Warning( "Unknown type: " . $entry->{type} , "    Path: ". $entry->{fullname} );
337
            }
338
            continue
339
            {
340
                #
341
                #   This block is always executed
342
                #   It is used to maintain the entry and the rewrite the XML file list
343
                #   Do not include the build.files.xxx.xml
344
                #       They are about to be deleted
345
                #       Not detailed in the non-tar package merge process
346
                #
347
                if ($keepEntry)
348
                {
349
                    unless ($entry->{fullname} =~ m~^built\.files\..*\.xml$~ )
350
                    {
351
                        if ($entryExists)
352
                        {
353
                            delete $entry->{md5sum};
354
                            delete $entry->{size};
355
                            $entry->{type} = 'merge';
356
                        }
357
                        push @newXml, $entry;
358
                    }
359
                }
360
            }
361
        }
362
    }
363
    #DebugDumpData("newXml",\@newXml);
364
 
365
    #
366
    #   Cleanout the non-bad entries
367
    #   Report on merge errors
368
    #
369
    my $headerReported;
370
    foreach my $entry (keys %fileData)
371
    {
372
        #
373
        #   Some entries are allowed to differ
374
        #       descpkg
375
        #       version_*.h 
376
        #           files as these are generated and may contain different dates and line endings
377
        #
378
        if ($entry eq 'descpkg')
379
        {
380
            delete $fileData{$entry};
381
            next;
382
        }
383
 
384
        if ($entry =~ m~/version[^/]*\.h$~)
385
        {
386
            Verbose("Ignore merge error on: $entry");
387
            delete $fileData{$entry};
388
            next;
389
        }
390
 
391
        #
392
        #   Delete entry if its not marked as bad
393
        unless (exists $fileData{$entry}{bad} )
394
        {
395
            delete $fileData{$entry};
396
            next;
397
        }
398
 
399
        unless ($headerReported)
400
        {
401
            $headerReported = 1;
402
            reportMergeError('Package Merge Error. File provided by different builds are not identical');
403
            reportMergeError('This prevents the build from being reproducible.');
404
        }
405
 
406
        if ($fileData{$entry}{badType})
407
        {
408
            #
409
            #   Have a TYPE merge error
410
            #       Detail what has happened
411
            #       Generate pretty output showning on which machines that are command.
412
            #
413
            my %typeList;
414
            foreach my $e ( @{$fileData{$entry}{hosts}} ) {
415
                UniquePush (\@{$typeList{$e->{type}}}, $e->{host});
416
            }
417
 
418
            reportMergeError('Entry Path: ' . $entry);
419
            foreach my $e ( @{$fileData{$entry}{hosts}} )
420
            {
421
                my $hostList;
422
                my @sameHosts = @{$typeList{$e->{type}}};
423
                ArrayDelete (\@sameHosts, $e->{host});
424
                if (@sameHosts) {
425
                    $hostList = ' Same as: ' . join(', ', @sameHosts);
426
                } else {
427
                    $hostList = ' Unique to: '. $e->{host};
428
                }
429
 
430
                reportMergeError('    Provided by: ' . sprintf('%-*s',$maxHostNameLength,$e->{host}) . ' Type: ' . sprintf('%-*s',$maxTypeLength,$e->{type}) . $hostList );
431
            }
432
 
433
        }
434
        else
435
        {
436
            #
437
            #   Have a FILE merge error
438
            #       Detail what has happened
439
            #       Generate pretty output showning on which machines that are common.
440
            #
441
            my %md5List;
442
            foreach my $e ( @{$fileData{$entry}{hosts}} ) {
443
                UniquePush (\@{$md5List{$e->{md5sum}}}, $e->{host});
444
            }
445
 
446
            reportMergeError('File Name: ' . $entry);
447
            foreach my $e ( @{$fileData{$entry}{hosts}} )
448
            {
449
                my $hostList;
450
                my @sameHosts = @{$md5List{$e->{md5sum}}};
451
                ArrayDelete (\@sameHosts, $e->{host});
452
                if (@sameHosts) {
453
                    $hostList = ' Same as: ' . join(', ', @sameHosts);
454
                } else {
455
                    $hostList = ' Unique to: '. $e->{host};
456
                }
457
 
458
                reportMergeError('    Provided by: ' . sprintf('%-*s',$maxHostNameLength,$e->{host}) . $hostList );
459
            }
460
        }
461
    }
462
    ErrorDoExit();
463
 
464
    #
465
    #   Calculate target package location
466
    #   
467
    Verbose("Package Target: $pkgTargetDir");
468
    RmDirTree($pkgTargetDir) if $opt_preDelete;
469
    Error ("Target package directory exists") if -d $pkgTargetDir;
470
    mkpath ($pkgTargetDir);
471
    Error ("Package target not created: $!", $pkgTargetDir) unless -d $pkgTargetDir;
472
    $deleteTargetDir = 1;
473
 
474
    #
475
    #   Extract the archive contents and merge them into one directory
476
    #       If there are overlaps - don't replace them
477
    #
478
    foreach my $srcfile ( keys %pkgData )
479
    {
480
        Message ("Extracting all files from " . StripDir($srcfile));
481
        my $rv = System ('tar', '-xzmf', $srcfile, IsVerbose(1) ? '-v' : undef, '-C', $pkgTargetDir );
482
        Error("Tar extraction error: $srcfile") if ($rv);
483
    }
484
 
485
    #
486
    #   Replace the built.files.xxx.xml files that came with each package fragment
487
    #   with a new one caclulated as we merged the fragemnts. The new one will not
488
    #   have duplicate files - they will be merked as merged.
489
    #   
490
    #   Delete existing built.files.xxx.xml
491
    #   Write out file meta data for the assembled package
492
    #
493
    foreach my $item (glob(catdir($pkgTargetDir, 'built.files.*.xml')))
494
    {
495
        Verbose("Delete metadata file: $item");
496
        unlink $item;
497
    }
498
 
499
    Message("Write new archive metadata");
500
    writeFileInfo(catfile($pkgTargetDir, 'built.files.packageAssembly.xml'),\@newXml);
501
 
502
    #
503
    #   Fix file permissions
504
    #   We know we are running under unix so we will use a unix command
505
    #
506
    Message('Setting file permissions');
507
    System('chmod', '-R', 'a+rx', $pkgTargetDir);
508
 
509
    #
510
    #   Fix descpkg file
511
    #   Original create_dpkg uses the CopyDescpkg function. This is a bit wonky
512
    #   All it appears to do is:
513
    #       Force build machine name
514
    #       Force user name
515
    #       Force build time into the descpkg file
516
    #  If a package was built on multiple machines then the build machine names were lost
517
    #  
518
    #   This implementation
519
    #       Use the descpkg file in the first package fragment
520
    #       There is enough other information in the build system to track where the package
521
    #       was built. This was not available when CopyDescpkg was implemented
522
 
523
 
524
    #
525
    #   All Done
526
    #       Flag  - don't cleanup generated dierctory
527
    #       
528
    Information("Package Target: $pkgTargetDir");
529
    $deleteTargetDir = 0;
530
    exit 0;
531
 
532
#-------------------------------------------------------------------------------
5568 dpurdie 533
# Function        : DeletePackageVersion 
534
#
535
# Description     : Delete the named package version from the package archive
536
#                   Used by the 'buildtool' to clean up failed or test builds
537
#
538
# Inputs          : 
539
#
540
# Returns         : Does not return. Must exit the utility 
541
#
542
sub DeletePackageVersion
543
{
544
    #
545
    #   Information for the user
546
    #
547
    Information ("---------------------------------------------------------------");
548
    Information ("Dpkg fragment assembly tool");
549
    Information ("Version: $VERSION");
550
    Information ("");
551
    Information ("Information:");
552
    Information ("Repository    = [$GBE_DPKG]");
553
    Information ("Target dir    = [$pkgTargetDir]");
554
    Information ("DPKG_NAME     = [$opt_pname]");
555
    Information ("DPKG_VERSION  = [$opt_pversion]");
556
    Information ("GBE_ABT       = [$GBE_ABT]");
557
    Information ("");
558
    Information ("Mode          - DeleteVersion");
559
    Information ("Package       - " . (-d $pkgTargetDir ? "Exists" : "Does Not exist"));
560
    Information ("---------------------------------------------------------------");
561
 
562
    Verbose("Package Target: $pkgTargetDir");
563
 
564
    if (-d $pkgTargetDir)
565
    {
566
        if (RmDirTree($pkgTargetDir))
567
        {
568
            Error ("Package-Version not deleted");
569
        }
570
    }
571
 
572
    exit 0;
573
}
574
 
575
 
576
#-------------------------------------------------------------------------------
5527 dpurdie 577
# Function        : END 
578
#
579
# Description     : Cleanup process 
580
#
581
# Inputs          : 
582
#
583
# Returns         : 
584
#
585
END
586
{
587
    #
588
    #   Save the programs exit code
589
    #   This END block may use the 'system' call and this will clobber the value in $?
590
    #   which is the systems exit code
591
    #
5568 dpurdie 592
    Message("Cleanup processing($?)");
593
    local $?;
5527 dpurdie 594
 
595
    #
596
    #   Delete input package fragments
597
    #   These will be deleted on error as well as on good exits
598
    #   Reason: This tool is used by the build system
599
    #           If a build fails it will be tried again
600
    #           
601
    unless ($opt_keepFragments)
602
    {
603
        Message ("Delete package fragments");
604
        foreach my $fragment ( @packageFragments)
605
        {
606
            Verbose ("Delete fragment: " . $fragment);
607
            RmDirTree ($fragment) && Warning("$fragment not deleted");
608
        }
609
    }
610
    else
611
    {
612
        Message ("Keeping package fragments");
613
    }
614
 
615
    #
616
    #   Delete everything in the temp directory
617
    #   It was a directory created by this instance for the use of this instance
618
    #
619
    if ($tmpDirInfo)
620
    {
621
        chdir($startDir);
622
        RmDirTree($workDir);
623
        if (-d $workDir)
624
        {
625
            Warning("TMPDIR still exists: $workDir");
626
        }
627
    } 
628
    elsif ($workDir)
629
    {
630
        Message ("Retaining workdir: $workDir");
631
    }
632
 
633
    #
634
    #   Delete the package target dir
635
    #   We must have created it - as we error if it exists.
636
    #   
637
    #   Remove the packageName and packageVersion directories fi possible
638
    #   
639
    if ($deleteTargetDir)
640
    {
641
        Message("Remove partially created package");
642
        RmDirTree($pkgTargetDir);
643
 
644
        my $pkgDir = StripFileExt($pkgTargetDir);
645
        rmdir($pkgDir) && Message("Remove package dir: $pkgDir");
646
    }
647
 
5568 dpurdie 648
    # Note: $? has been localised and should not be reflected back to the user
649
    Message("End Cleanup processing($?)");
5527 dpurdie 650
}
651
 
652
#-------------------------------------------------------------------------------
653
# Function        : writeFileInfo 
654
#
655
# Description     : Write out an XML file that contains this processes
656
#                   contribution to the output package 
657
#
658
# Inputs          : $targetFile             - File to write XML into
659
#                   $fileList               - Ref to an array of file data 
660
#
661
# Returns         : 
662
#
663
sub writeFileInfo
664
{
665
    my ($targetFile, $fileList) = @_;
666
 
667
    my $data;
668
    $data->{file} = $fileList;
669
 
670
    #
671
    #   Write out sections of XML
672
    #       Want control over the output order
673
    #       Use lots of attributes and only elements for arrays
674
    #       Save as one attribute per line - for readability
675
    #
676
    my $xs = XML::Simple->new( NoAttr =>0, AttrIndent => 1 );
677
 
678
    open (my $XML, '>', $targetFile) || Error ("Cannot create output file: $targetFile", $!);
679
    $xs->XMLout($data, 
680
                'RootName' => 'files', 
681
                'XMLDecl'  => '<?xml version="1.0" encoding="UTF-8"?>',
682
                'OutputFile' => $XML);
683
    close $XML;
684
 
685
}
686
 
687
 
688
#-------------------------------------------------------------------------------
689
# Function        : reportMergeError 
690
#
691
# Description     : Report an error or a warning
692
#
693
# Inputs          : All arguments passed to ReportError or Warning
694
#
695
# Returns         : Nothing 
696
#
697
sub reportMergeError
698
{
699
    $opt_MergeErrors ? Warning(@_) : ReportError(@_);
700
}
701
 
702
#-------------------------------------------------------------------------------
703
#   Documentation
704
#
705
 
706
=pod
707
 
708
=for htmltoc    SYSUTIL::
709
 
710
=head1 NAME
711
 
712
assemble_dpkg - Assemble a dpkg_archive entry from a set of tar files
713
 
714
=head1 SYNOPSIS
715
 
716
 jats assemble_dpkg [options]
717
 
718
 Options:
719
    -help              - Brief help message
720
    -help -help        - Detailed help message
721
    -man               - Full documentation
722
    -verbose           - Display additional progress messages
723
    -pname=name        - Ensure package is named correctly
724
    -pversion=version  - Ensure package version is correct
725
    -srcdir=path       - Location of the package fragments
5568 dpurdie 726
    -DeleteVersion     - Alternate Mode. Delete package-version
5527 dpurdie 727
 
728
  Debug and Testing:
729
    -[no]mergeErrors   - Allow merge errors
730
    -[no]preDelete     - Predelete generated package
731
    -[no]keepFragments - Delete input package fragments
732
    -[no]testArchive   - Perform operations within a test archive
733
    -output=path       - Base of test package archive
5582 dpurdie 734
    -tmpdir=path       - Specified temp directory
5527 dpurdie 735
 
736
=head1 OPTIONS
737
 
738
=over 8
739
 
740
=item B<-help>
741
 
742
Print a brief help message and exits.
743
 
744
=item B<-help -help>
745
 
746
Print a detailed help message with an explanation for each option.
747
 
748
=item B<-man>
749
 
750
Prints the manual page and exits.
751
 
752
=item B<-srcdir=path>
753
 
754
This option specifies the path of the packages fragments. The fragments will be
755
located using the package name and package version.
756
 
757
=item B<-pname=name>
758
 
759
The name of the target package
760
 
761
=item B<-pversion=version>
762
 
763
The version of the target package.
764
 
5568 dpurdie 765
=item B<-DeleteVersion>
766
 
767
This option invokes an alternate mode of operation. In this mode the specified package version
768
will be deleted from the package archive.
769
 
770
This mode is used by the 'buildtool' while cleaning up failed builds.
771
 
772
Is is not an error for the named package versio to not exist.
773
 
5527 dpurdie 774
=item B<-[no]mergeErrors>
775
 
776
This option allows the merging process to continue if merge errors are located.
777
The default is -noMergeErrors
778
 
779
This option is intended for testing use only.
780
 
781
=item B<-[no]preDelete>
782
 
783
This option will delete the target package instance before the package is assembled.
784
The default is -noPreDelete
785
 
786
This option is intended for testing use only.
787
 
788
=item B<-[no]keepFragments>
789
 
790
This option will prevents the package fragments from being deleted.
791
The default is to -noKeepFragments - the source apckage fragmenst will be deleted.
792
 
793
This option is intended for testing use only.
794
 
795
=item B<-[no]testArchive>
796
 
797
If this option is enabled then the assembly operation is performed within a test area within
798
the currently configured dpkg_archive. The test area is a subdirectory 
799
called C<.dpkg_archive/test_dpkg>
800
 
801
This option is intended for testing use only.
802
 
803
=item B<-output=path>
804
 
805
This option allows the user to specify to root of a test package archive.
806
The dafualt is to use the value provided by GBE_DPKG - the main package archive.
807
 
808
This option is intended for testing use only.
809
 
5582 dpurdie 810
=item B<-tmpdir=path>
811
 
812
This option allow the user to specify a directory to be used to store temp files. 
813
It will not be deleted at the end of processing.
814
 
815
This option is intended for testing use only.
816
 
5527 dpurdie 817
=back
818
 
819
=head1 DESCRIPTION
820
 
821
This utility program is used by the build system to assemble (merge) build artifacts from several
822
build machines into one package.
823
 
824
The build artifacts have been delivered to the package store as a collection
825
of zipped tar files (.tar.gz). There will be one tar file from each machine in the build set.
826
 
827
The process has been designed to overcome several problems:
828
 
829
=over 4
830
 
831
=item Speed
832
 
833
If some of the build machines are not co-located with the master package server, then 
834
the process of transferring a package with a large number of files can be very slow.
835
 
836
ie: > 1 second per file to transfer a file from AWS(Sydney) to PCC(Perth). 
837
If a package has several thousand files then this can take an hour.
838
 
839
If the packaged files are compressed into a single file, then the file creation overhead is eliminated.
840
 
841
=item Atomic File Creation
842
 
843
For package fragments to be transferred from multiple machines without error some form of 
844
multi-machine mutex is required. This has not been successfully implemented - after many attempts.
845
 
846
If the merge operation is done by the package server, then there is no need for a mutex.
847
 
848
=back
849
 
850
The process of transferring tarballs and then merging then in one location solves these two problems.
851
 
852
The reconstruction process is performed by a daemon on the package archive server to address the following issues:
853
 
854
=over 4
855
 
856
=item * Windows handling of symlinks
857
 
858
Symbolic links will be handled correctly on the package server as the file system is native.
859
 
860
=item * Network Speed
861
 
862
By running the merge on the package server the contents of the package are not dragged to and 
863
from the build server. If the build server is not co-located with the package archive then there
864
will be a major speed penalty.
865
 
866
=back
867
 
868
The basic process performed by this utility is:
869
 
870
=over 4
871
 
872
=item * 
873
 
874
Locate all parts of the package. There should be one from each build machine that is a part 
875
of the build set, unless the build was generic. For each package fragment:
876
 
877
=over 4
878
 
879
=item * 
880
 
881
Extract a 'built.files.<machname>' file - the file must exist.
882
 
883
=item *
884
 
885
Read all 'built.files.<machname>' files and in the process determine if there are any conflicts.
886
A conflict is deemed to exist if the files have different MD5 digests. This allows the same file
887
to be provided by different builds - as long as the content is the same. Line endings are handled
888
in a machine independent manner. 
889
 
890
=item *
891
 
892
Detect dead symbolic links.
893
 
894
=back
895
 
896
=item *
897
 
898
If there are no file conflicts or other detected errors, then all parts of the package will be 
899
extracted into a single directory.
900
 
901
=item *
902
 
903
File permisions will be adjusted. All directories will be made world readable and all files will be made world executable.
904
 
905
=back
906
 
907
=cut
908