Subversion Repositories DevTools

Rev

Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
6133 dpurdie 1
########################################################################
7300 dpurdie 2
# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.
6133 dpurdie 3
#
4
# Module name   : jats_generate_deployable.pl
5
# Module type   : Makefile system
6
# Compiler(s)   : Perl
7
# Environment(s): jats build system
8
#
9
# Description   : Extracts current package version list from release manager
10
#                 based on the 'IS_DEPOLYABLE' flag in a given Release
11
#                 and copies resultant packages to release specific
12
#                 directory.
13
#                 
14
#                 Based on jats_update_release.pl and jats_gen_bom.pl but it is 
15
#                 intended to be used by the PULSE digital distribution process
16
#......................................................................#
17
 
18
require 5.008_002;
19
use File::Basename;
20
use File::Copy;
21
use File::Path;
22
use strict;
23
use warnings;
24
use JatsEnv;
25
use JatsError;
26
use JatsRmApi;
27
use ArrayHashUtils;
28
use FileUtils;
29
use DBI;
30
use Getopt::Long;
31
use Pod::Usage;                             # required for help support
32
use JSON;
33
 
34
#
35
#   Config Options
36
#
37
my $VERSION = "1.0.0";                      # Update this
38
my $opt_help = 0;
39
my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose
40
my $opt_rtagid;
41
my $opt_rootdir = '.';
42
my $opt_test;
43
my $opt_showFilters;
44
my @opt_addFilters;
45
my @opt_delFilters;
46
my $opt_showFiles;
47
my @opt_addFiles;
48
my @opt_delFiles;
49
 
50
 
51
#
52
#   Constants
53
#
54
my $CONFFILE = '.bomGen';
7304 dpurdie 55
my $BOMFILE = '.bomCots';
6133 dpurdie 56
my $MANIFEST = 'MANIFEST.json';
57
my $TFVARS   = 'MANIFEST.tf';
58
 
59
#
60
#   Globals
61
#
62
my $DM_DB;              # Data Base Interface
63
my %bomList;            # All files in the BOM
64
my $bomInfo;            # Sbom meta data
7300 dpurdie 65
my %baseList;           # List of files in bin
6133 dpurdie 66
 
67
#
68
#   Configuration file vars
69
#
70
my @confFilters;
71
my @confFiles;
72
my %filtersUsed;
73
 
74
#-------------------------------------------------------------------------------
75
# Function        : Main
76
#
77
# Description     : Main entry point
78
#                   Parse user options
79
#
80
# Inputs          :
81
#
82
# Returns         :
83
#
84
 
85
my $result = GetOptions (
86
                "help:+"            => \$opt_help,              # flag, multiple use allowed
87
                "manual:3"          => \$opt_help,              # flag, multiple use allowed
88
                "verbose:+"         => \$opt_verbose,           # flag
89
                "rtagid|rtag_id=s"  => \$opt_rtagid,            # Number
90
                "rootdir=s"         => \$opt_rootdir,           # string
91
 
92
                "addfilter=s"       => \@opt_addFilters,        # multiple strings
93
                "delfilter=s"       => \@opt_delFilters,        # multiple strings
94
                "showfilters"       => \$opt_showFilters,       # flag
95
 
96
                "addfiles=s"       => \@opt_addFiles,           # multiple strings
97
                "delfiles=s"       => \@opt_delFiles,           # multiple strings
98
                "showfiles"        => \$opt_showFiles,          # flag
99
 
100
                "test"              => \$opt_test,              # flag
101
                );
102
 
103
#
104
#   Process help and manual options
105
#
106
pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result);
107
pod2usage(-verbose => 1)  if ($opt_help == 2 );
108
pod2usage(-verbose => 2)  if ($opt_help > 2);
109
 
110
ErrorConfig( 'name'    => 'GenDeploy',
111
             'verbose' => $opt_verbose );
112
 
113
#
114
#   Sanity tests
115
#
116
 
117
# Supplied rootdir must exists as a directory
118
Error("Root dir not specified") 
119
    unless defined $opt_rootdir;
120
Error("Root dir not a valid directory: ", $opt_rootdir )
121
    unless( -d $opt_rootdir );
122
 
123
    # Environment var GBE_DPKG must exists as a directory
124
Error("GBE_DPKG Environment var is not a directory")
125
    unless ( -d $ENV{GBE_DPKG} );
126
 
127
LoadFilterConfig();
128
ProcessFilterArgs();
129
 
130
#   Non Filter operations
131
#   Must supply an rtagid
132
Error("Need --rtagid", "Example: -rtagid=2362" )
133
    unless ($opt_rtagid);
134
 
