Subversion Repositories DevTools

Rev

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

Rev Author Line No. Line
6133 dpurdie 1
########################################################################
6177 dpurdie 2
# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.
6133 dpurdie 3
#
4
# Module name   : jats_generate_bom.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 Deployment Manager
10
#                 SBom(s) and copies resultant packages to release specific
11
#                 directory.
12
#                 
13
#                 Based on jats_update_release.pl but it is intended to be used
14
#                 by the PULSE digital distribution process
15
#......................................................................#
16
 
17
require 5.008_002;
18
use File::Basename;
19
use File::Copy;
20
use File::Path;
21
use strict;
22
use warnings;
23
use JatsEnv;
24
use JatsError;
25
use JatsRmApi;
26
use ArrayHashUtils;
27
use FileUtils;
28
use DBI;
29
use Getopt::Long;
30
use Pod::Usage;                             # required for help support
31
use JSON;
32
 
33
#
34
#   Config Options
35
#
36
my $VERSION = "1.0.0";                      # Update this
37
my $opt_help = 0;
38
my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose
39
my @opt_sbom_ids;
40
my $opt_rootdir = '.';
41
my @opt_filters;
42
my $opt_test;
43
my $opt_showfilters;
44
my @opt_addFilters;
45
my @opt_delFilters;
46
 
47
#
48
#   Constants
49
#
50
my $CONFFILE = ".bomGen";
51
 
52
#
53
#   Globals
54
#
55
my $DM_DB;              #   Data Base Interface
56
my %dirList;            #   All files in the directory
57
my %bomList;            #   All files in the BOM
58
my $bomInfo;            #   Sbom meta data
59
 
60
#
61
#   Configuration file vars
62
#
63
my @confFilters;
64
my %filtersUsed;
65
 
66
#-------------------------------------------------------------------------------
67
# Function        : Main
68
#
69
# Description     : Main entry point
70
#                   Parse user options
71
#
72
# Inputs          :
73
#
74
# Returns         :
75
#
76
 
77
my $result = GetOptions (
78
                "help:+"            => \$opt_help,              # flag, multiple use allowed
79
                "manual:3"          => \$opt_help,              # flag, multiple use allowed
80
                "verbose:+"         => \$opt_verbose,           # flag
81
                "sbomid|sbom_id=s"  => \@opt_sbom_ids,          # multiple numbers
82
                "filter=s"          => \@opt_filters,           # multiple strings
83
                "addfilter=s"       => \@opt_addFilters,        # multiple strings
84
                "delfilter=s"       => \@opt_delFilters,        # multiple strings
85
                "showfilter"        => \$opt_showfilters,       # flag
86
                "rootdir=s"         => \$opt_rootdir,           # string
87
                "test"              => \$opt_test,              # flag
88
                );
89
 
90
#
91
#   Process help and manual options
92
#
93
pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result);
94
pod2usage(-verbose => 1)  if ($opt_help == 2 );
95
pod2usage(-verbose => 2)  if ($opt_help > 2);
96
 
97
ErrorConfig( 'name'    => 'GenBom',
98
             'verbose' => $opt_verbose );
99
 
100
#
101
#   Sanity tests
102
#
103
 
104
# Supplied rootdir must exists as a directory
105
Error("Root dir not specified") 
106
    unless defined $opt_rootdir;
107
Error("Root dir not a valid directory: ", $opt_rootdir )
108
    unless( -d $opt_rootdir );
109
 
110
    # Environment var GBE_DPKG must exists as a directory
111
Error("GBE_DPKG Environment var is not a directory")
112
    unless ( -d $ENV{GBE_DPKG} );
113
 
114
LoadFilterConfig();
115
ProcessFilterArgs();
116
 
117
#   None Filter operations
118
#   Must supply at least one sbomid
119
Error("Need -sbomid", "Example: -sbomid=2362" )
120
    unless (@opt_sbom_ids);
121
 
122
#
123
#   This command is destined to be used in a directory where group permissions
124
#   are important. Ensure that the user is not killing group access
125
#
126
umask 0002;
127
 
