Subversion Repositories DevTools

Rev

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