7304 dpurdie 135
Error("No Filters defined.", "Add filters before creating BOM") 
136
    unless ( @confFilters );
137
 
6133 dpurdie 138
#
139
#   This command is destined to be used in a directory where group permissions
140
#   are important. Ensure that the user is not killing group access
141
#
142
umask 0002;
143
 
144
#
145
#   Body of the processing
146
#       Save generation time into the meta data
147
my $now = time;
148
$bomInfo->{version} = "2.0.0";
149
$bomInfo->{timestamp}{epoch} = $now;
150
$bomInfo->{timestamp}{utc} = gmtime($now);
151
 
152
Message("Copying packages from $ENV{GBE_DPKG} to $opt_rootdir");
153
 
154
#
155
#   Processing
156
#
157
connectRM(\$DM_DB);
158
GetReleaseInfo();               # Get Release Metadata
159
GetPackageData();               # Get RM Data
160
RemoveDuplicates();             # Need P or D, but not both
161
CopyInNew();                    # Copy new files
162
RemoveExcess();                 # Remove files no longer required
163
GenFileData();                  # Generate file metadata
164
WriteManifest();                # Save out meta data
165
exit 0;
166
 
167
#-------------------------------------------------------------------------------
168
# Function        : GenFileData 
169
#
170
# Description     : Generate meta data on each file
171
#                   Much of this is a guess.
172
#                   Assume files look like:
173
#                   
174
#                       VIXcryptoKeyManager-1.0.2061.cr-WIN32.exe
175
#                       erg-pkgmnt_1.0.3010.cr_UBUNTU16_P.deb
176
#                       erg-pkgmnt_1.0.3010.cr_RHEL7_P.rpm
177
#                       xxxxxx.sh - bit trickier
178
#
179
# Inputs          : None
180
#
181
# Returns         : Populates $bomInfo
182
#
183
sub GenFileData
184
{
185
    my @elist;
186
    my @edup;
187
    foreach my $file (sort keys %bomList)
188
    {
189
        my $data;
190
        my $alias;
191
 
192
        $bomList{$file}{version} =~ m~(.*)\.([a-z]+)$~;
193
        my $pvfull = $1;
194
        my $proj = $2;
195
        my $pv = $pvfull;
196
        $pv =~ s~\.\d+$~~;
197
 
198
        if ($file =~ m~^(.*)-(.*)\.(.*)-(WIN.*)\.(exe)$~i)
199
        {
200
            $data->{name} = $1;
201
            $data->{version} = $2;
202
            $data->{prj} = $3;
203
            $data->{arch} = $4;
204
            $data->{type} = $5;
205
        }
206
        elsif ( $file =~ m~^(.*)_(.*)\.([^_]+)_(.*)\.(deb|tgz|rpm)$~i)
207
        {
208
            $data->{name} = $1;
209
            $data->{version} = $2;
210
            $data->{prj} = $3;
211
            $data->{arch} = $4;
212
            $data->{type} = $5;
213
            $data->{arch} =~ s~_[PD]~~;
7304 dpurdie 214
            $alias = join('.', $data->{name}, $data->{prj}, $data->{arch}, $data->{type} );
6133 dpurdie 215
        }
216
        elsif ( $file =~ m~^(.*)-($pv)\.(.*)\.(rpm)$~i)
217
        {
218
            # COTS package
219
            $data->{name} = $1;
220
            $data->{version} = $2;
221
            $data->{arch} = $3;
222
            $data->{type} = $4;
223
            $data->{prj} = $proj;
224
        }
225
        elsif ( $file =~ m~^(.*)_($pv)\.(tgz)$~i)
226
        {
227
            # COTS package
228
            $data->{name} = $1;
229
            $data->{version} = $2;
230
            $data->{arch} = 'UNKNOWN';
231
            $data->{type} = $3;
232
            $data->{prj} = $proj;
233
        }
234
        elsif ( $file =~ m~^(.*)-($pv)\.(.*)\.(deb)$~i)
235
        {
236
            # COTS package
237
            $data->{name} = $1;
238
            $data->{version} = $2;
239
            $data->{arch} = $3;
240
            $data->{type} = $4;
241
            $data->{prj} = $proj;
242
        }
243
        elsif ( $file =~ m~^(.*)\.(sh|zip|msi|tar\.gz)$~i)
244
        {
245
            $data->{name} = $1;
246
            $data->{arch} = 'NOARCH';
247
            $data->{type} = $2;
248
 
249
            $data->{version} = $pvfull;
250
            $data->{prj} = $proj;
251
        }
252
 
253
        unless ($data && $data->{name} && $data->{prj} && $data->{type}) {
254
            push @elist, $file;
255
            next;
256
        }
257
        $data->{fullname} = $file;
258
 
259
        #
260
        #   Create a nice alias
261
        #       ERG -> VIX  (not done)
262
        #       All lowercase
263
        #
7304 dpurdie 264
        $alias = join ('.', $data->{name}, $data->{prj}, $data->{type} ) unless defined $alias;
6133 dpurdie 265
        $alias = lc ($alias);
266
        #$alias =~ s~^erg~vix~;
267
        #$alias =~ s~^vix~vix-~;
268
        #$alias =~ s~^vix--~vix-~;
269
        push (@edup, join( ' : ', $alias, $file ,$bomInfo->{files}{$alias}{fullname})  ) if exists $bomInfo->{files}{$alias};
270
 
271
        delete $data->{type};
272
        $bomInfo->{files}{$alias} = $data;
7304 dpurdie 273
#Debug0("Alias: $file-> $alias");
6133 dpurdie 274
    }
275
 
276
    ReportError ("Cannot extract file metadata from:", @elist)  if (@elist);
277
    ReportError ("Duplicate aliases for:", @edup)  if (@edup);
278
    ErrorDoExit();
279
}
280
 
