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