128
# We do need to make sure that all sbomids specified have the same project & release in DM
129
# so we call the getSbomProjectAndRelease
130
connectRM(\$DM_DB);
131
getSbomProjectAndRelease($DM_DB, \@opt_sbom_ids);
132
 
133
#
134
#   Body of the processing
135
#       Save generation time into the meta data
136
my $now = time;
137
$bomInfo->{version} = "1.0.0";
138
$bomInfo->{timestamp}{epoc} = $now;
139
$bomInfo->{timestamp}{utc} = gmtime($now);
140
 
141
Message("Copying packages from $ENV{GBE_DPKG} to $opt_rootdir");
142
 
143
#
144
#   Processing
145
#
146
GetSbomData();                  # Get DM/RM Data
147
RemoveDuplicates();             # Need P or D, but not both
148
CopyInNew();                    # Copy new files
149
RemoveExcess();                 # Remove files no longer required
150
GenFileData();                  # Generate file metadata
151
WriteManifest();                # Save out meta data
152
exit 0;
153
 
154
#-------------------------------------------------------------------------------
155
# Function        : GenFileData 
156
#
157
# Description     : Generate meta data on each file
158
#                   Much of this is a guess.
159
#                   Assume files look like:
160
#                   
161
#                       VIXcryptoKeyManager-1.0.2061.cr-WIN32.exe
162
#                       erg-pkgmnt_1.0.3010.cr_UBUNTU16_P.deb
163
#                       erg-pkgmnt_1.0.3010.cr_RHEL7_P.rpm
164
#
165
# Inputs          : None
166
#
167
# Returns         : Populates $bomInfo
168
#
169
sub GenFileData
170
{
171
    my @elist;
172
    my @edup;
173
    foreach my $file (sort keys %bomList)
174
    {
175
        my $data;
176
        my $alias;
177
 
178
        if ($file =~ m~^(.*)-(.*)\.(.*)-(WIN.*)\.(exe)$~i)
179
        {
180
            $data->{name} = $1;
181
            $data->{version} = $2;
182
            $data->{prj} = $3;
183
            $data->{arch} = $4;
184
            $data->{type} = $5;
185
        }
186
        elsif ( $file =~ m~^(.*)_(.*)\.([^_]+)_(.*)\.(deb)$~i)
187
        {
188
            $data->{name} = $1;
189
            $data->{version} = $2;
190
            $data->{prj} = $3;
191
            $data->{arch} = $4;
192
            $data->{type} = $5;
193
            $data->{arch} =~ s~_[PD]~~;
194
        }
195
        elsif ( $file =~ m~^(.*)_(.*)\.([^_]+)_(.*)\.(rpm)~i)
196
        {
197
            $data->{name} = $1;
198
            $data->{version} = $2;
199
            $data->{prj} = $3;
200
            $data->{arch} = $4;
201
            $data->{type} = $5;
202
            $data->{arch} =~ s~_[PD]~~;;
203
        }
204
 
205
        unless ($data && $data->{name} && $data->{prj} && $data->{type}) {
206
            push @elist, $file;
207
            next;
208
        }
209
        $data->{fullname} = $file;
210
 
211
        #
212
        #   Create a nice alias
213
        #       ERG -> VIX
214
        #       All lowercase
215
        #
216
        $alias = join ('.', $data->{name}, $data->{prj}, $data->{type});
217
        $alias = lc ($alias);
218
        $alias =~ s~^erg~vix~;
219
        $alias =~ s~^vix~vix-~;
220
        $alias =~ s~^vix--~vix-~;
221
        push (@edup, join( ' : ', $alias, $file ,$bomInfo->{files}{$alias}{fullname})  ) if exists $bomInfo->{files}{$alias};
222
 
223
        delete $data->{type};
224
        $bomInfo->{files}{$alias} = $data;
225
    }
226
 
227
    ReportError ("Cannot extract file metadata from:", @elist)  if (@elist);
228
    ReportError ("Duplicate aliases for:", @edup)  if (@edup);
229
    ErrorDoExit();
230
}
231
 