281
#-------------------------------------------------------------------------------
282
# Function        : CopyInNew 
283
#
284
# Description     : Copy in new files
285
#                   Don't copy in files that already exist - assume that the
286
#                   files don't chnage without a chnage to the file name
287
#
288
# Inputs          : 
289
#
290
# Returns         : 
291
#
292
sub CopyInNew
293
{
294
    #
295
    #   Ensure the output directory exists
296
    #
297
    if ( ! -d $opt_rootdir )
298
    {
299
        if ( defined($opt_test) )
300
        {
301
            Message("mkdir $opt_rootdir");
302
        }
303
        else
304
        {
305
            eval { mkpath($opt_rootdir) };
306
            Error("Failed to make project directory tree $opt_rootdir") if ( $@ || ! -d $opt_rootdir );
307
        }
308
    }
309
 
310
    #
7300 dpurdie 311
    #   Generate a list of all files in the directory
312
    #
313
    foreach my $file ( glob("$opt_rootdir/*") ) {
314
        $baseList{$file}{data} = 1;
315
    }
316
 
317
    #
6133 dpurdie 318
    #   Determine the files to be transferred
319
    #
320
    my @filelist;
321
    foreach my $file ( keys %bomList)
322
    {
323
        push (@filelist, $file) unless ( -f "$opt_rootdir/$file" );
324
    }
325
 
326
    #
327
    #   Perform the actual copy
328
    #
329
    if ( @filelist )
330
    {
331
        #Message("Copying files for package $PKG_NAME version $PKG_VERSION");
332
        if ( defined($opt_test) )
333
        {
334
            Message( map("$_...", @filelist) );
335
        }
336
        else
337
        {
338
            eval { mkpath($opt_rootdir) };
339
            Error("Failed to make destination directory") if ( $@ || ! -d $opt_rootdir );
340
            foreach my $file ( @filelist )
341
            {
342
                Verbose("Copy: $file...");
343
 
344
                my $srcFile = $bomList{$file}{path};
345
                if ( ! copy($srcFile, $opt_rootdir) )
346
                {
347
                    Warning("Failed to copy $file ($!)");
348
                }
349
            }
350
        }
351
    }
352
}
353
 
