| 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 |
|