232
#-------------------------------------------------------------------------------
233
# Function        : CopyInNew 
234
#
235
# Description     : Copy in new files
236
#                   Don't copy in files that already exist - assume that the
237
#                   files don't chnage without a chnage to the file name
238
#
239
# Inputs          : 
240
#
241
# Returns         : 
242
#
243
sub CopyInNew
244
{
245
    #
246
    #   Ensure the output directory exists
247
    #
248
    if ( ! -d $opt_rootdir )
249
    {
250
        if ( defined($opt_test) )
251
        {
252
            Message("mkdir $opt_rootdir");
253
        }
254
        else
255
        {
256
            eval { mkpath($opt_rootdir) };
257
            Error("Failed to make project directory tree $opt_rootdir") if ( $@ || ! -d $opt_rootdir );
258
        }
259
    }
260
 
261
    #
262
    #   Determine the files to be transferred
263
    #
264
    my @filelist;
265
    foreach my $file ( keys %bomList)
266
    {
267
        push (@filelist, $file) unless ( -f "$opt_rootdir/$file" );
268
    }
269
 
270
    #
271
    #   Perform the actual copy
272
    #
273
    if ( @filelist )
274
    {
275
        #Message("Copying files for package $PKG_NAME version $PKG_VERSION");
276
        if ( defined($opt_test) )
277
        {
278
            Message( map("$_...", @filelist) );
279
        }
280
        else
281
        {
282
            eval { mkpath($opt_rootdir) };
283
            Error("Failed to make destination directory") if ( $@ || ! -d $opt_rootdir );
284
            foreach my $file ( @filelist )
285
            {
286
                Verbose("Copy: $file...");
287
                my $srcFile = $bomList{$file};
288
                if ( ! copy($srcFile, $opt_rootdir) )
289
                {
290
                    Warning("Failed to copy $file ($!)");
291
                }
292
            }
293
        }
294
    }
295
}
296
 
297
#-------------------------------------------------------------------------------
298
# Function        : RemoveExcess 
299
#
300
# Description     : Remove excess files from the output directory 
301
#
302
# Inputs          : 
303
#
304
# Returns         : 
305
#
306
sub RemoveExcess
307
{
308
    my @filelist;
309
    #
310
    #   Find all files in the output directory
311
    #   Use the 'filters' so that we don't pickup files that should
312
    #   be in the directory. README.md, MANIFEST ...
313
    #
314
    foreach my $filter ( @confFilters )
315
    {
316
        foreach my $srcPath ( glob("$opt_rootdir/$filter") )
317
        {
318
            next unless ( -f $srcPath );
319
            my $dstFile = basename($srcPath);
320
            $dirList{$dstFile} = 1;
321
            push (@filelist, $dstFile) unless (exists $bomList{$dstFile} );
322
        }
323
    }
324
 
325
    if ( @filelist)
326
    {
327
        Message ("Delete execess files", @filelist );
328
        unless ( defined($opt_test) )
329
        {
330
            foreach my $file ( @filelist )
331
            {
332
                Verbose("Delete: $file...");
333
                if ( unlink("$opt_rootdir/$file") ne 1 )
334
                {
335
                    Warning("Failed to delete: $file. ($!)");
336
                }
337
            }
338
        }
339
    }
340
}
341
 