354
#-------------------------------------------------------------------------------
355
# Function        : RemoveExcess 
356
#
357
# Description     : Remove excess files from the output directory 
358
#
359
# Inputs          : 
360
#
361
# Returns         : 
362
#
363
sub RemoveExcess
364
{
365
    my @filelist;
366
    my %keepList = map { $_ => 1 } @confFiles;
367
 
368
    #
369
    #   Find all files in the output directory
370
    #   Use the 'keepList' so that we don't pickup files that should
371
    #   be in the directory. README.md, MANIFEST ...
372
    #
373
    foreach my $srcPath ( glob("$opt_rootdir/*") )
374
    {
375
        my $dstFile = basename($srcPath);
376
        next if exists $keepList{$dstFile};
377
        next unless ( -f $srcPath );
378
 
379
        push (@filelist, $dstFile) unless (exists $bomList{$dstFile} );
380
    }
381
 
382
    if ( @filelist)
383
    {
7304 dpurdie 384
        Verbose ("Delete execess files", @filelist );
6133 dpurdie 385
        unless ( defined($opt_test) )
386
        {
387
            foreach my $file ( @filelist )
388
            {
7304 dpurdie 389
                Verbose2("Delete: $file...");
6133 dpurdie 390
                if ( unlink("$opt_rootdir/$file") ne 1 )
391
                {
392
                    Warning("Failed to delete: $file. ($!)");
393
                }
394
            }
395
        }
396
    }
7300 dpurdie 397
 
398
    #
399
    #   Report changed files
400
    #   Generate a list of all files in the directory
401
    #
402
    foreach my $file ( glob("$opt_rootdir/*") ) {
403
        $baseList{$file}{data} |= 2;
404
    }
405
 
406
    #
407
    #   Determined added, removed and replaced
408
    #       
409
    #
410
    my (@replaced, @added, @removed, @unchanged, %newList);
411
    foreach my $entry ( keys %baseList )
412
    {
413
        (my $key = $entry) =~ s~\d+~z~g;
414
        $baseList{$entry}{key} = $key;
415
 
416
        (my $name = $entry) =~ s~^\./~~;
417
        $newList{$key}{$baseList{$entry}{data}} = $entry;
418
    }
419
 
420
    foreach my $key ( sort keys %newList )
421
    {
422
        if (exists $newList{$key}{1} && exists $newList{$key}{2}  ) {
423
            push @replaced, "$newList{$key}{1}   =>   $newList{$key}{2}";
424
        } elsif (exists $newList{$key}{1}) {
425
            push @removed, $newList{$key}{1};
426
        } elsif (exists $newList{$key}{2}) {
427
            push @added, $newList{$key}{2};
428
        } elsif (exists $newList{$key}{3}) {
429
            push @unchanged, $newList{$key}{3};
430
        }
431
    }
432
 
433
    Message ("Unchanged: " .(@unchanged ? scalar(@unchanged ) : 'None') );
434
    Message ("Replaced: " . (@replaced ?  scalar(@replaced )  : 'None'), @replaced);
435
    Message ("Added: " .    (@added    ?  scalar(@added )     : 'None'), @added);
436
    Message ("Removed: " .  (@removed  ?  scalar(@removed )   : 'None'), @removed);
6133 dpurdie 437
}
438
 
439
#-------------------------------------------------------------------------------
440
# Function        : RemoveDuplicates 
441
#
442
# Description     : Scan the BOM file list and remove duplicate installers
443
#                   Duplicate installers are that that have both a P and a D
444
#                   flavor of the installer
445
#                   
446
#                   This test has some nasty built-in knowledge (assumtions)
447
#                   It assumes that:
448
#                       Windows installers are only created for one flavor
449
#                           Don't need to worry about windoes installers
450
#                       Non windows installers are of the form:
451
#                           Name_Architecture_Type.deb    
452
#
453
# Inputs          : 
454
#
455
# Returns         : 
456
#
457
sub RemoveDuplicates
458
{
459
    my %baseNames;
460
    foreach my $file ( keys %bomList)
461
    {
462
        #
463
        #   Only process files that are of the expected form
464
        #       ie: erg-udcrypt_1.0.3043.vss_UBUNTU16_P.deb
465
        #
466
        if( $file =~ m~(.*)_([PD])(\.(deb|rpm|tgz))$~ )
467
        {
468
            my $base=$1;
469
            my $type=$2;
470
            my $suf=$3;
471
 
472
            if (exists $baseNames{$base} )
473
            {
474
                my $debugName = $base . '_D' . $suf;  
475
                Verbose("Remove debug installer: $file. Kill: $debugName");
476
                delete $bomList{$debugName};
477
            }
478
 
479
            $baseNames{$base} = $type;
480
        }
481
    }
482
}
483
 
484
#-------------------------------------------------------------------------------
485
# Function        : LoadFilterConfig  
486
#
487
# Description     : Load Filter Config
488
#                   Retain filter config for future reference 
489
#
490
# Inputs          : 
491
#
492
# Returns         : 
493
#
494
sub LoadFilterConfig
495
{
496
    if ( -f "$opt_rootdir/$CONFFILE" )
497
    {
498
        Message("Loading Config File");
7304 dpurdie 499
        my $perl_scalar = ReadJsonFile("$opt_rootdir/$CONFFILE");
6133 dpurdie 500
        Error ("Invalid format in Config file")
501
            unless (ref($perl_scalar->{filters}) eq 'ARRAY');
502
 
503
        push (@confFilters, @{$perl_scalar->{filters}});
504
        push (@confFiles, @{$perl_scalar->{keptfiles}}) if exists ($perl_scalar->{keptfiles});
505
    }
506
}
507
 
