Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed
######################################################################### Copyright (c) VIX TECHNOLOGY (AUST) LTD## Module name : jats_generate_bom.pl# Module type : Makefile system# Compiler(s) : Perl# Environment(s): jats build system## Description : Extracts current package version list from Deployment Manager# SBom(s) and copies resultant packages to release specific# directory.## Based on jats_update_release.pl but it is intended to be used# by the PULSE digital distribution process#......................................................................#require 5.008_002;use File::Basename;use File::Copy;use File::Path;use strict;use warnings;use JatsEnv;use JatsError;use JatsRmApi;use ArrayHashUtils;use FileUtils;use DBI;use Getopt::Long;use Pod::Usage; # required for help supportuse JSON;## Config Options#my $VERSION = "1.0.0"; # Update thismy $opt_help = 0;my $opt_verbose = $ENV{'GBE_VERBOSE'}; # Allow global verbosemy @opt_sbom_ids;my $opt_rootdir = '.';my @opt_filters;my $opt_test;my $opt_showfilters;my @opt_addFilters;my @opt_delFilters;## Constants#my $CONFFILE = ".bomGen";## Globals#my $DM_DB; # Data Base Interfacemy %dirList; # All files in the directorymy %bomList; # All files in the BOMmy $bomInfo; # Sbom meta data## Configuration file vars#my @confFilters;my %filtersUsed;#-------------------------------------------------------------------------------# Function : Main## Description : Main entry point# Parse user options## Inputs :## Returns :#my $result = GetOptions ("help:+" => \$opt_help, # flag, multiple use allowed"manual:3" => \$opt_help, # flag, multiple use allowed"verbose:+" => \$opt_verbose, # flag"sbomid|sbom_id=s" => \@opt_sbom_ids, # multiple numbers"filter=s" => \@opt_filters, # multiple strings"addfilter=s" => \@opt_addFilters, # multiple strings"delfilter=s" => \@opt_delFilters, # multiple strings"showfilter" => \$opt_showfilters, # flag"rootdir=s" => \$opt_rootdir, # string"test" => \$opt_test, # flag);## Process help and manual options#pod2usage(-verbose => 0, -message => "Version: $VERSION") if ($opt_help == 1 || ! $result);pod2usage(-verbose => 1) if ($opt_help == 2 );pod2usage(-verbose => 2) if ($opt_help > 2);ErrorConfig( 'name' => 'GenBom','verbose' => $opt_verbose );## Sanity tests## Supplied rootdir must exists as a directoryError("Root dir not specified")unless defined $opt_rootdir;Error("Root dir not a valid directory: ", $opt_rootdir )unless( -d $opt_rootdir );# Environment var GBE_DPKG must exists as a directoryError("GBE_DPKG Environment var is not a directory")unless ( -d $ENV{GBE_DPKG} );LoadFilterConfig();ProcessFilterArgs();# None Filter operations# Must supply at least one sbomidError("Need -sbomid", "Example: -sbomid=2362" )unless (@opt_sbom_ids);## This command is destined to be used in a directory where group permissions# are important. Ensure that the user is not killing group access#umask 0002;# We do need to make sure that all sbomids specified have the same project & release in DM# so we call the getSbomProjectAndReleaseconnectRM(\$DM_DB);getSbomProjectAndRelease($DM_DB, \@opt_sbom_ids);## Body of the processing# Save generation time into the meta datamy $now = time;$bomInfo->{version} = "1.0.0";$bomInfo->{timestamp}{epoc} = $now;$bomInfo->{timestamp}{utc} = gmtime($now);Message("Copying packages from $ENV{GBE_DPKG} to $opt_rootdir");## Processing#GetSbomData(); # Get DM/RM DataRemoveDuplicates(); # Need P or D, but not bothCopyInNew(); # Copy new filesRemoveExcess(); # Remove files no longer requiredGenFileData(); # Generate file metadataWriteManifest(); # Save out meta dataexit 0;#-------------------------------------------------------------------------------# Function : GenFileData## Description : Generate meta data on each file# Much of this is a guess.# Assume files look like:## VIXcryptoKeyManager-1.0.2061.cr-WIN32.exe# erg-pkgmnt_1.0.3010.cr_UBUNTU16_P.deb# erg-pkgmnt_1.0.3010.cr_RHEL7_P.rpm## Inputs : None## Returns : Populates $bomInfo#sub GenFileData{my @elist;my @edup;foreach my $file (sort keys %bomList){my $data;my $alias;if ($file =~ m~^(.*)-(.*)\.(.*)-(WIN.*)\.(exe)$~i){$data->{name} = $1;$data->{version} = $2;$data->{prj} = $3;$data->{arch} = $4;$data->{type} = $5;}elsif ( $file =~ m~^(.*)_(.*)\.([^_]+)_(.*)\.(deb)$~i){$data->{name} = $1;$data->{version} = $2;$data->{prj} = $3;$data->{arch} = $4;$data->{type} = $5;$data->{arch} =~ s~_[PD]~~;}elsif ( $file =~ m~^(.*)_(.*)\.([^_]+)_(.*)\.(rpm)~i){$data->{name} = $1;$data->{version} = $2;$data->{prj} = $3;$data->{arch} = $4;$data->{type} = $5;$data->{arch} =~ s~_[PD]~~;;}unless ($data && $data->{name} && $data->{prj} && $data->{type}) {push @elist, $file;next;}$data->{fullname} = $file;## Create a nice alias# ERG -> VIX# All lowercase#$alias = join ('.', $data->{name}, $data->{prj}, $data->{type});$alias = lc ($alias);$alias =~ s~^erg~vix~;$alias =~ s~^vix~vix-~;$alias =~ s~^vix--~vix-~;push (@edup, join( ' : ', $alias, $file ,$bomInfo->{files}{$alias}{fullname}) ) if exists $bomInfo->{files}{$alias};delete $data->{type};$bomInfo->{files}{$alias} = $data;}ReportError ("Cannot extract file metadata from:", @elist) if (@elist);ReportError ("Duplicate aliases for:", @edup) if (@edup);ErrorDoExit();}#-------------------------------------------------------------------------------# Function : CopyInNew## Description : Copy in new files# Don't copy in files that already exist - assume that the# files don't chnage without a chnage to the file name## Inputs :## Returns :#sub CopyInNew{## Ensure the output directory exists#if ( ! -d $opt_rootdir ){if ( defined($opt_test) ){Message("mkdir $opt_rootdir");}else{eval { mkpath($opt_rootdir) };Error("Failed to make project directory tree $opt_rootdir") if ( $@ || ! -d $opt_rootdir );}}## Determine the files to be transferred#my @filelist;foreach my $file ( keys %bomList){push (@filelist, $file) unless ( -f "$opt_rootdir/$file" );}## Perform the actual copy#if ( @filelist ){#Message("Copying files for package $PKG_NAME version $PKG_VERSION");if ( defined($opt_test) ){Message( map("$_...", @filelist) );}else{eval { mkpath($opt_rootdir) };Error("Failed to make destination directory") if ( $@ || ! -d $opt_rootdir );foreach my $file ( @filelist ){Verbose("Copy: $file...");my $srcFile = $bomList{$file};if ( ! copy($srcFile, $opt_rootdir) ){Warning("Failed to copy $file ($!)");}}}}}#-------------------------------------------------------------------------------# Function : RemoveExcess## Description : Remove excess files from the output directory## Inputs :## Returns :#sub RemoveExcess{my @filelist;## Find all files in the output directory# Use the 'filters' so that we don't pickup files that should# be in the directory. README.md, MANIFEST ...#foreach my $filter ( @confFilters ){foreach my $srcPath ( glob("$opt_rootdir/$filter") ){next unless ( -f $srcPath );my $dstFile = basename($srcPath);$dirList{$dstFile} = 1;push (@filelist, $dstFile) unless (exists $bomList{$dstFile} );}}if ( @filelist){Message ("Delete execess files", @filelist );unless ( defined($opt_test) ){foreach my $file ( @filelist ){Verbose("Delete: $file...");if ( unlink("$opt_rootdir/$file") ne 1 ){Warning("Failed to delete: $file. ($!)");}}}}}#-------------------------------------------------------------------------------# Function : RemoveDuplicates## Description : Scan the BOM file list and remove duplicate installers# Duplicate installers are that that have both a P and a D# flavor of the installer## This test has some nasty built-in knowledge (assumtions)# It assumes that:# Windows installers are only created for one flavor# Don't need to worry about windoes installers# Non windows installers are of the form:# Name_Architecture_Type.deb## Inputs :## Returns :#sub RemoveDuplicates{my %baseNames;foreach my $file ( keys %bomList){## Only process files that are of the expected form# ie: erg-udcrypt_1.0.3043.vss_UBUNTU16_P.deb#if( $file =~ m~(.*)_([PD])(\.(deb|rpm))$~ ){my $base=$1;my $type=$2;my $suf=$3;if (exists $baseNames{$base} ){my $debugName = $base . '_D' . $suf;Verbose("Remove debug installer: $file. Kill: $debugName");delete $bomList{$debugName};}$baseNames{$base} = $type;}}}#-------------------------------------------------------------------------------# Function : LoadFilterConfig## Description : Load Filter Config# Retain filter config for future reference## Inputs :## Returns :#sub LoadFilterConfig{if ( -f "$opt_rootdir/$CONFFILE" ){Message("Loading Config File");local $/;open(my $fh, "<$opt_rootdir/$CONFFILE") || Error("Failed to open config file");my $json_text = <$fh>;my $perl_scalar = decode_json( $json_text );Error ("Invalid format in Config file")unless (ref($perl_scalar->{filters}) eq 'ARRAY');push(@confFilters, @{$perl_scalar->{filters}});close($fh);}}#-------------------------------------------------------------------------------# Function : ProcessFilterArgs## Description : Process the filter based arguments## Inputs :## Returns :#sub ProcessFilterArgs{my $filterArgSeen;my $writeConf;if ( $#opt_filters > -1 && $#confFilters > -1 ){Message("Filters supplied on Command line", @opt_filters);Message("Filters in release configuration file", @confFilters);if ( !GetYesNo("Replace Config Filters with command line Filters, be careful as this may change the copy rules") ){Error("Script terminated by user.");}@confFilters = ();foreach my $element (@opt_filters) {UniquePush (\@confFilters, $_ ) foreach ( split(/,/, $element));}$writeConf = 1;$filterArgSeen = 1;}elsif ( $#opt_filters > -1 && $#confFilters == -1 ){Message("Filters supplied on Command line will be written to config file for release", @opt_filters);@confFilters = ();foreach my $element (@opt_filters) {UniquePush (\@confFilters, $_ ) foreach ( split(/,/, $element));}$writeConf = 1;}elsif ( $#opt_filters == -1 && $#confFilters > -1 ){Message("Filters loaded from config file for release will be used", @confFilters) if ( IsVerbose(1) );}elsif ( $#opt_filters == -1 && $#confFilters == -1 ){Error("No Filters supplied on command line or release config file");}if ( @opt_addFilters ){Message ("Adding command line filters to the release config file");foreach my $element (@opt_addFilters) {UniquePush (\@confFilters, $_ ) foreach ( split(/,/, $element));}$writeConf = 1;}if ( @opt_delFilters ){Message ("Deleting command line filters to the release config file");foreach my $element (@opt_delFilters) {ArrayDelete (\@confFilters, $_ ) foreach ( split(/,/, $element));}$writeConf = 1;}if ($opt_showfilters){Message ("Configured Filters",@confFilters );$filterArgSeen = 1;}## Save filter information#if ( $writeConf && ! defined($opt_test) ){Verbose ("Write config file");my $config;push @{$config->{filters}},@confFilters;FileCreate ("$opt_rootdir/$CONFFILE", to_json( $config, { ascii => 1, pretty => 1 }));}## Terminate program on any filter operations#exit 0 if ( $writeConf || $filterArgSeen);}#-------------------------------------------------------------------------------# Function : WriteManifest## Description : Save the filter config file if required## Inputs :## Returns :#sub WriteManifest{return if defined($opt_test);## Create JSON metadata#Verbose ("Write JSON Manifest");my $jsonString = to_json( $bomInfo, { ascii => 1, pretty => 1, canonical => 1 } );FileCreate ($opt_rootdir . '/MANIFEST.json', $jsonString);}# -------------------------------------------------------------------------sub GetYesNo## -------------------------------------------------------------------------{my ($question) = @_;my ($u_tmp) = "";Question ("$question, (default: y) [y,n]: ");while ( <STDIN> ){$u_tmp = $_;chomp($u_tmp);return 1if ( "$u_tmp" eq "" );if( $u_tmp =~ /[yn]{1}/i ){return ( "$u_tmp" eq "y" );}else{Question("Please re-enter response? (default: y) [y,n]: ");}}}#-------------------------------------------------------------------------------# Function : getSbomProjectAndRelease## Description : Get SBOM Meta Data# Ensure all BOMS are a part of the same project## Inputs :## Returns : Will exit on error#sub getSbomProjectAndRelease{my ( $DB, $sboms ) = @_;my ( $lastProj, $lastRel );Error("getSbomProjectAndRelease: SBom Parameter Error, must pass array") if ( ref($sboms) ne "ARRAY" );# create a hash of sbom values so we can test after if any sboms could not be foundmy %sbomIdx = map { $_ => 1 } @{$sboms};my $m_sqlstr = "SELECT boms.bom_id, dm_projects.proj_name, branches.branch_name " ."FROM deployment_manager.boms, deployment_manager.branches, deployment_manager.dm_projects " ."WHERE branches.branch_id = boms.branch_id AND " ." dm_projects.proj_id = branches.proj_id AND " ." boms.bom_id " . ( $#{$sboms} == 0 ? "= " . $sboms->[0] : "IN ( " . join(",", @{$sboms}) . ")" );my $sth = $DB->prepare($m_sqlstr);if ( defined($sth) ){if ( $sth->execute( ) ){if ( $sth->rows ){while ( my ( $bom, $proj, $rel ) = $sth->fetchrow_array ){if ( ! defined($proj) ){Error("getSbomProjectAndRelease: NULL Project Name from Deployment Manager Sbom : $bom");}elsif ( ! defined($rel) ){Error("getSbomProjectAndRelease: NULL Release Tag Name from Deployment Manager Sbom : $bom");}elsif ( defined($lastProj) && $proj ne $lastProj ){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");}elsif ( defined($lastRel) && $rel ne $lastRel ){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");}$lastProj = $proj;$lastRel = $rel;my $data;$data->{sbom_id} = $bom;$data->{project} = $proj;$data->{release} = $rel;push @{$bomInfo->{sbom}}, $data;# delete sbom from idx, any remaining after loop will indicate we have an sbom that could not founddelete($sbomIdx{$bom});}my @sbomsNotFound = keys %sbomIdx;if ( $#sbomsNotFound > -1 ){Error("getSbomProjectAndRelease: Could not find details for the following SBomId(s) " . join(",", @sbomsNotFound) );}}else{Error("getSbomProjectAndRelease: No SBom(s) found for Deployment Manager SBomId(s) " . join(",", @{$sboms}) );}$sth->finish();}else{Error("getSbomProjectAndRelease: Execute failure", $sth->errstr(), $m_sqlstr );}}else{Error("getSbomProjectAndRelease: Prepare failure", $sth->errstr(), $m_sqlstr );}}#-------------------------------------------------------------------------------# Function : GetSbomData## Description : Extract data from DM and RM based on the provided SBOM# Ignore 'Unbuildable package - These are DM Only artifacts## Inputs :## Returns :#sub GetSbomData{my $m_sqlstr = "SELECT packages.pkg_name, package_versions.pkg_version " ."FROM deployment_manager.bom_contents, " ." deployment_manager.network_nodes, " ." deployment_manager.os_contents, " ." deployment_manager.operating_systems, " ." release_manager.package_versions, " ." release_manager.packages " ."WHERE network_nodes.node_id = bom_contents.node_id AND " ." network_nodes.node_id = operating_systems.node_id AND " ." operating_systems.os_id = os_contents.os_id AND " ." os_contents.prod_id = package_versions.pv_id AND " ." package_versions.pkg_id = packages.pkg_id AND " ." package_versions.build_type != 'U' AND " ." bom_contents.bom_id " . ( $#opt_sbom_ids == 0 ? "= " . $opt_sbom_ids[0] : "IN ( " . join(",", @opt_sbom_ids) . ")" ) . " " ."GROUP BY packages.pkg_name, package_versions.pkg_version " ."ORDER BY packages.pkg_name ASC, package_versions.pkg_version ASC";my ( $PKG_NAME, $PKG_VERSION );my $sth = $DM_DB->prepare($m_sqlstr);if ( defined($sth) ){if ( $sth->execute( ) ){if ( $sth->rows ){while ( ( $PKG_NAME, $PKG_VERSION ) = $sth->fetchrow_array ){my $pkgDir = "$ENV{GBE_DPKG}/$PKG_NAME";my $srcDir = "$ENV{GBE_DPKG}/$PKG_NAME/$PKG_VERSION";my $dstDir = $opt_rootdir;if ( -d "$srcDir" ){my $foundFiltered = 0;# for each of the filter rules we glob the rule in the src pkg/version dir# and if any of the globbed files dont exist in the dst dir add it to the# the filelist array of files to copyforeach my $filter ( @confFilters ){foreach my $srcPath ( glob("$srcDir/$filter") ){next unless ( -f $srcPath );$foundFiltered = 1;$filtersUsed{$filter} = 1;my $dstFile = basename($srcPath);my $srcFile = $srcPath;$srcFile =~ s~^$srcDir/~~;$bomList{$srcFile} = $srcPath;}}# if no files found using filters then issue warningWarning("No Files found for Package Version $PKG_NAME/$PKG_VERSION using supplied filters")unless ( $foundFiltered );}elsif ( ! -d "$pkgDir" ){# if srcDir and pkgDir dont exist then package is not in dpkg_archive so display messageWarning("Skipping Package $PKG_NAME/$PKG_VERSION as it does not exist in dpkg_archive");}else{# However if srcDir does not exist but pkgDir does exist then the package version is missing which maybe an issueWarning("Missing Version $PKG_VERSION for Package $PKG_NAME in dpkg_archive");}}## Report filter elements that where not used.#my @notUsed;foreach my $filter ( @confFilters ){next if ( exists $filtersUsed{$filter} );push @notUsed, $filter}Warning ("Unused filter rules:", @notUsed )if ( @notUsed );}else{Error("No Boms found for Deployment Manager SBomId(s) " . join(",", @opt_sbom_ids) );}$sth->finish();}else{Error("Execute failure", $sth->errstr(), $m_sqlstr );}}else{Error("Prepare failure", $sth->errstr(), $m_sqlstr );}}#-------------------------------------------------------------------------------# Documentation#=pod=for htmltoc DEPLOY::generate_bom=head1 NAMEjats_generate_bom - Extracts current package version list from Deployment Manager SBom(s)and copy resultant packages to a specific directory.=head1 SYNOPSISjats generate_bom [options]Options:-help - brief help message-help -help - Detailed help message-man - Full documentation-sbomid=xxx - Specify the Deployment Manager SBom(s) to process- Can be specified multiple times to combine SBoms-rootdir=xxx - Specifies the root of the releases directory-showfilters - Display current filter set and exit-filter=xxx - Specifies a shell wildcard used to filter package files to copy- Can be specified multiple times to use multiple filters-addfilter=xxx - Add a new filter to the existing filter set-delfilter=xxx - Delete a filter from the existing filter set-test - Just log actions without copying files.-verbose - Enable verbose output=head1 OPTIONS=over 8=item B<-help>Print a brief help message and exits.=item B<-help -help>Print a detailed help message with an explanation for each option.=item B<-man>Prints the manual page and exits.=item B<-sbomid=xxx>This option specifies one or more SBOM_ID's to use as the source of packages that will be copied.The SBoms will be used to get a unique list of package/versions that can be copied from dpkg_archive.This option is Mandatory, for non-filter command, and a minimum of one SBom must be supplied. If more that one SBom issupplied then all Sbom Ids must be of the same project and release with in that project.=item B<-rootdir=xxx>This option specifies the root directory where the packages will be copied to.The specified directory must exist.The default value is the current directory.=item B<-showfilters>This option will display the current filter set. If it is combined with another filter operationthen the other operations will be performed before the display.=item B<-filter=xxx[,yyy]>This option specifies a comma separated list of shell wildcard filter rule thatis used to determine which files are copied from package version directory inGBE_DPKG to the release directory. This can be supplied multiple times tospecify rules for copying.This must be specified on the command line the first time this command is run against a releaseand packages are copied to the project/release directory. These values are then written to aconfig file in the project/release directory so the same values can be used on subsequent runs.In these subsequent runs this option need not be specified as the config items will be used, howeverthey can be changed by specifying them again on the command line and the config will be re-written.The values of these will depend on what builds are required for each project. Some examples are--filter='*-WIN32.exe,*.deb'=item B<-addFilter=xxx[,yyy]>This option allows new filters to be added to an existing set of filters. Thisoption can be specified multiple times.=item B<-delFilter=xxx[,yyy]>This option deletes one or more filter rules from an existing set of filters. Thisoption can be specified multiple times.=item B<-test>This option will display what would be copied without actually copying anything=item B<-verbose>This option will display progress information as the program executes.=back=head1 DESCRIPTIONThis program is used to update a Distribution 'bin' directory with the versions ofpackages as indicated by the specified Deployment Manager SBoms.There are two modes of operation: Filter modification operations and BOM creation.In 'Filter modification' mode the current filter set will be updated and the program willexit.In BOM creation mode an sbomid must be provided.The sbomid is used to get all the required information from Deployment Manager aboutwhich package version are required, as well as the project name and release name underwhich the Sboms are under.The sbomid option can be specified multiple times to copy packages from multiple SBomsto the Project Release directory. All Sboms that are specified must be under thesame Release under the same Project otherwise the script will abort.In addition to using Deployment Manager SBoms to determine which Package/Versions arerequired to be copied this script also uses a set of shell wildcard filters that areused to determine which files are actually copied when invoked.The filter rules can be supplied on the command line if available read from aconfiguration file saved in the output diretory the last time the script was runon this release directory.One or more filter rules must be specified on the command line the first time this commandis run against a project release directory. These filter values are then written to a configfile in the output directory so the same values can be used on subsequent runs.In subsequent runs the filter rules will be loaded from the config file and need not be specifiedon the command line, however the filter rules in the config file can be changed by specifyingthem again on the command line and the config will be re-written.=cut