342
#-------------------------------------------------------------------------------
343
# Function        : RemoveDuplicates 
344
#
345
# Description     : Scan the BOM file list and remove duplicate installers
346
#                   Duplicate installers are that that have both a P and a D
347
#                   flavor of the installer
348
#                   
349
#                   This test has some nasty built-in knowledge (assumtions)
350
#                   It assumes that:
351
#                       Windows installers are only created for one flavor
352
#                           Don't need to worry about windoes installers
353
#                       Non windows installers are of the form:
354
#                           Name_Architecture_Type.deb    
355
#
356
# Inputs          : 
357
#
358
# Returns         : 
359
#
360
sub RemoveDuplicates
361
{
362
    my %baseNames;
363
    foreach my $file ( keys %bomList)
364
    {
365
        #
366
        #   Only process files that are of the expected form
367
        #       ie: erg-udcrypt_1.0.3043.vss_UBUNTU16_P.deb
368
        #
369
        if( $file =~ m~(.*)_([PD])(\.(deb|rpm))$~ )
370
        {
371
            my $base=$1;
372
            my $type=$2;
373
            my $suf=$3;
374
 
375
            if (exists $baseNames{$base} )
376
            {
377
                my $debugName = $base . '_D' . $suf;  
378
                Verbose("Remove debug installer: $file. Kill: $debugName");
379
                delete $bomList{$debugName};
380
            }
381
 
382
            $baseNames{$base} = $type;
383
        }
384
    }
385
}
386
 
387
#-------------------------------------------------------------------------------
388
# Function        : LoadFilterConfig  
389
#
390
# Description     : Load Filter Config
391
#                   Retain filter config for future reference 
392
#
393
# Inputs          : 
394
#
395
# Returns         : 
396
#
397
sub LoadFilterConfig
398
{
399
    if ( -f "$opt_rootdir/$CONFFILE" )
400
    {
401
        Message("Loading Config File");
402
 
403
        local $/;
404
        open(my $fh, "<$opt_rootdir/$CONFFILE") || Error("Failed to open config file");
405
        my $json_text = <$fh>;
406
        my $perl_scalar = decode_json( $json_text );
407
        Error ("Invalid format in Config file")
408
            unless (ref($perl_scalar->{filters}) eq 'ARRAY');
409
        push(@confFilters, @{$perl_scalar->{filters}});
410
        close($fh);
411
    }
412
}
413
 