508
#-------------------------------------------------------------------------------
7304 dpurdie 509
# Function        : ReadJsonFile 
510
#
511
# Description     : Read a JSON file and return the data 
512
#
513
# Inputs          : $fname  - Name of the file to read 
514
#
515
# Returns         : Ref to the JSON 
516
#
517
sub ReadJsonFile
518
{
519
    my ($fname) = @_;
520
    local $/;
521
    open(my $fh, $fname ) || Error("Failed to open $fname. $!");
522
    my $json_text = <$fh>;
523
    my $perl_scalar = decode_json( $json_text );
524
    close($fh);
525
 
526
    return $perl_scalar;
527
}
528
 
529
#-------------------------------------------------------------------------------
530
# Function        : WriteJsonFile 
531
#
532
# Description     : Write data into a file as JSON
533
#
534
# Inputs          : $fname  - Name of file to write
535
#                   $data   - Ref to data to write 
536
#
537
# Returns         : Will not return on error
538
#
539
sub WriteJsonFile
540
{
541
    my ($fname, $data) = @_;
542
    FileCreate ($fname, to_json( $data, { ascii => 1, pretty => 1 }));
543
}
544
 
545
 
546
#-------------------------------------------------------------------------------
6133 dpurdie 547
# Function        : ProcessFilterArgs
548
#
549
# Description     : Process the filter based arguments 
550
#
551
# Inputs          : 
552
#
553
# Returns         : 
554
#
555
sub ProcessFilterArgs
556
{
557
    my $filterArgSeen;
558
    my $writeConf;
559
 
560
 
561
 
562
    if ( @opt_addFilters )
563
    {
564
        Message ("Adding command line filters to the release config file");
565
        foreach my $element (@opt_addFilters) {
566
            UniquePush (\@confFilters, $_ ) foreach  ( split(/,/, $element));
567
        }
568
        $writeConf = 1;
569
    }
570
 
571
    if ( @opt_delFilters )
572
    {
573
        Message ("Deleting command line filters to the release config file");
574
        foreach my $element (@opt_delFilters) {
575
            ArrayDelete (\@confFilters, $_ ) foreach  ( split(/,/, $element));
576
        }
577
        $writeConf = 1;
578
    }
579
 
580
    if ( @opt_addFiles )
581
    {
582
        Message ("Adding command line files to the release config file");
583
        foreach my $element (@opt_addFiles) {
584
            UniquePush (\@confFiles, $_ ) foreach  ( split(/,/, $element));
585
        }
586
        $writeConf = 1;
587
    }
588
 
589
    if ( @opt_delFiles )
590
    {
591
        Message ("Deleting command line files to the release config file");
592
        foreach my $element (@opt_delFiles) {
593
            ArrayDelete (\@confFiles, $_ ) foreach  ( split(/,/, $element));
594
        }
595
        $writeConf = 1;
596
    }
597
 
598
    #
599
    #   Save filter information
600
    #
601
    if ( $writeConf && ! defined($opt_test) )
602
    {
603
        Verbose ("Write config file");
604
 
605
        #
606
        #   Add known files
607
        #
7304 dpurdie 608
        UniquePush (\@confFiles, $CONFFILE, $BOMFILE, $MANIFEST, $TFVARS);
6133 dpurdie 609
 
610
        my $config;
611
        push @{$config->{filters}},@confFilters;
612
        push @{$config->{keptfiles}},@confFiles;
7304 dpurdie 613
        WriteJsonFile("$opt_rootdir/$CONFFILE",$config);
6133 dpurdie 614
    }
615
 
616
    #
617
    #   Display information to the user
618
    #
619
    if ($opt_showFilters)
620
    {
621
        Message ("Configured Filters",@confFilters );
622
        $filterArgSeen = 1;
623
    }
624
 
625
    if ($opt_showFiles)
626
    {
627
        Message ("Configured Files. Keep:",@confFiles );
628
        $filterArgSeen = 1;
629
    }
630
 
631
 
632
    #
633
    #   Terminate program on any filter operations
634
    #
635
    exit 0 if ( $writeConf || $filterArgSeen);
636
}
637
 
638
#-------------------------------------------------------------------------------
639
# Function        : WriteManifest 
640
#
641
# Description     : Save the filter config file if required
642
#
643
# Inputs          : 
644
#
645
# Returns         : 
646
#
647
sub WriteManifest
648
{
649
    return if defined($opt_test);
650
 
651
    #
652
    #   Create JSON metadata
653
    #
654
    Verbose ("Write JSON Manifest");
655
    my $jsonString = to_json( $bomInfo, { ascii => 1, pretty => 1, canonical => 1 } ); 
656
    FileCreate ($opt_rootdir . '/' . $MANIFEST, $jsonString);
657
 
658
    #
659
    #   Create Terraform data
660
    #       Note: Terraform variable cannot have a '.' in them
661
    #   
662
    my @tfData2;
663
 
664
    push @tfData2, "// Terraform variable definitions to map clean package name to full file name";
665
    push @tfData2, "variable vixFileName {";
666
    push @tfData2, "    type = \"map\"";
667
    push @tfData2, "    default = {" ;
668
 
7300 dpurdie 669
    foreach my $item ( sort keys %{$bomInfo->{files}} )
6133 dpurdie 670
    {
671
        push @tfData2, "        \"". $item  ."\" = \"" .$bomInfo->{files}{$item}{fullname} ."\"";
672
    }
673
 
674
    push @tfData2, "    }" ;
675
    push @tfData2, "}" ;
676
 
677
    FileCreate ($opt_rootdir . '/' . $TFVARS, @tfData2);
678
 
679
 
680
}
681
 
