Subversion Repositories DevTools

Rev

Rev 7299 | Details | Compare with Previous | Last modification | View Log | RSS feed

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