414
#-------------------------------------------------------------------------------
415
# Function        : ProcessFilterArgs
416
#
417
# Description     : Process the filter based arguments 
418
#
419
# Inputs          : 
420
#
421
# Returns         : 
422
#
423
sub ProcessFilterArgs
424
{
425
    my $filterArgSeen;
426
    my $writeConf;
427
 
428
 
429
    if ( $#opt_filters > -1 && $#confFilters > -1 )
430
    {
431
        Message("Filters supplied on Command line", @opt_filters);
432
        Message("Filters in release configuration file", @confFilters);
433
        if ( !GetYesNo("Replace Config Filters with command line Filters, be careful as this may change the copy rules") )
434
        {
435
            Error("Script terminated by user.");
436
        }
437
        @confFilters = ();
438
        foreach my $element (@opt_filters) {
439
            UniquePush (\@confFilters, $_ ) foreach  ( split(/,/, $element));
440
        }
441
        $writeConf = 1;
442
        $filterArgSeen = 1;
443
    }
444
    elsif ( $#opt_filters > -1 && $#confFilters == -1 )
445
    {
446
        Message("Filters supplied on Command line will be written to config file for release", @opt_filters);
447
        @confFilters = ();
448
        foreach my $element (@opt_filters) {
449
            UniquePush (\@confFilters, $_ ) foreach  ( split(/,/, $element));
450
        }
451
        $writeConf = 1;
452
    }
453
    elsif ( $#opt_filters == -1 && $#confFilters > -1 )
454
    {
455
        Message("Filters loaded from config file for release will be used", @confFilters) if ( IsVerbose(1) );
456
    }
457
    elsif ( $#opt_filters == -1 && $#confFilters == -1 )
458
    {
459
        Error("No Filters supplied on command line or release config file");
460
    }
461
 
462
    if ( @opt_addFilters )
463
    {
464
        Message ("Adding command line filters to the release config file");
465
        foreach my $element (@opt_addFilters) {
466
            UniquePush (\@confFilters, $_ ) foreach  ( split(/,/, $element));
467
        }
468
        $writeConf = 1;
469
    }
470
 
471
    if ( @opt_delFilters )
472
    {
473
        Message ("Deleting command line filters to the release config file");
474
        foreach my $element (@opt_delFilters) {
475
            ArrayDelete (\@confFilters, $_ ) foreach  ( split(/,/, $element));
476
        }
477
        $writeConf = 1;
478
    }
479
 
480
    if ($opt_showfilters)
481
    {
482
        Message ("Configured Filters",@confFilters );
483
        $filterArgSeen = 1;
484
    }
485
 
486
    #
487
    #   Save filter information
488
    #
489
    if ( $writeConf && ! defined($opt_test) )
490
    {
491
        Verbose ("Write config file");
492
        my $config;
493
        push @{$config->{filters}},@confFilters;
494
        FileCreate ("$opt_rootdir/$CONFFILE", to_json( $config, { ascii => 1, pretty => 1 }));
495
    }
496
 
497
    #
498
    #   Terminate program on any filter operations
499
    #
500
    exit 0 if ( $writeConf || $filterArgSeen);
501
}
502
 
503
#-------------------------------------------------------------------------------
504
# Function        : WriteManifest 
505
#
506
# Description     : Save the filter config file if required
507
#
508
# Inputs          : 
509
#
510
# Returns         : 
511
#
512
sub WriteManifest
513
{
514
    return if defined($opt_test);
515
 
516
    #
517
    #   Create JSON metadata
518
    #
519
    Verbose ("Write JSON Manifest");
520
    my $jsonString = to_json( $bomInfo, { ascii => 1, pretty => 1, canonical => 1 } ); 
521
    FileCreate ($opt_rootdir . '/MANIFEST.json', $jsonString);
522
 
523
}
524
 
525
# -------------------------------------------------------------------------
526
sub GetYesNo
527
#
528
# -------------------------------------------------------------------------
529
{
530
    my ($question) = @_;
531
    my ($u_tmp) = "";
532
    Question ("$question, (default: y) [y,n]: ");
533
 
534
    while ( <STDIN> )
535
    {
536
        $u_tmp = $_;
537
        chomp($u_tmp);
538
 
539
        return 1
540
            if ( "$u_tmp" eq "" );
541
 
542
        if( $u_tmp =~ /[yn]{1}/i )
543
        {
544
            return ( "$u_tmp" eq "y" );
545
        }
546
        else
547
        {
548
            Question("Please re-enter response? (default: y) [y,n]: ");
549
        }
550
    }
551
}
552
 
553
#-------------------------------------------------------------------------------
554
# Function        : getSbomProjectAndRelease 
555
#
556
# Description     : Get SBOM Meta Data
557
#                   Ensure all BOMS are a part of the same project
558
#
559
# Inputs          : 
560
#
561
# Returns         : Will exit on error 
562
#
563
sub getSbomProjectAndRelease
564
{
565
    my ( $DB, $sboms ) = @_;
566
    my ( $lastProj, $lastRel );
567
 
568
    Error("getSbomProjectAndRelease: SBom Parameter Error, must pass array") if ( ref($sboms) ne "ARRAY" );
569
 
570
    # create a hash of sbom values so we can test after if any sboms could not be found
571
    my %sbomIdx = map { $_ => 1 } @{$sboms};
572
 
573
    my $m_sqlstr = "SELECT   boms.bom_id, dm_projects.proj_name, branches.branch_name " .
574
                   "FROM     deployment_manager.boms, deployment_manager.branches, deployment_manager.dm_projects " .
575
                   "WHERE    branches.branch_id = boms.branch_id AND " .
576
                   "         dm_projects.proj_id = branches.proj_id AND " .
577
                   "         boms.bom_id " . ( $#{$sboms} == 0 ? "= " . $sboms->[0] : "IN ( " . join(",", @{$sboms}) . ")" );
578
 
579
    my $sth = $DB->prepare($m_sqlstr);
580
    if ( defined($sth) )
581
    {
582
        if ( $sth->execute( ) )
583
        {
584
            if ( $sth->rows )
585
            {
586
                while ( my ( $bom, $proj, $rel ) = $sth->fetchrow_array )
587
                {
588
                    if ( ! defined($proj) )
589
                    {
590
                        Error("getSbomProjectAndRelease: NULL Project Name from Deployment Manager Sbom : $bom");
591
                    }
592
                    elsif ( ! defined($rel) )
593
                    {
594
                        Error("getSbomProjectAndRelease: NULL Release Tag Name from Deployment Manager Sbom : $bom");
595
                    }
596
                    elsif ( defined($lastProj) && $proj ne $lastProj )
597
                    {
598
                        Error("getSbomProjectAndRelease: SBom Id [$bom] is in a different project [$proj]", "All SBom Id's must all be part of the same Deployment Manager Project");
599
                    }
600
                    elsif ( defined($lastRel) && $rel ne $lastRel )
601
                    {
602
                        Error("getSbomProjectAndRelease: SBom Id [$bom] is in a different project release [$rel]", "All SBom Id's must all be part of the same Deployment Manager Project Release");
603
                    }
604
                    $lastProj = $proj;
605
                    $lastRel  = $rel;
606
 
607
                    my $data;
608
                    $data->{sbom_id} = $bom;
609
                    $data->{project} = $proj;
610
                    $data->{release} = $rel;
611
                    push @{$bomInfo->{sbom}}, $data;
612
 
613
                    # delete sbom from idx, any remaining after loop will indicate we have an sbom that could not found
614
                    delete($sbomIdx{$bom});
615
                }
616
 
617
                my @sbomsNotFound = keys %sbomIdx;
618
                if ( $#sbomsNotFound > -1 )
619
                {
620
                    Error("getSbomProjectAndRelease: Could not find details for the following SBomId(s) " . join(",", @sbomsNotFound) );
621
                }
622
            }
623
            else
624
            {
625
                Error("getSbomProjectAndRelease: No SBom(s) found for Deployment Manager SBomId(s) " . join(",", @{$sboms}) );
626
            }
627
            $sth->finish();
628
        }
629
        else
630
        {
631
            Error("getSbomProjectAndRelease: Execute failure", $sth->errstr(), $m_sqlstr );
632
        }
633
    }
634
    else
635
    {
636
        Error("getSbomProjectAndRelease: Prepare failure", $sth->errstr(), $m_sqlstr );
637
    }
638
}
639
 
640
#-------------------------------------------------------------------------------
641
# Function        : GetSbomData 
642
#
643
# Description     : Extract data from DM and RM based on the provided SBOM
644
#                       Ignore 'Unbuildable package - These are DM Only artifacts
645
#
646
# Inputs          : 
647
#
648
# Returns         : 
649
#
650
sub GetSbomData
651
{
652
    my $m_sqlstr = "SELECT   packages.pkg_name, package_versions.pkg_version " .
653
                   "FROM     deployment_manager.bom_contents, " .
654
                   "         deployment_manager.network_nodes, " .
655
                   "         deployment_manager.os_contents, " .
656
                   "         deployment_manager.operating_systems, " .
657
                   "         release_manager.package_versions, " .
658
                   "         release_manager.packages " .
659
                   "WHERE    network_nodes.node_id = bom_contents.node_id AND " .
660
                   "         network_nodes.node_id = operating_systems.node_id AND " .
661
                   "         operating_systems.os_id = os_contents.os_id AND " .
662
                   "         os_contents.prod_id = package_versions.pv_id AND " .
663
                   "         package_versions.pkg_id = packages.pkg_id AND " .
664
                   "         package_versions.build_type != 'U' AND " .
665
                   "         bom_contents.bom_id " . ( $#opt_sbom_ids == 0 ? "= " . $opt_sbom_ids[0] : "IN ( " . join(",", @opt_sbom_ids) . ")" ) . " " .
666
                   "GROUP BY packages.pkg_name, package_versions.pkg_version " .
667
                   "ORDER BY packages.pkg_name ASC, package_versions.pkg_version ASC";
668
 
669
    my ( $PKG_NAME, $PKG_VERSION );
670
 
671
    my $sth = $DM_DB->prepare($m_sqlstr);
672
    if ( defined($sth) )
673
    {
674
        if ( $sth->execute( ) )
675
        {
676
            if ( $sth->rows )
677
            {
678
                while ( ( $PKG_NAME, $PKG_VERSION ) = $sth->fetchrow_array )
679
                {
680
                    my $pkgDir = "$ENV{GBE_DPKG}/$PKG_NAME";
681
                    my $srcDir = "$ENV{GBE_DPKG}/$PKG_NAME/$PKG_VERSION";
682
                    my $dstDir = $opt_rootdir;
683
 
684
                    if ( -d "$srcDir" )
685
                    {
686
                        my $foundFiltered = 0;
687
 
688
                        # for each of the filter rules we glob the rule in the src pkg/version dir
689
                        # and if any of the globbed files dont exist in the dst dir add it to the 
690
                        # the filelist array of files to copy
691
                        foreach my $filter ( @confFilters )
692
                        {
693
                            foreach my $srcPath ( glob("$srcDir/$filter") )
694
                            {
695
                                next unless ( -f $srcPath );
696
                                $foundFiltered = 1;
697
                                $filtersUsed{$filter} = 1;
698
                                my $dstFile = basename($srcPath);
699
                                my $srcFile = $srcPath;
700
                                $srcFile =~ s~^$srcDir/~~;
701
                                $bomList{$srcFile} = $srcPath;
702
                            }
703
                        }
704
 
705
                        # if no files found using filters then issue warning
706
                        Warning("No Files found for Package Version $PKG_NAME/$PKG_VERSION using supplied filters") 
707
                            unless ( $foundFiltered );
708
                    }
709
                    elsif ( ! -d "$pkgDir" )
710
                    {
711
                        # if srcDir and pkgDir dont exist then package is not in dpkg_archive so display message
712
                        Warning("Skipping Package $PKG_NAME/$PKG_VERSION as it does not exist in dpkg_archive");
713
                    }
714
                    else
715
                    {
716
                        # However if srcDir does not exist but pkgDir does exist then the package version is missing which maybe an issue
717
                        Warning("Missing Version $PKG_VERSION for Package $PKG_NAME in dpkg_archive");
718
                    }
719
                }
720
 
721
                #
722
                #   Report filter elements that where not used.
723
                #
724
                my @notUsed;
725
                foreach my $filter ( @confFilters )
726
                {
727
                    next if ( exists $filtersUsed{$filter} );
728
                    push @notUsed, $filter
729
                }
730
                Warning ("Unused filter rules:", @notUsed )
731
                    if ( @notUsed );
732
 
733
            }
734
            else
735
            {
736
                Error("No Boms found for Deployment Manager SBomId(s) " . join(",", @opt_sbom_ids) );
737
            }
738
            $sth->finish();
739
        }
740
        else
741
        {
742
            Error("Execute failure", $sth->errstr(), $m_sqlstr );
743
        }
744
    }
745
    else
746
    {
747
        Error("Prepare failure", $sth->errstr(), $m_sqlstr );
748
    }
749
}
750
 
751
#-------------------------------------------------------------------------------
752
#   Documentation
753
#
754
 
755
=pod
756
 
757
=for htmltoc    DEPLOY::generate_bom
758
 
759
=head1 NAME
760
 
761
jats_generate_bom - Extracts current package version list from Deployment Manager SBom(s)
762
                and copy resultant packages to a specific directory.
763
 
764
=head1 SYNOPSIS
765
 
766
  jats generate_bom [options]
767
 
768
 Options:
769
    -help              - brief help message
770
    -help -help        - Detailed help message
771
    -man               - Full documentation
772
    -sbomid=xxx        - Specify the Deployment Manager SBom(s) to process
773
                       - Can be specified multiple times to combine SBoms
774
    -rootdir=xxx       - Specifies the root of the releases directory
775
    -showfilters       - Display current filter set and exit
776
    -filter=xxx        - Specifies a shell wildcard used to filter package files to copy
777
                       - Can be specified multiple times to use multiple filters
778
    -addfilter=xxx     - Add a new filter to the existing filter set
779
    -delfilter=xxx     - Delete a filter from the existing filter set
780
    -test              - Just log actions without copying files.
781
    -verbose           - Enable verbose output
782
 
783
=head1 OPTIONS
784
 
785
=over 8
786
 
787
=item B<-help>
788
 
789
Print a brief help message and exits.
790
 
791
=item B<-help -help>
792
 
793
Print a detailed help message with an explanation for each option.
794
 
795
=item B<-man>
796
 
797
Prints the manual page and exits.
798
 
799
=item B<-sbomid=xxx>
800
 
801
This option specifies one or more SBOM_ID's to use as the source of packages that will be copied.
802
The SBoms will be used to get a unique list of package/versions that can be copied from dpkg_archive.
803
 
804
This option is Mandatory, for non-filter command,  and a minimum of one SBom must be supplied. If more that one SBom is
805
supplied then all Sbom Ids must be of the same project and release with in that project.
806
 
807
=item B<-rootdir=xxx>
808
 
809
This option specifies the root directory where the packages will be copied to.
810
 
811
The specified directory must exist.
812
 
813
The default value is the current directory.
814
 
815
=item B<-showfilters>
816
 
817
This option will display the current filter set. If it is combined with another filter operation 
818
then the other operations will be performed before the display.
819
 
820
=item B<-filter=xxx[,yyy]>
821
 
822
This option specifies a comma separated list of shell wildcard filter rule that
823
is used to determine which files are copied from package version directory in
824
GBE_DPKG to the release directory. This can be supplied multiple times to
825
specify rules for copying.
826
 
827
This must be specified on the command line the first time this command is run against a release 
828
and packages are copied to the project/release directory.  These values are then written to a 
829
config file in the project/release directory so the same values can be used on subsequent runs.  
830
In these subsequent runs this option need not be specified as the config items will be used, however
831
they can be changed by specifying them again on the command line and the config will be re-written.
832
 
833
The values of these will depend on what builds are required for each project.  Some examples are
834
    --filter='*-WIN32.exe,*.deb'
835
 
836
=item B<-addFilter=xxx[,yyy]>
837
 
838
This option allows new filters to be added to an existing set of filters. This
839
option can be specified multiple times.
840
 
841
=item B<-delFilter=xxx[,yyy]>
842
 
843
This option deletes one or more filter rules from an existing set of filters. This
844
option can be specified multiple times.
845
 
846
=item B<-test>
847
 
848
This option will display what would be copied without actually copying anything
849
 
850
=item B<-verbose>
851
 
852
This option will display progress information as the program executes.
853
 
854
=back
855
 
856
=head1 DESCRIPTION
857
 
858
This program is used to update a Distribution 'bin' directory with the versions of
859
packages as indicated by the specified Deployment Manager SBoms.
860
 
861
There are two modes of operation: Filter modification operations and BOM creation.
862
 
863
In 'Filter modification' mode the current filter set will be updated and the program will
864
exit.
865
 
866
In BOM creation mode an sbomid must be provided.
867
 
868
The sbomid is used to get all the required information from Deployment Manager about
869
which package version are required, as well as the project name and release name under
870
which the Sboms are under.
871
 
872
The sbomid option can be specified multiple times to copy packages from multiple SBoms
873
to the Project Release directory.  All Sboms that are specified must be under the 
874
same Release under the same Project otherwise the script will abort.
875
 
876
In addition to using Deployment Manager SBoms to determine which Package/Versions are
877
required to be copied this script also uses a set of shell wildcard filters that are
878
used to determine which files are actually copied when invoked.
879
 
880
The filter rules can be supplied on the command line if available read from a 
881
configuration file saved in the output diretory the last time the script was run
882
on this release directory.
883
 
884
One or more filter rules must be specified on the command line the first time this command 
885
is run against a project release directory.  These filter values are then written to a config
886
file in the output directory so the same values can be used on subsequent runs.  
887
In subsequent runs the filter rules will be loaded from the config file and need not be specified 
888
on the command line, however the filter rules in the config file can be changed by specifying 
889
them again on the command line and the config will be re-written.
890
 
891
=cut
892