682
#-------------------------------------------------------------------------------
683
# Function        : GetReleaseInfo 
684
#
685
# Description     : Get Release Meta Data
686
#
687
# Inputs          : 
688
#
689
# Returns         : Will exit on error 
690
#
691
sub GetReleaseInfo
692
{
693
    my $m_sqlstr = "SELECT p.PROJ_ID, rt.rtag_id, p.PROJ_NAME, rt.RTAG_NAME" .
694
                    " FROM release_tags rt, PROJECTS p" .
695
                    " WHERE p.PROJ_ID = rt.PROJ_ID" .
696
                    " and rt.RTAG_ID = " . $opt_rtagid;
697
 
698
    my $sth = $DM_DB->prepare($m_sqlstr);
699
    if ( defined($sth) )
700
    {
701
        if ( $sth->execute( ) )
702
        {
703
            if ( $sth->rows )
704
            {
705
                while ( my ( $proj_id, $xx, $pname, $rname ) = $sth->fetchrow_array )
706
                {
707
                    my $data;
708
                    $data->{product_id} = $proj_id;
709
                    $data->{product_name} = $pname;
710
                    $data->{release_rtagid} = $opt_rtagid;
711
                    $data->{release_name} = $rname;
712
                    push @{$bomInfo->{release}}, $data;
713
                }
714
            }
715
            else
716
            {
717
                Error("GetReleaseInfo: No rtagid found for " . $opt_rtagid);
718
            }
719
            $sth->finish();
720
        }
721
        else
722
        {
723
            Error("GetReleaseInfo: Execute failure", $sth->errstr(), $m_sqlstr );
724
        }
725
    }
726
    else
727
    {
728
        Error("GetReleaseInfo: Prepare failure", $sth->errstr(), $m_sqlstr );
729
    }
730
}
731
 
732
#-------------------------------------------------------------------------------
733
# Function        : GetPackageData 
734
#
735
# Description     : Extract data from RM based on the provided rtag_id
736
#
737
# Inputs          : 
738
#
739
# Returns         : 
740
#
741
sub GetPackageData
742
{
7304 dpurdie 743
    my $m_sqlstr =  "SELECT p.PKG_NAME, " .
744
                    " pv.PKG_VERSION, " .
745
                    " l.name " .
746
                    "FROM package_versions pv, " .
747
                    " RELEASE_MANAGER.RELEASE_CONTENT rc, " .
748
                    " RELEASE_MANAGER.PACKAGES p, " .
749
                    " RELEASE_MANAGER.LICENCING pl, " .
750
                    " RELEASE_MANAGER.LICENCES l " .
751
                    "WHERE rc.rtag_id     = $opt_rtagid " .
752
                    " AND rc.pv_id         = pv.pv_id " .
753
                    " AND p.PKG_ID         = pv.pkg_id " .
754
                    " AND pv.IS_DEPLOYABLE = 'Y' " .
755
                    " AND pl.PV_ID(+)      = pv.pv_id " .
756
                    " AND pl.LICENCE       = l.LICENCE(+)" ;
6133 dpurdie 757
#                    " and ( pv.IS_DEPLOYABLE = 'Y' or upper( p.PKG_NAME) like 'ERG%' or upper( p.PKG_NAME) like 'VIX%' )";
758
 
7304 dpurdie 759
 
760
 
761
    my ( $PKG_NAME, $PKG_VERSION, $LICENSE );
6133 dpurdie 762
    my $sth = $DM_DB->prepare($m_sqlstr);
763
    if ( defined($sth) )
764
    {
765
        if ( $sth->execute( ) )
766
        {
767
            if ( $sth->rows )
768
            {
7304 dpurdie 769
                while ( ( $PKG_NAME, $PKG_VERSION, $LICENSE ) = $sth->fetchrow_array )
6133 dpurdie 770
                {
771
                    Verbose ("Deployable: $PKG_NAME, $PKG_VERSION");
772
                    my $pkgDir = "$ENV{GBE_DPKG}/$PKG_NAME";
773
                    my $srcDir = "$ENV{GBE_DPKG}/$PKG_NAME/$PKG_VERSION";
774
                    my $dstDir = $opt_rootdir;
775
 
776
                    if ( -d "$srcDir" )
777
                    {
778
                        my $foundFiltered = 0;
779
 
780
                        # for each of the filter rules we glob the rule in the src pkg/version dir
781
                        # and if any of the globbed files dont exist in the dst dir add it to the 
782
                        # the filelist array of files to copy
783
                        foreach my $filter ( @confFilters )
784
                        {
785
                            foreach my $srcPath ( glob("$srcDir/$filter") )
786
                            {
787
                                next unless ( -f $srcPath );
788
                                $foundFiltered = 1;
789
                                $filtersUsed{$filter} = 1;
790
                                my $dstFile = basename($srcPath);
791
                                my $srcFile = $srcPath;
7304 dpurdie 792
                                ReportError("File provided by multiple packages: $dstFile") if exists ($bomList{$dstFile});
793
                                $bomList{$dstFile}{path} = $srcPath;
794
                                $bomList{$dstFile}{package} = $PKG_NAME;
795
                                $bomList{$dstFile}{version} = $PKG_VERSION;
796
                                $bomList{$dstFile}{license} = $LICENSE || '';
6133 dpurdie 797
                            }
798
                        }
799
 
800
                        # if no files found using filters then issue warning
801
                        Warning("No Files found for Package Version $PKG_NAME/$PKG_VERSION using supplied filters") 
802
                            unless ( $foundFiltered );
803
 
804
                        if ($foundFiltered)
805
                        {
806
                            $bomInfo->{packages}{$PKG_NAME} = $PKG_VERSION;
807
                        }
808
                    }
809
                    elsif ( ! -d "$pkgDir" )
810
                    {
811
                        # if srcDir and pkgDir dont exist then package is not in dpkg_archive so display message
812
                        Warning("Skipping Package $PKG_NAME/$PKG_VERSION as it does not exist in dpkg_archive");
813
                    }
814
                    else
815
                    {
816
                        # However if srcDir does not exist but pkgDir does exist then the package version is missing which maybe an issue
817
                        Warning("Missing Version $PKG_VERSION for Package $PKG_NAME in dpkg_archive");
818
                    }
819
                }
820
 
821
                #
822
                #   Report filter elements that where not used.
823
                #
824
                my @notUsed;
825
                foreach my $filter ( @confFilters )
826
                {
827
                    next if ( exists $filtersUsed{$filter} );
828
                    push @notUsed, $filter
829
                }
830
                Warning ("Unused filter rules:", @notUsed )
831
                    if ( @notUsed );
832
 
833
            }
834
            else
835
            {
836
                Error("No Packages for rtagid: $opt_rtagid");
837
            }
838
            $sth->finish();
839
        }
840
        else
841
        {
842
            Error("Execute failure", $sth->errstr(), $m_sqlstr );
843
        }
844
    }
845
    else
846
    {
847
        Error("Prepare failure", $sth->errstr(), $m_sqlstr );
848
    }
7304 dpurdie 849
 
850
    #
851
    #   Report Commercial packages
852
    #   Write out a file to contain the list of COTS files
853
    #
854
    my @Commercial;
855
    foreach my $file (sort keys %bomList)
856
    {
857
        next unless ($bomList{$file}{license} =~ m ~^Commercial~);
858
        $bomList{$file}{cots} = 1;
859
        push @Commercial, $file;
860
    }
861
    Message ("Commercial software packages:", @Commercial);
862
    my $data;
863
    $data->{COTS} = \@Commercial;
864
    WriteJsonFile ("$opt_rootdir/$BOMFILE", $data);
865
 
866
    ErrorDoExit();
6133 dpurdie 867
}
868
 
869
#-------------------------------------------------------------------------------
870
#   Documentation
871
#
872
 
873
=pod
874
 
875
=for htmltoc    DEPLOY::generate_deployable
876
 
877
=head1 NAME
878
 
879
jats_generate_deployable - Extracts current package version list from Release Manager RtagId
880
                and copy resultant packages to a specific directory.
881
 
882
=head1 SYNOPSIS
883
 
884
  jats generate_deployable [options]
885
 
886
 Options:
887
    -help                   - Brief help message
888
    -help -help             - Detailed help message
889
    -man                    - Full documentation
890
    -rtagid=xxx             - Specify the Release Manager RtagId to process
891
    -rootdir=xxx            - Specifies the root of the releases directory
892
 
893
    -showfilters            - Display current filter set and exit
894
    -addfilter=xxx[,yyy]    - Add a new filter to the existing filter set
895
    -delfilter=xxx[,yyy]    - Delete a filter from the existing filter set
896
 
897
    -showfiles              - Display current kept file set and exit
898
    -addfiles=xxx[,yyy]     - Add a new file to the kept file set
899
    -delfiles=xxx[,yyy]     - Delete a file from the kept file set
900
 
901
    -test                   - Just log actions without copying files.
902
    -verbose                - Enable verbose output
903
 
904
=head1 OPTIONS
905
 
906
=over 8
907
 
908
=item B<-help>
909
 
910
Print a brief help message and exits.
911
 
912
=item B<-help -help>
913
 
914
Print a detailed help message with an explanation for each option.
915
 
916
=item B<-man>
917
 
918
Prints the manual page and exits.
919
 
920
=item B<-rtagid=xxx>
921
 
922
This option specifies one or more RTAG_ID's to use as the source of packages that will be copied.
923
The ID will be used to get a unique list of package/versions that can be copied from dpkg_archive.
924
 
925
This option is Mandatory, for non-filter command.
926
 
927
=item B<-rootdir=xxx>
928
 
929
This option specifies the root directory where the packages will be copied to.
930
 
931
The specified directory must exist.
932
 
933
The default value is the current directory.
934
 
935
=item B<-showfilters>
936
 
937
This option will display the current filter set. If it is combined with another filter operation 
938
then the other operations will be performed before the display.
939
 
940
=item B<-addFilter=xxx[,yyy]>
941
 
942
This option allows new filters to be added to the set of filters. This
943
option can be specified multiple times.
944
 
945
This option specifies a comma separated list of shell wildcard filter rule that
946
will be used to determine which files are copied from package version directory in
947
GBE_DPKG to the release directory. This can be supplied multiple times to
948
specify rules for copying.
949
 
950
Filters must be added the first time this command is run against a release 
951
and packages are copied to the project/release directory.  These values are then written to a 
952
config file in the release directory so the same values can be used on subsequent runs.  
953
In these subsequent runs this option need not be specified as the config items will be used, however
954
they can be changed by specifying them again on the command line and the config will be re-written.
955
 
956
The values of these will depend on what builds are required for each project.  Some examples are
957
    --filter='*-WIN32.exe,*.deb'
958
 
959
=item B<-delFilter=xxx[,yyy]>
960
 
961
This option deletes one or more filter rules from an existing set of filters. This
962
option can be specified multiple times.
963
 
964
=item B<-showfiles>
965
 
966
This option will display the current file set. If it is combined with another file operations
967
then the other operations will be performed before the display.
968
 
969
=item B<-addFile=xxx[,yyy]>
970
 
971
This option allows new files to be added to the set of kept files. This
972
option can be specified multiple times.
973
 
974
This option specifies a comma separated list of file names (No wild cards) that
975
will be used to specify a list of files that shold be kept in the directory. These
976
files do not form a part of the manifest, but are not deleted by the tool.
977
 
978
=item B<-delFile=xxx[,yyy]>
979
 
980
This option deletes one or more files from the set of kept files. This
981
option can be specified multiple times.
982
 
983
=item B<-test>
984
 
985
This option will display what would be copied without actually copying anything
986
 
987
=item B<-verbose>
988
 
989
This option will display progress information as the program executes.
990
 
991
=back
992
 
993
=head1 DESCRIPTION
994
 
995
This program is used to update a Distribution 'bin' directory with the versions of
996
packages as indicated by the specified Deployment Manager SBoms.
997
 
998
There are two modes of operation: Filter modification operations and BOM creation.
999
 
1000
In 'Filter modification' mode the current filter set will be updated and the program will
1001
exit.
1002
 
1003
In BOM creation mode an sbomid must be provided.
1004
 
1005
The rtagid is used to get all the required information from Release Manager about
1006
which package version are required, as well as the project name and release name.
1007
 
1008
 
1009
In addition to using Release Manager information to determine which Package/Versions are
1010
required to be copied this script also uses a set of shell wildcard filters that are
1011
used to determine which files are actually copied when invoked.
1012
 
1013
The filter rules can be supplied on the command line if available read from a 
1014
configuration file saved in the output diretory the last time the script was run
1015
on this release directory.
1016
 
1017
One or more filter rules must be specified on the command line the first time this command 
1018
is run against a project release directory.  These filter values are then written to a config
1019
file in the output directory so the same values can be used on subsequent runs.  
1020
In subsequent runs the filter rules will be loaded from the config file and need not be specified 
1021
on the command line, however the filter rules in the config file can be changed by specifying 
1022
them again on the command line and the config will be re-written.
1023
 
1024
=cut
1025