Subversion Repositories DevTools

Rev

Rev 279 | Rev 285 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
227 dpurdie 1 
########################################################################
281 dpurdie 2 
# Copyright ( C ) 2009 ERG Limited, All rights reserved
227 dpurdie 3 
#
281 dpurdie 4 
# Module name   : escrow.pl
227 dpurdie 5 
# Module type   : Makefile system
281 dpurdie 6 
# Compiler(s)   : Perl
7 
# Environment(s): jats build system
227 dpurdie 8 
#
9 
# Description   : Determine packages from an SBOM for escrow purposes
10 
#                 For a given bom_id determine all used packages
11 
#                 Create various bits of useful information
12 
#                   Extract commands
13 
#                   Build Order
14 
#                   Depenendency Info
15 
#                   Bad Packages
16 
#
17 
#......................................................................#
18 
 
255 dpurdie 19 
require 5.006_001;
227 dpurdie 20 
use strict;
21 
use warnings;
22 
use JatsEnv;
23 
use JatsError;
24 
use JatsSystem;
25 
use JatsRmApi;
26 
use DBI;
27 
use Getopt::Long;
28 
use Pod::Usage;                             # required for help support
29 
use Storable qw (dclone);
30 
 
31 
#
32 
#   Config Options
33 
#
34 
my $VERSION = "1.0.0";              # Update this
35 
my $opt_help = 0;
36 
my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose
37 
my $opt_sbom_id;
38 
my $opt_rtag_id;
39 
my $opt_test = 0;
40 
my $opt_patch = 1;
41 
my $opt_extract;
233 dpurdie 42 
my $opt_rootpkg;
227 dpurdie 43 
 
44 
#
45 
#   Data Base Interface
46 
#
47 
my $RM_DB;
48 
my $DM_DB;
49 
 
50 
#
51 
#   Global variables
52 
#
53 
my %os_id_list;                 # os_id in the SBOM
54 
my %os_env_list;                # OS Environments
55 
my %pv_id;                      # Packages in the SBOM
56 
my %Package;                    # Per Package information
57 
my %Release;                    # Release information
58 
my %Release_pvid;               # Release info
59 
my @StrayPackages;              # Non-top level packages
60 
my @create_list;                # List of files created
61 
my $fpref = "sbom";             # Sbom Prefix
62 
our $GBE_RM_URL;
63 
our $GBE_DM_URL;
64 
 
65 
#
66 
#   Constants, that should be variable
67 
#
68 
my $rm_base = "/dependencies.asp?pv_id=";
69 
my $dm_base = "/OsDefault.asp?bom_id=BOMID&os_id=";
70 
 
71 
#
72 
#   Build types. Should be populated from a table
73 
#
74 
my %BM_ID = (
75 
    1 => "Solaris",
76 
    2 => "Win32",
77 
    3 => "Linux",
78 
    4 => "Generic",
79 
);
80 
 
81 
my %BSA_ID = (
82 
    1 => "Jats Debug",
83 
    2 => "Jats Prod",
84 
    3 => "Jats Debug+Prod",
85 
    4 => "Ant Java 1.4",
86 
    5 => "Ant Java 1.5",
87 
    6 => "Ant Java 1.6",
88 
);
89 
 
90 
#
91 
#   Packages to be ignored
92 
#
93 
my %ignore;
94 
my %patch;
95 
 
96 
 
97 
#-------------------------------------------------------------------------------
98 
# Function        : Main
99 
#
100 
# Description     : Main entry point
101 
#                   Parse user options
102 
#
103 
# Inputs          :
104 
#
105 
# Returns         :
106 
#
107 
 
108 
my $result = GetOptions (
281 dpurdie 109 
                "help:+"        => \$opt_help,              # flag, multiple use allowed
110 
                "manual:3"      => \$opt_help,              # flag, multiple use allowed
111 
                "verbose:+"     => \$opt_verbose,           # flag
227 dpurdie 112 
                "sbomid=s"      => \$opt_sbom_id,           # string
279 dpurdie 113 
                "sbom_id=s"     => \$opt_sbom_id,           # string
227 dpurdie 114 
                "rtagid=s"      => \$opt_rtag_id,           # string
279 dpurdie 115 
                "rtag_id=s"     => \$opt_rtag_id,           # string
233 dpurdie 116 
                "rootpackage=s" => \$opt_rootpkg,           # String
227 dpurdie 117 
                "ignore=s",     => sub{my ($a,$i) = @_; $ignore{$i} = 0 },
118 
                "test!"         => \$opt_test,              #[no]flag
119 
                "patch!"        => \$opt_patch,             #[no]flag
120 
                "extract=s"     => \$opt_extract,           # Name of file
121 
                );
122 
 
123 
#
124 
#   Process help and manual options
125 
#
126 
pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result);
127 
pod2usage(-verbose => 1)  if ($opt_help == 2 );
281 dpurdie 128 
pod2usage(-verbose => 2)  if ($opt_help > 2);
227 dpurdie 129 
 
130 
ErrorConfig( 'name'    => 'ESCROW',
131 
             'verbose' => $opt_verbose );
132 
 
133 
#
134 
#   Sanity test
135 
#
281 dpurdie 136 
unless ( $opt_rtag_id || $opt_sbom_id || $opt_extract || $#ARGV >= 1)
227 dpurdie 137 
{
138 
    Error ("Need sbomid and/or rtagid, or -extract",
139 
           "Example: -sbomid=13543, for NZS Phase-1",
140 
           "Example: -sbomid=13543 -rtagid=xxxx, for NZS Phase-1, comapred against given release",
141 
           "Example: -rtagid=2362, for Sydney R1/R2",
235 dpurdie 142 
           "Example: -rtagid=8843 -root=StockholmSBOM",
281 dpurdie 143 
           "Example: PackageName PackageVersion, for extracting a single package",
227 dpurdie 144 
    )
145 
}
146 
 
147 
#
148 
#   The extract option is special
149 
#   It places the progam in a different mode
150 
#
151 
if ( $opt_extract )
152 
{
153 
    Error ("Cannot mix -extract with sbomid or rtagid" )
281 dpurdie 154 
        if ( $opt_rtag_id || $opt_sbom_id || $#ARGV >= 0 );
227 dpurdie 155 
 
156 
    extract_files();
157 
    exit (0);
158 
}
159 
 
160 
Warning ("No sbomid provided. Output based an a Release") unless ( $opt_sbom_id );
161 
$dm_base =~ s~BOMID~$opt_sbom_id~ if ($opt_sbom_id);
162 
$fpref = "release" unless ( $opt_sbom_id );
163 
 
164 
#
165 
#   Import essential EnvVars
166 
#
167 
EnvImport('GBE_RM_URL');
168 
EnvImport('GBE_DM_URL');
169 
 
170 
$rm_base = $GBE_RM_URL . $rm_base;
171 
$dm_base = $::GBE_DM_URL . $dm_base;
172 
 
173 
if ( $opt_sbom_id )
174 
{
175 
    #
176 
    #   Determines the OS_ID's for the bom
177 
    #
178 
    getOSIDforBOMID($opt_sbom_id);
179 
 
180 
    #
181 
    #   Locate packages associated with the base install for each os
182 
    #
183 
    foreach my $base_env_id ( sort keys %os_env_list )
184 
    {
185 
        getPackagesforBaseInstall( $base_env_id );
186 
    }
187 
 
188 
    #
189 
    #   Determine all the top level packages in the BOM
190 
    #
191 
    foreach my $os_id ( sort keys %os_id_list )
192 
    {
193 
        getPackages_by_osid( $os_id );
194 
    }
195 
 
196 
    #
197 
    #   For each Top Level Package determine the dependent packages
198 
    #
281 dpurdie 199 
    getPkgDetailsForPVIDs (keys %pv_id);
227 dpurdie 200 
    LocateStrays();
201 
 
202 
    #
203 
    #   Determine packages in a given Release
204 
    #
205 
    if ( $opt_rtag_id )
206 
    {
207 
        getPkgDetailsByRTAG_ID( $opt_rtag_id );
208 
    }
209 
}
281 dpurdie 210 
elsif ( $opt_rtag_id )
227 dpurdie 211 
{
212 
    getPkgDetailsByRTAG_ID( $opt_rtag_id );
233 dpurdie 213 
    if ( $opt_rootpkg )
227 dpurdie 214 
    {
233 dpurdie 215 
        #
216 
        #   Base the report on a single package in a release
217 
        #   Determine the package
218 
        #
219 
        Error ("Root Package not found: $opt_rootpkg") unless ( exists $Release{$opt_rootpkg} );
220 
        my @root_vers = keys %{$Release{$opt_rootpkg}};
221 
        Error ("Multiple versions of Root Package: $opt_rootpkg", @root_vers ) if ( $#root_vers > 0 );
222 
        Message("Root Package: $opt_rootpkg, " . $root_vers[0]);
223 
 
224 
        getPkgDetailsByPV_ID( $Release{$opt_rootpkg}{$root_vers[0]}{pv_id} );
227 dpurdie 225 
    }
233 dpurdie 226 
    else
227 
    {
281 dpurdie 228 
        getPkgDetailsForPVIDs (keys %Release_pvid);
233 dpurdie 229 
    }
230 
    LocateStrays(1);
227 dpurdie 231 
}
281 dpurdie 232 
elsif ( $#ARGV >= 1 )
233 
{
234 
    #
235 
    #   Locate package and dependents
236 
    #   Convert package name into a PVID
237 
    #
238 
    my $pv_id = getPkgDetailsByName( @ARGV );
239 
    Error ("Cannot locate package by name and version: @ARGV")
240 
        unless ( $pv_id );
227 dpurdie 241 
 
281 dpurdie 242 
    #
243 
    #   Set package as the root package
244 
    $opt_rootpkg = $ARGV[0];
245 
    getPkgDetailsByPV_ID( $pv_id  );
246 
    LocateStrays(2);
247 
}
248 
else
249 
{
250 
    Error ("Don't know what to do with common line arguments provided");
251 
}
227 dpurdie 252 
 
281 dpurdie 253 
 
227 dpurdie 254 
#
255 
#   Remove packages to be ignored
256 
#
257 
foreach my $pkg ( keys %ignore )
258 
{
259 
    delete $Package{$pkg};
260 
}
261 
 
262 
##
263 
##   Display a list of all packages found so far
264 
##
265 
#foreach my $name ( sort keys %Package )
266 
#{
267 
#    foreach my $ver ( sort keys %{$Package{$name}} )
268 
#    {
269 
#
270 
#        my $label = $Package{$name}{$ver}{label} || '';
271 
#        my $path = $Package{$name}{$ver}{path} || '';
272 
#
273 
#        printf ("%30s %15s %45s %s\n", $name, $ver, $label, $path );
274 
#    }
275 
#}
276 
 
277 
#
278 
#   Generate output files
279 
#       1) Jats extract commands
280 
#       2) Error list
281 
my $file;
282 
$file = "${fpref}_extract.txt";
283 
push @create_list, $file;
284 
open (JE, ">$file" ) || Error ("Cannot create $file");
285 
 
286 
$file = "${fpref}_status.txt";
287 
push @create_list, $file;
288 
 
289 
open (ST, ">$file" ) || Error("Cannot create $file");
290 
print ST "Cannot build:\n";
291 
 
292 
foreach my $name ( sort keys %Package )
293 
{
294 
    foreach my $ver ( sort keys %{$Package{$name}} )
295 
    {
296 
 
297 
        my $label = $Package{$name}{$ver}{label} || '';
298 
        my $path = $Package{$name}{$ver}{path} || '';
299 
        my $mtest = exists ($Package{$name}{$ver}{build} ) || '0';
300 
        my @reason1;            # can't extract files
301 
        my @reason2;            # Others
302 
 
303 
        push @reason1, 'No Label' unless ( $label );
304 
        push @reason1, 'Bad Label, N/A' if ( $label =~ s~^N/A$~~i || $label  =~ s~^na$~~i );
305 
 
306 
        push @reason1, 'No Source Path' unless ( $path );
307 
        push @reason1, 'Bad Path, N/A' if ( $path =~ m~^N/A$~i || $path  =~ m~^na$~i );
308 
        push @reason1, 'Bad Path, dpkg' if ( $path =~ m~^/dpkg_archive~ || $path  =~ m~^dpkg_archive~ );
309 
        push @reason1, 'Bad Path, http' if ( $path =~ m~^http:~i );
310 
        push @reason1, 'Bad Path, Drive' if ( $path =~ m~^[A-Za-z]\:~ );
311 
        push @reason1, 'Bad Path, UNC' if ( $path =~ m~^//~ );
312 
        push @reason1, 'Bad Path, Relative' unless ( $path =~ m~^/~ );
313 
 
314 
 
315 
        push @reason2, 'No Build System' unless ( exists ($Package{$name}{$ver}{build} ) );
316 
 
317 
        unless ( @reason1 )
318 
        {
319 
            my $vname = "$name $ver";
320 
            $vname =~ s~ ~_~g;
321 
            $vname =~ s~__~~g;
322 
 
243 dpurdie 323 
            print JE "jats extract -extractfiles \"-view=$vname\" \"-label=$label\" \"-path=$path\" -root=. -noprefix\n";
227 dpurdie 324 
        }
325 
 
326 
        if ( @reason1 || @reason2 )
327 
        {
328 
            $Package{$name}{$ver}{bad_extract} = [@reason1, @reason2];
329 
            printf ST "%40s %20s %50s (%s) %s\n", $name, $ver, $label, $mtest, $path ;
330 
        }
331 
    }
332 
}
333 
 
334 
close (JE);
335 
close (ST);
336 
 
337 
#
338 
#   Generate build order info
339 
#
340 
BuildOrder();
341 
 
342 
#
343 
#   Generate HTML depenedancy information and other useful stuff
344 
#
345 
GenerateHTML();
241 dpurdie 346 
GenerateHTMLLodgement();
227 dpurdie 347 
 
348 
 
349 
#
350 
#   Display names of files created
351 
#
352 
foreach my $file ( sort @create_list )
353 
{
354 
    Message ("Created: $file");
355 
}
356 
exit;
357 
 
358 
 
359 
#-------------------------------------------------------------------------------
360 
# Function        : getOSIDforBOMID
361 
#
362 
# Description     : Get all the os_id's associated with a BOMID
363 
#
364 
# Inputs          : $bom_id             - BOM to process
365 
#
366 
# Returns         :
367 
#
368 
 
369 
sub getOSIDforBOMID
370 
{
371 
    my ($bom_id) = @_;
372 
    my $foundDetails = 0;
373 
    my (@row);
233 dpurdie 374 
Verbose ("getOSIDforBOMID");
227 dpurdie 375 
    connectDM(\$DM_DB) unless ($DM_DB);
376 
 
377 
    my $m_sqlstr = "SELECT distinct os.OS_ID, os.OS_NAME, nn.NODE_NAME, obe.BASE_ENV_ID " .
378 
                   " FROM OPERATING_SYSTEMS os, BOM_CONTENTS bc, NETWORK_NODES nn, OS_BASE_ENV obe" .
379 
                   " WHERE bc.BOM_ID = $bom_id AND bc.NODE_ID = os.NODE_ID AND nn.NODE_ID = os.NODE_ID AND obe.OS_ID = os.OS_ID ";
380 
 
381 
    my $sth = $DM_DB->prepare($m_sqlstr);
382 
    if ( defined($sth) )
383 
    {
384 
        if ( $sth->execute( ) )
385 
        {
386 
            if ( $sth->rows )
387 
            {
388 
                while ( @row = $sth->fetchrow_array )
389 
                {
390 
                    Verbose ("OS_ID: ".join (',',@row) );
391 
                    $os_id_list{$row[0]}{os_name} = $row[1];
392 
                    $os_id_list{$row[0]}{node_name} = $row[2];
393 
 
394 
                    $os_env_list{$row[3]}{needed} = 1;
395 
                    $os_env_list{$row[3]}{os_id}{$row[0]} = 1;
233 dpurdie 396 
 
397 
                    $foundDetails = 1;
227 dpurdie 398 
                }
399 
            }
400 
            $sth->finish();
401 
        }
233 dpurdie 402 
        else
403 
        {
404 
            Error("getOSIDforBOMID:Execute failure" );
405 
        }
227 dpurdie 406 
    }
407 
    else
408 
    {
409 
        Error("getOSIDforBOMID:Prepare failure" );
410 
    }
233 dpurdie 411 
 
412 
    Error("getOSIDforBOMID:No OS Information Found" ) unless $foundDetails;
413 
 
227 dpurdie 414 
}
415 
 
416 
#-------------------------------------------------------------------------------
417 
# Function        : getPackagesforBaseInstall
418 
#
419 
# Description     : Get all the packages for a given base install
420 
#
421 
# Inputs          :
422 
#
423 
# Returns         :
424 
#
425 
 
426 
sub getPackagesforBaseInstall
427 
{
428 
    my ($base_env_id) =@_;
429 
    my $foundDetails = 0;
430 
    my (@row);
431 
 
432 
    connectDM(\$DM_DB) unless ($DM_DB);
433 
 
434 
    # First get details from pv_id
435 
 
436 
    my $m_sqlstr = "SELECT DISTINCT bec.PROD_ID, pkg.pkg_name, pv.pkg_version, pkg.pkg_id, pv.pv_id" .
437 
                " FROM PACKAGES pkg, PACKAGE_VERSIONS pv,PRODUCT_DETAILS pd, BASE_ENV_CONTENTS bec".
438 
                " WHERE bec.BASE_ENV_ID = $base_env_id AND bec.PROD_ID (+)= pv.PV_ID AND pv.pkg_id = pkg.pkg_id";
439 
 
440 
    my $sth = $DM_DB->prepare($m_sqlstr);
441 
    if ( defined($sth) )
442 
    {
443 
        if ( $sth->execute( ) )
444 
        {
445 
            if ( $sth->rows )
446 
            {
447 
                while ( @row = $sth->fetchrow_array )
448 
                {
449 
                    Verbose ("OS ENV Package($base_env_id}:" . join (',',@row) );
450 
 
451 
                    my $pv_id =     $row[0];
452 
                    my $name =      $row[1]  || 'BadName';
453 
                    my $ver =       $row[2]  || 'BadVer';
454 
 
455 
                    $pv_id{$pv_id}{pkg_name} =$name;
456 
                    $pv_id{$pv_id}{pkg_ver} = $ver;
457 
                    foreach my $os_id ( keys %{$os_env_list{$base_env_id}{os_id}} )
458 
                    {
459 
                        $pv_id{$pv_id}{os_id}{$os_id} = 2;
460 
                    }
461 
                }
462 
            }
463 
            $sth->finish();
464 
        }
465 
        else
466 
        {
467 
            Error ("getPackagesforBaseInstall: Execute error");
468 
        }
469 
    }
470 
    else
471 
    {
472 
        Error("getPackagesforBaseInstall:Prepare failure" );
473 
    }
474 
 
475 
}
476 
 
477 
 
478 
#-------------------------------------------------------------------------------
479 
# Function        : getPackages_by_osid
480 
#
481 
# Description     : Get all the packages used by a given os_id
482 
#
483 
# Inputs          :
484 
#
485 
# Returns         :
486 
#
487 
 
488 
my $count = 0;
489 
sub getPackages_by_osid
490 
{
491 
    my ($os_id) =@_;
492 
    my $foundDetails = 0;
493 
    my (@row);
494 
 
495 
    connectDM(\$DM_DB) unless ($DM_DB);
496 
 
497 
    # First get details from pv_id
498 
 
499 
    my $m_sqlstr = "SELECT osc.*, pkg.pkg_name, pv.pkg_version, pd.IS_REJECTED, pv.IS_PATCH,pv.IS_OBSOLETE, pkg.pkg_id, pv.pv_id" .
500 
                " FROM PACKAGES pkg, PACKAGE_VERSIONS pv,PRODUCT_DETAILS pd,".
501 
	            "(" .
502 
		        " SELECT osc.seq_num, osc.prod_id".
503 
		        " FROM os_contents osc".
504 
		        " WHERE osc.os_id = $os_id" .
505 
	            " ) osc" .
506 
                " WHERE pd.PROD_ID (+)= pv.PV_ID" .
507 
                "   AND pv.pkg_id = pkg.pkg_id" .
508 
                "   AND osc.PROD_ID = pv.pv_id" .
509 
                " ORDER BY osc.SEQ_NUM desc" ;
510 
 
511 
    my $sth = $DM_DB->prepare($m_sqlstr);
512 
    if ( defined($sth) )
513 
    {
514 
        if ( $sth->execute( ) )
515 
        {
516 
            if ( $sth->rows )
517 
            {
518 
                while ( @row = $sth->fetchrow_array )
519 
                {
520 
next if ( $opt_test && ++$count > 2 );
521 
                    Verbose ("SBOM Package:".join (',',@row) );
522 
                    my $pv_id =     $row[8];
523 
                    my $name =      $row[2]  || 'BadName';
524 
                    my $ver =       $row[3]  || 'BadVer';
525 
 
526 
                    $pv_id{$pv_id}{pkg_name} =$name;
527 
                    $pv_id{$pv_id}{pkg_ver} = $ver;
528 
                    $pv_id{$pv_id}{os_id}{$os_id} = 1;
529 
                }
530 
            }
531 
            $sth->finish();
532 
        }
533 
    }
534 
    else
535 
    {
536 
        Error("getPackages_by_osid:Prepare failure" );
537 
    }
538 
}
539 
 
540 
#-------------------------------------------------------------------------------
541 
# Function        : getPkgDetailsByPV_ID
542 
#
543 
# Description     : Populate the Packages structure given a PV_ID
544 
#                   Called for each package in the SBOM
545 
#
546 
# Inputs          : PV_ID           - Package Unique Identifier
547 
#
548 
# Returns         : Populates Package
549 
#
550 
sub getPkgDetailsByPV_ID
551 
{
552 
    my ($PV_ID) = @_;
553 
    my $foundDetails = 0;
554 
    my (@row);
555 
 
556 
    connectRM(\$RM_DB) unless ($RM_DB);
557 
 
558 
    # First get details from pv_id
559 
 
241 dpurdie 560 
    my $m_sqlstr = "SELECT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION, pv.PKG_LABEL, pv.SRC_PATH, pv.IS_DEPLOYABLE, pbi.BSA_ID, pbi.BM_ID, PV_DESCRIPTION" .
227 dpurdie 561 
                    " FROM PACKAGE_VERSIONS pv, PACKAGES pkg, PACKAGE_BUILD_INFO pbi" .
562 
                    " WHERE pv.PV_ID = \'$PV_ID\' AND pv.PKG_ID = pkg.PKG_ID AND pv.PV_ID = pbi.PV_ID (+) ";
563 
 
564 
    my $sth = $RM_DB->prepare($m_sqlstr);
565 
    if ( defined($sth) )
566 
    {
567 
        if ( $sth->execute( ) )
568 
        {
569 
            if ( $sth->rows )
570 
            {
571 
                while ( @row = $sth->fetchrow_array )
572 
                {
573 
                    my $pv_id       = $row[0];
574 
                    my $name        = $row[1];
575 
                    my $ver         = $row[2];
576 
                    my $label       = $row[3] || '';
577 
                    my $path        = $row[4] || '';
578 
                    my $deployable  = $row[5];
579 
                    my $build_info  = $row[6] || '';
580 
                    my $build_mach  = $row[7] || '';
241 dpurdie 581 
                    my $description = $row[8] || '';
227 dpurdie 582 
 
583 
                    #
584 
                    #   BSA_ID: 1:debug, 2:prod, 3:debug+prod, 4:Java1.4 5: Java 1.5
585 
                    #   BM_ID : 1:solaris, 2:win32, 3: linux, 4:generic
586 
                    #
587 
 
588 
 
589 
                    #
590 
                    #   Does it look like a patch
591 
                    #   We may want to ignore it.
592 
                    #
593 
                    my $patch = "";
594 
                    unless ( $opt_patch )
595 
                    {
596 
                        if ( $ver =~ m~\.p\d+.\w+$~ )
597 
                        {
598 
                            $patch = "Patch";
599 
                            $patch{$name} = 0
600 
                                unless (  exists $patch{$name} );
601 
                            $patch{$name}++;
602 
                        }
603 
                    }
604 
                    Verbose ("getPkgDetailsByPV_ID: $PV_ID, $name, $ver, $build_mach ,$build_info, $patch");
605 
                    next if ( $patch );
606 
 
607 
 
608 
                    if ( exists $ignore{$name} )
609 
                    {
610 
                        Verbose2( "    Ignoring: $PV_ID, $name, $ver, $build_mach ,$build_info, $patch\n");
611 
                        $ignore{$name}++;
612 
                        last;
613 
                    }
614 
 
229 dpurdie 615 
                    $path =~ tr~\\/~/~;
227 dpurdie 616 
 
617 
                    $Package{$name}{$ver}{pvid} = $PV_ID;
618 
                    $Package{$name}{$ver}{done} = 1;
619 
                    $Package{$name}{$ver}{base} = 1;
620 
                    $Package{$name}{$ver}{deployable} = 1 if ($deployable);
621 
                    $Package{$name}{$ver}{label} = $label;
622 
                    $Package{$name}{$ver}{path} = $path;
623 
                    $Package{$name}{$ver}{build}{$build_mach} = $build_info if $build_mach;
241 dpurdie 624 
                    $Package{$name}{$ver}{description} = $description;
227 dpurdie 625 
 
626 
                    GetDepends( $pv_id, $name, $ver );
627 
 
628 
                }
629 
            }
630 
            else
631 
            {
632 
                Warning ("No Package details for: PVID: $PV_ID");
633 
            }
634 
            $sth->finish();
635 
        }
636 
        else
637 
        {
638 
            Error("getPkgDetailsByPV_ID: Execute failure", $m_sqlstr );
639 
        }
640 
    }
641 
    else
642 
    {
643 
        Error("Prepare failure" );
644 
    }
645 
}
646 
 
647 
#-------------------------------------------------------------------------------
281 dpurdie 648 
# Function        : getPkgDetailsByName
649 
#
650 
# Description     : Determine the PVID for a given package name and version
651 
#
652 
# Inputs          : $pname          - Package name
653 
#                   $pver           - Package Version
654 
#
655 
# Returns         :
656 
#
657 
 
658 
sub getPkgDetailsByName
659 
{
660 
    my ($pname, $pver) = @_;
661 
    my $pv_id;
662 
    my (@row);
663 
 
664 
    connectRM(\$RM_DB) unless ($RM_DB);
665 
 
666 
    # First get details for a given package version
667 
 
668 
    my $m_sqlstr = "SELECT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION" .
669 
                    " FROM PACKAGE_VERSIONS pv, PACKAGES pkg" .
670 
                    " WHERE pkg.PKG_NAME = \'$pname\' AND pv.PKG_VERSION = \'$pver\' AND pv.PKG_ID = pkg.PKG_ID";
671 
    my $sth = $RM_DB->prepare($m_sqlstr);
672 
    if ( defined($sth) )
673 
    {
674 
        if ( $sth->execute( ) )
675 
        {
676 
            if ( $sth->rows )
677 
            {
678 
                while ( @row = $sth->fetchrow_array )
679 
                {
680 
                    $pv_id = $row[0];
681 
                    my $name = $row[1];
682 
                    my $ver = $row[2];
683 
                    Verbose( "getPkgDetailsByName :PV_ID= $pv_id");
684 
                }
685 
            }
686 
            $sth->finish();
687 
        }
688 
    }
689 
    else
690 
    {
691 
        Error("Prepare failure" );
692 
    }
693 
    return $pv_id;
694 
}
695 
 
696 
#-------------------------------------------------------------------------------
697 
# Function        : getPkgDetailsForPVIDs
698 
#
699 
# Description     : Get all package details by PVID, from a list of PVIDs
700 
#
701 
# Inputs          : List of PVID's to process
702 
#
703 
# Returns         : Nothing
704 
#
705 
sub getPkgDetailsForPVIDs
706 
{
707 
 
708 
    my $count = 0;
709 
    foreach my $pv_id ( @_ )
710 
    {
711 
        next if ( $opt_test && ++$count > 2 );
712 
        getPkgDetailsByPV_ID( $pv_id);
713 
    }
714 
}
715 
 
716 
#-------------------------------------------------------------------------------
227 dpurdie 717 
# Function        : GetDepends
718 
#
719 
# Description     : Extract the dependancies for a given package version
720 
#
721 
# Inputs          : $pvid
722 
#
723 
# Returns         :
724 
#
725 
sub GetDepends
726 
{
727 
    my ($pv_id, $pname, $pver ) = @_;
728 
 
729 
    connectRM(\$RM_DB) unless ($RM_DB);
730 
 
731 
    #
732 
    #   Now extract the package dependacies
733 
    #
734 
    my $m_sqlstr = "SELECT pkg.PKG_NAME, pv.PKG_VERSION, pd.DPV_ID" .
735 
                   " FROM PACKAGE_DEPENDENCIES pd, PACKAGE_VERSIONS pv, PACKAGES pkg" .
736 
                   " WHERE pd.PV_ID = \'$pv_id\' AND pd.DPV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID";
737 
    my $sth = $RM_DB->prepare($m_sqlstr);
738 
    if ( defined($sth) )
739 
    {
740 
        if ( $sth->execute( ) )
741 
        {
742 
            if ( $sth->rows )
743 
            {
744 
                my %depends;
745 
                while ( my @row = $sth->fetchrow_array )
746 
                {
747 
#print "$pname $pver ===== @row\n";
748 
                    my $name = $row[0];
749 
                    my $ver = $row[1];
750 
 
751 
                    Verbose2( "       Depends: $name, $ver");
752 
 
753 
                    $depends{$name,$ver} = 1;
754 
                    $Package{$name}{$ver}{usedby}{$pname,$pver} = 1;
755 
 
756 
                    unless ( exists $Package{$name}{$ver}{done} )
757 
                    {
758 
                        my @DATA = ($name, $ver, $row[2]);
759 
                        push @StrayPackages, \@DATA;
760 
                    }
761 
                }
762 
                $Package{$pname}{$pver}{depends} = \%depends;
763 
            }
764 
            $sth->finish();
765 
        }
766 
    }
767 
    else
768 
    {
769 
        Error("GetDepends:Prepare failure" );
770 
    }
771 
}
772 
 
773 
#-------------------------------------------------------------------------------
774 
# Function        : getPkgDetailsByRTAG_ID
775 
#
233 dpurdie 776 
# Description     : Extract all the packages for a given rtag_id
227 dpurdie 777 
#
778 
# Inputs          : RTAG_ID
779 
#
780 
# Returns         :
781 
#
782 
 
783 
sub getPkgDetailsByRTAG_ID
784 
{
233 dpurdie 785 
    my ($RTAG_ID) = @_;
227 dpurdie 786 
    my $foundDetails = 0;
787 
    my (@row);
788 
 
789 
    connectRM(\$RM_DB);
790 
 
791 
    # First get details from pv_id
792 
 
793 
    my $m_sqlstr = "SELECT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION".
794 
                   " FROM RELEASE_CONTENT rc, PACKAGE_VERSIONS pv, PACKAGES pkg" .
795 
                   " WHERE rc.RTAG_ID = $RTAG_ID AND rc.PV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID";
796 
    my $sth = $RM_DB->prepare($m_sqlstr);
797 
    if ( defined($sth) )
798 
    {
799 
        if ( $sth->execute( ) )
800 
        {
801 
            if ( $sth->rows )
802 
            {
803 
                while ( @row = $sth->fetchrow_array )
804 
                {
805 
                    my $pv_id   = $row[0];
806 
                    my $name    = $row[1];
807 
                    my $ver     = $row[2];
808 
                    Verbose ("getPkgDetailsByRTAG_ID: $RTAG_ID, $name, $ver, $pv_id");
809 
 
810 
                    $Release{$name}{$ver}{pv_id} = $pv_id;
811 
                    $Release_pvid{$pv_id} = 1;
812 
                }
813 
            }
814 
            $sth->finish();
815 
        }
816 
    }
817 
    else
818 
    {
819 
        Error("getPkgDetailsByRTAG_ID:Prepare failure" );
820 
    }
821 
}
822 
 
823 
 
824 
#-------------------------------------------------------------------------------
825 
# Function        : LocateStrays
826 
#
827 
# Description     : Locate stray packages
828 
#                   These are packages that have not been defined by the
829 
#                   top level SBOM. These are not really stray
830 
#
281 dpurdie 831 
# Inputs          : $mode           2: No stray tagging
832 
#                                   0: Mark all as stray
833 
#                                   1: Don't mark packages as stray
834 
#                                      if they are in releases hash
835 
# Returns         : Nothing
227 dpurdie 836 
#
837 
sub LocateStrays
838 
{
233 dpurdie 839 
    my ($mode) = @_;
227 dpurdie 840 
    while ( $#StrayPackages >= 0 )
841 
    {
842 
        my $DATA = pop @StrayPackages;
843 
        my $name = $DATA->[0];
844 
        my $ver = $DATA->[1];
845 
        my $pv_id = $DATA->[2];
846 
 
847 
        next if ( exists $Package{$name}{$ver}{done} );
848 
        getPkgDetailsByPV_ID ( $pv_id );
281 dpurdie 849 
 
850 
        next if ( $mode > 1 );
233 dpurdie 851 
        if ( $mode )
852 
        {
853 
            next if ( exists $Release{$name}{$ver} );
854 
        }
227 dpurdie 855 
        $Package{$name}{$ver}{stray} = 1;
233 dpurdie 856 
#print "Stray: $pv_id, $name, $ver\n";
227 dpurdie 857 
    }
858 
}
859 
 
860 
#-------------------------------------------------------------------------------
861 
# Function        : BuildOrder
862 
#
863 
# Description     : Determine the order to build packages
864 
#
865 
# Inputs          :
866 
#
867 
# Returns         :
868 
#
869 
sub BuildOrder
870 
{
871 
    foreach my $name ( keys %Package )
872 
    {
873 
        foreach my $ver ( keys %{$Package{$name}} )
874 
        {
875 
            AddToBuildList( $name, $ver, $Package{$name}{$ver}{depends} );
876 
        }
877 
    }
878 
 
879 
    DetermineBuildOrder();
880 
}
881 
 
882 
#-------------------------------------------------------------------------------
883 
# Function        : AddToBuildList
884 
#
885 
# Description     : Add packages to a build list
886 
#
887 
# Inputs          : PackageName
888 
#                   PackageVersion
889 
#                   Hash of dependancies
890 
#
891 
# Returns         :
892 
#
893 
my %BuildList;
894 
sub AddToBuildList
895 
{
896 
    my ($name, $ver, $pdepends ) = @_;
897 
 
898 
    Warning ("Duplicate Package to build: $name, $ver") if exists $BuildList{$name,$ver};
899 
 
900 
    #
901 
    #   Clone dependancies as we will destroy the list as we process data
902 
    #
903 
    my $ref;
904 
    $ref = dclone ($pdepends ) if $pdepends;
905 
    $BuildList{$name,$ver}{depends} = $ref;
906 
}
907 
 
908 
#-------------------------------------------------------------------------------
909 
# Function        : DetermineBuildOrder
910 
#
911 
# Description     : Determine the build order
912 
#
913 
# Inputs          :
914 
#
915 
# Returns         :
916 
#
917 
sub DetermineBuildOrder
918 
{
919 
 
920 
    my $file = "${fpref}_buildinfo.txt";
921 
    push @create_list, $file;
922 
 
923 
    open (BI, ">$file" )  || Error ("Cannot create $file");
924 
 
925 
#    DebugDumpData ("BuildList", \%BuildList); exit 1;
926 
 
927 
    my $more = 1;
928 
    my $level = 0;
929 
    while ( $more )
930 
    {
931 
        my @build;
932 
        $level ++;
933 
        $more = 0;
934 
        foreach my $key ( keys %BuildList )
935 
        {
936 
            #
937 
            #   Locate packges with no dependencies left
938 
            #
939 
            next if ( keys %{$BuildList{$key}{depends}} );
940 
            push @build, $key;
941 
        }
942 
 
943 
        foreach my $build ( @build )
944 
        {
945 
            $more = 1;
946 
            delete $BuildList{$build};
947 
            my ($name, $ver) = split $;, $build;
948 
 
949 
            my $label = $Package{$name}{$ver}{label} || '';
950 
            my $path  = $Package{$name}{$ver}{path} || '';
951 
            $Package{$name}{$ver}{buildorder}  = $level;
952 
 
953 
            printf BI "Build(%2d): %40s %15s %-55s %s\n", $level, $name, $ver, $label, $path;
954 
        }
955 
 
956 
        #
957 
        #   Delete dependencies
958 
        #
959 
        foreach my $key ( keys %BuildList )
960 
        {
961 
            foreach my $build ( @build )
962 
            {
963 
                delete $BuildList{$key}{depends}->{$build};
964 
            }
965 
        }
966 
    }
967 
    close BI;
968 
}
969 
 
970 
#-------------------------------------------------------------------------------
971 
# Function        : GenerateHTML
972 
#
973 
# Description     : Generate Dependency information
974 
#                   Generate a nive HTML dependancy table
975 
#                   Shows DependOn and UsedBy
976 
# Inputs          :
977 
#
978 
# Returns         :
979 
#
980 
 
237 dpurdie 981 
sub th
982 
{
983 
    my ($text, $span) = @_;
984 
 
985 
    my $string = '<th style="vertical-align: top;"';
986 
    $string .= " colspan=\"$span\"" if ( $span );
987 
    $string .= '>' . $text . '</th>' . "\n";
988 
    return $string;
989 
}
990 
 
991 
sub thl
992 
{
993 
    my ($text, $span) = @_;
994 
 
995 
    my $string = '<th style="text-align: left;"';
996 
    $string .= " colspan=\"$span\"" if ( $span );
997 
    $string .= '>' . $text . '</th>' . "\n";
998 
    return $string;
999 
}
1000 
 
1001 
 
227 dpurdie 1002 
sub GenerateHTML
1003 
{
1004 
    my $td = '<td style="vertical-align: top;">' . "\n";
1005 
    my $tdr = '<td style="text-align: right;">';
1006 
 
1007 
    my $file = "${fpref}_depends.html";
1008 
    push @create_list, $file;
1009 
    open (DP, ">$file" )  || Error ("Cannot create $file");
1010 
 
1011 
    #
1012 
    #   Generate an index
1013 
    #
1014 
    print DP "<dl><dt><h1>Index</h1></dt>\n";
1015 
    print DP "<dd><a href=\"#Ignore\">Ignored Packages</a></dd>\n";
1016 
    print DP "<dd><a href=\"#Depend\">Dependency Info</a></dd>\n";
1017 
    print DP "<dd><a href=\"#Multi\">Multiple Package Version</a></dd>\n";
233 dpurdie 1018 
    print DP "<dd><a href=\"#Leaf\">Packages that have no parents</a></dd>\n";
227 dpurdie 1019 
    print DP "<dd><a href=\"#NoBuild\">Packages that cannot be built</a></dd>\n";
237 dpurdie 1020 
    print DP "<dd><a href=\"#Excess\">Excess Packages from Release: $opt_rtag_id</a></dd>\n" if ( $opt_rtag_id && ($opt_sbom_id || $opt_rootpkg ));
1021 
    print DP "<dd><a href=\"#Stray\">Required Packages, not part of the release</a></dd>\n" if ( $opt_rtag_id && ! ($opt_sbom_id || $opt_rootpkg) );
227 dpurdie 1022 
    print DP "<dd><a href=\"#Inconsistent\">Packages in the Release, with inconsistent dependencies</a></dd>\n" if ( $opt_rtag_id && !$opt_sbom_id );
1023 
 
1024 
    print DP "</dl>\n";
1025 
 
1026 
    #
1027 
    #   Ignored Packages
1028 
    #
1029 
    print DP "<h1><a name=\"Ignore\">Ignored Packages</a></h1>\n";
1030 
 
1031 
    print DP "The following package, and all dependents, have been ignored.<br><br>\n";
1032 
 
1033 
    foreach my $name ( sort keys %ignore )
1034 
    {
1035 
        print DP "$name: $ignore{$name} versions<br>\n";
1036 
    }
1037 
 
1038 
    unless ( $opt_patch )
1039 
    {
1040 
        print DP "The following package have patches that have been ignored.<br><br>\n";
1041 
        foreach my $name ( sort keys %patch )
1042 
        {
1043 
            print DP "$name: $patch{$name} patches<br>\n";
1044 
        }
1045 
    }
1046 
 
1047 
    #
1048 
    #   Dependency Information
1049 
    #
1050 
    print DP "<h1><a name=\"Depend\">Dependency Info</a></h1>\n";
1051 
 
1052 
    print DP "<table border=\"1\"><tbody>\n";
1053 
    print DP "<tr>\n";
237 dpurdie 1054 
    print DP th("Package Dependency");
1055 
    print DP th("Package Used by");
1056 
    print DP th("Build Info");
227 dpurdie 1057 
    print DP "</tr>\n";
237 dpurdie 1058 
    my $package_count = 0;
227 dpurdie 1059 
    foreach my $name ( sort keys %Package )
1060 
    {
1061 
        foreach my $ver ( sort keys %{$Package{$name}} )
1062 
        {
1063 
            print DP "<tr>\n";
237 dpurdie 1064 
            $package_count++;
227 dpurdie 1065 
            #
1066 
            #   Depends On info
1067 
            #
1068 
 
1069 
            print DP $td;
1070 
            my $anchor= "${name}_${ver}";
1071 
            my $tag = "usedby_${name}_${ver}";
1072 
            printf  DP "<dl><dt><a name=\"$anchor\"></a><a href=\"#$tag\">%s&nbsp;%s</a> Depends on:</dt>\n", $name, $ver;
1073 
            foreach my $depend ( sort keys %{$Package{$name}{$ver}{depends}} )
1074 
            {
1075 
                my ($dname, $dver) = split $;, $depend;
1076 
                my $tag = "${dname}_${dver}";
1077 
                printf  DP "    <dd><a href=\"#$tag\">%s&nbsp;%s</a></dd>\n", $dname, $dver;
1078 
            }
1079 
            print DP "</dl>\n";
1080 
            print DP "</td>\n";
1081 
 
1082 
 
1083 
            #
1084 
            #   Used By information
1085 
            #
1086 
            print DP $td;
1087 
            $anchor= "usedby_${name}_${ver}";
1088 
            $tag = "${name}_${ver}";
1089 
            printf  DP "<dl><dt><a name=\"$anchor\"></a><a href=\"#$tag\">%s&nbsp;%s</a> Used by:</dt>\n", $name, $ver;
1090 
            foreach my $depend ( sort keys %{$Package{$name}{$ver}{usedby}} )
1091 
            {
1092 
                my ($dname, $dver) = split $;, $depend;
1093 
                my $tag = "usedby_${dname}_${dver}";
1094 
                printf  DP "    <dd><a href=\"#$tag\">%s&nbsp;%s</a></dd>\n", $dname, $dver;
1095 
            }
1096 
            print DP "</dl>\n";
1097 
            print DP "</td>\n";
1098 
 
1099 
            #
1100 
            #   Build Info
1101 
            #
1102 
            print DP $td;
1103 
            print DP "<table>";
1104 
            my $stray = ( exists ($Package{$name}{$ver}{stray}) && $Package{$name}{$ver}{stray} );
1105 
 
1106 
            my $pv_id = $Package{$name}{$ver}{pvid} || 'No PVID';
1107 
            my $pv_id_ref = $rm_base . $pv_id;
1108 
               $pv_id_ref .= "&rtag_id=" . $opt_rtag_id if ($opt_rtag_id && !$stray);
233 dpurdie 1109 
            my $pv_id_str = "<a href=\"$pv_id_ref\" TARGET=\"_blank\">$pv_id</a>";
227 dpurdie 1110 
 
1111 
            printf DP "<tr>${tdr}Pvid:</td><td>%s</td></tr>\n", $pv_id_str;
1112 
            printf DP "<tr>${tdr}Label:</td><td>%s</td></tr>\n", $Package{$name}{$ver}{label} || 'NoneProvided';
1113 
            printf DP "<tr>${tdr}Path:</td><td>%s</td></tr>\n", $Package{$name}{$ver}{path}  || 'NoneProvided';
1114 
 
1115 
            my $order = 'Not Built';
1116 
            my @machs;
1117 
 
1118 
            if ( exists($Package{$name}{$ver}{build}) )
1119 
            {
1120 
                $order = $Package{$name}{$ver}{buildorder};
1121 
                @machs = sort keys %{$Package{$name}{$ver}{build}};
1122 
            }
1123 
            else
1124 
            {
1125 
                my $tag = "notbuilt_${name}_${ver}";
1126 
                $order = "<a href=\"#$tag\">Not Built</a>"
1127 
            }
1128 
 
1129 
            printf DP "<tr>${tdr}Build Order:</td><td>%s</td></tr>\n", $order;
1130 
 
1131 
            my $text = "Build:";
1132 
            foreach my $mach ( @machs )
1133 
            {
1134 
                my $type = $Package{$name}{$ver}{build}{$mach};
1135 
                printf DP "<tr>${tdr}$text</td><td>%s&nbsp;%s</td></tr>\n", $BM_ID{$mach} || "Unknown, $mach", $BSA_ID{$type} || 'Unknown';
1136 
                $text = '';
1137 
            }
1138 
 
1139 
            my $pvid = $Package{$name}{$ver}{pvid};
1140 
            $text = "Deployed:";
1141 
            foreach my $osid ( sort keys %{ $pv_id{$pvid}{os_id}  } )
1142 
            {
1143 
                my $os_name = $os_id_list{$osid}{os_name};
1144 
                my $node =    $os_id_list{$osid}{node_name};
1145 
 
1146 
                my $ref = $dm_base . $osid;
1147 
                my $str = "<a href=\"$ref\">$node,($os_name)</a>";
1148 
 
1149 
 
1150 
                printf DP "<tr>${tdr}$text</td><td>$str</td></tr>\n";
1151 
                $text = '';
1152 
            }
1153 
 
1154 
            if ( $stray )
1155 
            {
1156 
                printf DP "<tr>${tdr}Stray:</td><td>Package included indirectly</td></tr>\n";
1157 
            }
1158 
 
1159 
 
1160 
 
1161 
            print DP "</table>";
1162 
            print DP "</td>\n";
1163 
 
1164 
            #
1165 
            #   End of Row
1166 
            #
1167 
            print DP "</tr>\n";
1168 
        }
1169 
    }
237 dpurdie 1170 
    print DP "<tr>\n";
1171 
    print DP thl("Total Count: $package_count", 3);
1172 
    print DP "</tr>\n";
1173 
 
227 dpurdie 1174 
    print DP "</tbody></table>\n";
1175 
 
1176 
 
1177 
    #
1178 
    #   Multiple versions of a package
1179 
    #
1180 
    print DP "<h1><a name=\"Multi\">Multiple Package Versions</a></h1>\n";
1181 
    print DP "<table border=\"1\"><tbody>\n";
1182 
    print DP "<tr>\n";
237 dpurdie 1183 
    print DP th("Multiple Versions");
227 dpurdie 1184 
    print DP "</tr>\n";
237 dpurdie 1185 
    my $multiple_count = 0;
227 dpurdie 1186 
    foreach my $name ( sort keys %Package )
1187 
    {
1188 
        my @versions = keys %{$Package{$name}};
1189 
        next unless ( $#versions > 0 );
237 dpurdie 1190 
        $multiple_count++;
227 dpurdie 1191 
        print DP "<tr>\n";
1192 
        print DP $td;
1193 
        printf  DP "<dl><dt>$name</a> Versions:<dt>\n";
1194 
 
1195 
        foreach my $ver ( sort @versions )
1196 
        {
1197 
            my $tag = "${name}_${ver}";
1198 
            printf  DP "    <dd>";
1199 
            printf  DP "<a href=\"#$tag\">%s&nbsp;%s</a>\n", $name, $ver;
1200 
            print   DP " - Not in Release" if ($opt_rtag_id && $Package{$name}{$ver}{stray});
1201 
            printf  DP "</dd>\n", $name, $ver;
1202 
        }
1203 
        print DP "</dl>\n";
1204 
        print DP "</td>\n";
1205 
        print DP "</tr>\n";
1206 
    }
237 dpurdie 1207 
    print DP "<tr>\n";
1208 
    print DP thl("Total Count: $multiple_count");
1209 
    print DP "</tr>\n";
1210 
 
227 dpurdie 1211 
    print DP "</tbody></table>\n";
1212 
 
1213 
 
1214 
    #
233 dpurdie 1215 
    #   Leaf Packages
1216 
    #
1217 
    print DP "<h1><a name=\"Leaf\">Packages that have no parents</a></h1>\n";
1218 
    print DP "<table border=\"1\"><tbody>\n";
1219 
    print DP "<tr>\n";
237 dpurdie 1220 
    print DP th("Leaf Packages");
233 dpurdie 1221 
    print DP "</tr>\n";
237 dpurdie 1222 
    my $leaf_count = 0;
233 dpurdie 1223 
    foreach my $name ( sort keys %Package )
1224 
    {
1225 
        foreach my $ver ( sort keys %{$Package{$name}} )
1226 
        {
1227 
            my @usedby = keys %{$Package{$name}{$ver}{usedby}};
1228 
            next if ( @usedby );
237 dpurdie 1229 
            $leaf_count++;
233 dpurdie 1230 
 
1231 
            print DP "<tr>\n";
1232 
            print DP $td;
1233 
 
1234 
            my $tag = "${name}_${ver}";
1235 
 
1236 
            printf  DP "<dt><a href=\"#$tag\">%s&nbsp;%s</a>\n", $name, $ver;
1237 
 
1238 
            print DP "</td>\n";
1239 
            print DP "</tr>\n";
1240 
        }
1241 
    }
237 dpurdie 1242 
    print DP "<tr>\n";
1243 
    print DP thl("Total Count: $leaf_count");
1244 
    print DP "</tr>\n";
233 dpurdie 1245 
    print DP "</tbody></table>\n";
1246 
 
1247 
 
1248 
 
1249 
    #
227 dpurdie 1250 
    #   Packages that cannot be built
1251 
    #
1252 
    print DP "<h1><a name=\"NoBuild\">Packages that cannot be built</a></h1>\n";
1253 
    print DP "<table border=\"1\"><tbody>\n";
1254 
    print DP "<tr>\n";
237 dpurdie 1255 
    print DP th("Not Built");
227 dpurdie 1256 
    print DP "</tr>\n";
233 dpurdie 1257 
    my $no_build_count = 0;
227 dpurdie 1258 
 
1259 
    foreach my $name ( sort keys %Package )
1260 
    {
1261 
        my @versions = keys %{$Package{$name}};
1262 
        foreach my $ver ( sort @versions )
1263 
        {
1264 
            next unless exists($Package{$name}{$ver}{bad_extract});
233 dpurdie 1265 
            $no_build_count++;
227 dpurdie 1266 
            my @reasons = @{$Package{$name}{$ver}{bad_extract}};
1267 
 
1268 
            print DP "<tr><dl>\n";
1269 
            print DP $td;
1270 
 
1271 
            my $tag = "${name}_${ver}";
1272 
            my $anchor = "notbuilt_${name}_${ver}";
1273 
 
1274 
            printf  DP "<dt><a name=\"$anchor\"></a><a href=\"#$tag\">%s&nbsp;%s</a></dt>\n", $name, $ver;
1275 
            foreach my $reason ( @reasons )
1276 
            {
1277 
                print  DP "<dd>$reason</dd>\n";
1278 
            }
1279 
 
1280 
 
1281 
            print DP "</dl>\n";
1282 
            print DP "</td>\n";
1283 
            print DP "</tr>\n";
1284 
 
1285 
        }
1286 
    }
233 dpurdie 1287 
    print DP "<tr>\n";
237 dpurdie 1288 
    print DP thl("Total Count: $no_build_count");
233 dpurdie 1289 
    print DP "</tr>\n";
1290 
 
227 dpurdie 1291 
    print DP "</tbody></table>\n";
1292 
 
1293 
    #
1294 
    #   Packages that are in a specified release, but not described by the SBOM
1295 
    #
237 dpurdie 1296 
    if ( $opt_rtag_id && ($opt_sbom_id || $opt_rootpkg) )
227 dpurdie 1297 
    {
1298 
        print DP "<h1><a name=\"Excess\">Excess Packages from Release: $opt_rtag_id</a></h1>\n";
1299 
        print DP "<table border=\"1\"><tbody>\n";
1300 
        print DP "<tr>\n";
237 dpurdie 1301 
        print DP th("Excess Packages",3);
227 dpurdie 1302 
        print DP "</tr>\n";
1303 
 
1304 
        print DP "<tr>\n";
237 dpurdie 1305 
        print DP th("Package");
1306 
        print DP th("PVID");
1307 
        print DP th("Used Package");
227 dpurdie 1308 
        print DP "</tr>\n";
1309 
 
1310 
        my $were_found = 0;
1311 
        my $not_found = 0;
1312 
        foreach my $name ( sort keys %Release )
1313 
        {
1314 
            my @versions = keys %{$Release{$name}};
1315 
            foreach my $ver ( sort @versions )
1316 
            {
1317 
                if (exists($Package{$name}{$ver}))
1318 
                {
1319 
                    $were_found++;
1320 
                    next;
1321 
                }
1322 
                $not_found++;
1323 
 
1324 
                print DP "<tr>\n";
1325 
                print DP $td;
1326 
 
1327 
                my $pv_id = $Release{$name}{$ver}{pv_id} || 'No PVID';
1328 
                my $pv_id_ref = $rm_base . $pv_id . "&rtag_id=" . $opt_rtag_id;
233 dpurdie 1329 
                my $pv_id_str = "<a href=\"$pv_id_ref\" TARGET=\"_blank\">$pv_id</a>";
227 dpurdie 1330 
 
1331 
                printf  DP "$name $ver ", $name, $ver;
1332 
                print DP "</td>\n";
1333 
 
1334 
                print DP $td;
1335 
                printf DP "Pvid: %s\n", $pv_id_str;
1336 
                print DP "</td>\n";
1337 
 
1338 
                print DP $td;
1339 
                my @pver = keys %{$Package{$name}};
1340 
                if (@pver)
1341 
                {
1342 
                    printf  DP "<dl><dt> Uses Versions:<dt>\n";
1343 
                    foreach my $ver ( sort @pver  )
1344 
                    {
1345 
                        my $tag = "${name}_${ver}";
1346 
                        printf  DP "    <dd><a href=\"#$tag\">%s&nbsp;%s</a></dd>\n", $name, $ver;
1347 
                    }
1348 
                    print DP "</dl>\n";
1349 
                }
1350 
                else
1351 
                {
1352 
                    printf DP "No Versions of this package used\n"
1353 
                }
1354 
                print DP "</td>\n";
1355 
 
1356 
 
1357 
                print DP "</tr>\n";
1358 
            }
1359 
        }
1360 
 
1361 
        print DP "<tr>\n";
237 dpurdie 1362 
        print DP thl("Packages found in SBOM: $were_found",3);
227 dpurdie 1363 
        print DP "</td>\n";
1364 
        print DP "</tr>\n";
1365 
 
1366 
        print DP "<tr>\n";
237 dpurdie 1367 
        print DP thl("Packages NOT found in SBOM: $not_found", 3);
227 dpurdie 1368 
        print DP "</td>\n";
1369 
        print DP "</tr>\n";
1370 
 
1371 
        print DP "</tbody></table>\n";
1372 
    }
1373 
 
1374 
    #
1375 
    #   Packages that are strays
1376 
    #   They are not top level packages in the release
1377 
    #
237 dpurdie 1378 
    if ( $opt_rtag_id && ! ($opt_sbom_id || $opt_rootpkg) )
227 dpurdie 1379 
    {
1380 
        print DP "<h1><a name=\"Stray\">Required Packages, not part of the release</a></h1>\n";
1381 
        print DP "<table border=\"1\"><tbody>\n";
1382 
        print DP "<tr>\n";
237 dpurdie 1383 
        print DP th("Stray Packages",3);
227 dpurdie 1384 
        print DP "</tr>\n";
1385 
 
1386 
        print DP "<tr>\n";
237 dpurdie 1387 
        print DP th("Inconsisient Package");
1388 
        print DP th("PVID");
1389 
        print DP th("Preferred Package");
227 dpurdie 1390 
        print DP "</tr>\n";
237 dpurdie 1391 
        my $stray_count = 0;
227 dpurdie 1392 
 
1393 
        foreach my $name ( sort keys %Package )
1394 
        {
1395 
 
1396 
            my @versions = keys %{$Package{$name}};
1397 
            foreach my $ver ( sort @versions )
1398 
            {
1399 
                unless (exists($Package{$name}{$ver}{stray}) && $Package{$name}{$ver}{stray} )
1400 
                {
1401 
                    next;
1402 
                }
1403 
 
1404 
                #
1405 
                #   Determine preferred package version(s)
1406 
                #   These will be those without a 'stray' tag
1407 
                #
1408 
                my @preferred = ();
1409 
                foreach my $pver ( keys %{$Package{$name}} )
1410 
                {
1411 
                    next if (exists($Package{$name}{$pver}{stray} ) && $Package{$name}{$pver}{stray} );
1412 
                    push @preferred, $pver;
1413 
                }
1414 
 
1415 
                print DP "<tr>\n";
237 dpurdie 1416 
                $stray_count++;
227 dpurdie 1417 
 
1418 
                #
1419 
                #  Package name and Used By information
1420 
                #
1421 
                print DP $td;
1422 
                my $anchor= "usedby_${name}_${ver}";
1423 
                my $tag = "${name}_${ver}";
1424 
                printf  DP "<dl><dt><a name=\"$anchor\"></a><a href=\"#$tag\">%s&nbsp;%s</a> Used by:</dt>\n", $name, $ver;
1425 
                foreach my $depend ( sort keys %{$Package{$name}{$ver}{usedby}} )
1426 
                {
1427 
                    my ($dname, $dver) = split $;, $depend;
1428 
                    my $tag = "usedby_${dname}_${dver}";
1429 
                    printf  DP "    <dd><a href=\"#$tag\">%s&nbsp;%s</a></dd>\n", $dname, $dver;
1430 
                }
1431 
                print DP "</dl>\n";
1432 
                print DP "</td>\n";
1433 
 
1434 
 
1435 
                my $pv_id = $Package{$name}{$ver}{pvid} || 'No PVID';
1436 
 
1437 
                my $pv_id_ref = $rm_base . $pv_id;
233 dpurdie 1438 
                my $pv_id_str = "<a href=\"$pv_id_ref\" TARGET=\"_blank\">$pv_id</a>";
227 dpurdie 1439 
 
1440 
                print DP $td;
1441 
                printf DP "Pvid: %s\n", $pv_id_str;
1442 
                print DP "</td>\n";
1443 
 
1444 
                #
1445 
                #   Insert Preferred package(s)
1446 
                #
1447 
                print DP $td;
1448 
                print DP "<table>\n";
1449 
                foreach my $pver ( sort @preferred )
1450 
                {
1451 
                    my $tag = "${name}_${pver}";
1452 
                    printf  DP "<tr><td><a href=\"#$tag\">%s&nbsp;%s</a></td></tr>\n", $name, $pver;
1453 
                }
1454 
 
1455 
                print DP "</table>\n";
1456 
                print DP "</tr>\n";
1457 
 
1458 
            }
1459 
        }
1460 
 
237 dpurdie 1461 
        print DP "<tr>\n";
1462 
        print DP thl("Total Count: $stray_count", 3);
1463 
        print DP "</tr>\n";
227 dpurdie 1464 
        print DP "</tbody></table>\n";
1465 
    }
1466 
 
1467 
    #
1468 
    #   Packages that have components not in the release
1469 
    #   They are not top level packages in the release
1470 
    #
1471 
    if ( $opt_rtag_id && !$opt_sbom_id )
1472 
    {
1473 
        print DP "<h1><a name=\"Inconsistent\">Packages in the Release, with inconsistent dependencies</a></h1>\n";
1474 
        print DP "<table border=\"1\"><tbody>\n";
1475 
 
1476 
        print DP "<tr>\n";
237 dpurdie 1477 
        print DP th("Inconsisient Package");
227 dpurdie 1478 
        print DP "</tr>\n";
237 dpurdie 1479 
        my $inconsistent_count = 0;
227 dpurdie 1480 
 
1481 
        foreach my $name ( sort keys %Package )
1482 
        {
1483 
 
1484 
            my @versions = keys %{$Package{$name}};
1485 
            foreach my $ver ( sort @versions )
1486 
            {
1487 
                #
1488 
                #   Ignore 'stray' packages
1489 
                #
1490 
                next if (exists($Package{$name}{$ver}{stray}) && $Package{$name}{$ver}{stray} );
1491 
 
1492 
                #
1493 
                #   Is it inconsitient
1494 
                #
1495 
                my $ok = 1;
1496 
                foreach my $depend ( sort keys %{$Package{$name}{$ver}{depends}} )
1497 
                {
1498 
                    my ($dname, $dver) = split $;, $depend;
1499 
                    if (exists($Package{$dname}{$dver}{stray}) && $Package{$dname}{$dver}{stray} )
1500 
                    {
1501 
                        $ok = 0;
1502 
                        last;
1503 
                    }
1504 
                }
1505 
 
1506 
                next if ( $ok );
237 dpurdie 1507 
                $inconsistent_count++;
227 dpurdie 1508 
 
1509 
                #
1510 
                #   Depends On info
1511 
                #
1512 
 
1513 
                print DP "<tr>\n";
1514 
                print DP $td;
1515 
                my $anchor= "${name}_${ver}";
1516 
                my $tag = "usedby_${name}_${ver}";
1517 
                printf  DP "<dl><dt><a name=\"$anchor\"></a><a href=\"#$tag\">%s&nbsp;%s</a> Inconsistent::</dt>\n", $name, $ver;
1518 
                foreach my $depend ( sort keys %{$Package{$name}{$ver}{depends}} )
1519 
                {
1520 
                    my ($dname, $dver) = split $;, $depend;
1521 
                    next unless (exists($Package{$dname}{$dver}{stray}) && $Package{$dname}{$dver}{stray} );
1522 
 
1523 
                    my $tag = "${dname}_${dver}";
1524 
                    printf  DP "    <dd><a href=\"#$tag\">%s&nbsp;%s</a></dd>\n", $dname, $dver;
1525 
                }
1526 
                print DP "</dl>\n";
1527 
                print DP "</td>\n";
1528 
                print DP "<tr>\n";
1529 
 
1530 
            }
1531 
        }
1532 
 
237 dpurdie 1533 
        print DP "<tr>\n";
1534 
        print DP thl("Total Count: $inconsistent_count");
1535 
        print DP "</tr>\n";
227 dpurdie 1536 
        print DP "</tbody></table>\n";
1537 
    }
1538 
 
1539 
    close DP;
1540 
}
1541 
 
1542 
#-------------------------------------------------------------------------------
241 dpurdie 1543 
# Function        : GenerateHTMLLodgement
1544 
#
1545 
# Description     : Simple document to describe packages
1546 
#
1547 
# Inputs          :
1548 
#
1549 
# Returns         :
1550 
#
1551 
sub GenerateHTMLLodgement
1552 
{
1553 
    my $td  = '<td style="vertical-align: top;">' . "\n";
1554 
 
1555 
    my $file = "${fpref}_lodgement.html";
1556 
    push @create_list, $file;
1557 
    open (DP, ">$file" )  || Error ("Cannot create $file");
1558 
 
1559 
    #
1560 
    #   Package Information
1561 
    #
1562 
    print DP "<h1>Package Information</h1>\n";
1563 
 
1564 
    print DP "<table border=\"1\"><tbody>\n";
1565 
    print DP "<tr>\n";
1566 
    print DP th("Name, Version");
1567 
    print DP th("Dependencies");
1568 
    print DP "</tr>\n";
1569 
    my $package_count = 0;
1570 
    foreach my $name ( sort keys %Package )
1571 
    {
1572 
        foreach my $ver ( sort keys %{$Package{$name}} )
1573 
        {
1574 
            print DP "<tr>\n";
1575 
            $package_count++;
1576 
 
1577 
            my $anchor= "${name}_${ver}";
1578 
 
1579 
            #
1580 
            #   Package Name and description
1581 
            #   Cleanup and html-ize the description string
1582 
            #
1583 
            my $description = $Package{$name}{$ver}{description};
1584 
            $description =~ s{\n\r}{\n}g;
1585 
            $description =~ s{\r}{}g;
1586 
            $description =~ s{^\n+}{};
1587 
            $description =~ s{&}{&amp;}g;
1588 
            $description =~ s{<}{&lt;}g;
1589 
            $description =~ s{>}{&gt;}g;
1590 
            $description =~ s{"}{&quot;}g;
1591 
            $description =~ s{\n}{<br>\n}g;
1592 
 
1593 
            print DP $td;
1594 
            printf  DP "<a name=\"$anchor\"></a>%s,&nbsp;%s<br>\n", $name, $ver;
1595 
            print DP "<dl><dd>\n";
1596 
            print  DP $description;
1597 
            print DP "</dd></dl>\n";
1598 
            print DP "\n</td>\n";
1599 
 
1600 
            #
1601 
            #   Depends On info
1602 
            #
1603 
            my $icount = 0;
1604 
            print DP $td;
1605 
#            printf  DP "<dl><dt><a name=\"$anchor\"></a><a href=\"#$tag\">%s&nbsp;%s</a> Depends on:</dt>\n", $name, $ver;
1606 
            foreach my $depend ( sort keys %{$Package{$name}{$ver}{depends}} )
1607 
            {
1608 
                my ($dname, $dver) = split $;, $depend;
1609 
                my $tag = "${dname}_${dver}";
1610 
                printf  DP "<a href=\"#$tag\">%s&nbsp;%s</a><br>\n", $dname, $dver;
1611 
                $icount++;
1612 
            }
1613 
            print DP "<br>\n" unless $icount;
1614 
            print DP "</td>\n";
1615 
 
1616 
            #
1617 
            #   End of Row
1618 
            #
1619 
            print DP "</tr>\n";
1620 
        }
1621 
    }
1622 
    print DP "<tr>\n";
1623 
    print DP thl("Total Count: $package_count", 2);
1624 
    print DP "</tr>\n";
1625 
 
1626 
    print DP "</tbody>\n";
1627 
    print DP "</table>\n";
1628 
    close DP;
1629 
}
1630 
 
1631 
#-------------------------------------------------------------------------------
227 dpurdie 1632 
# Function        : extract_files
1633 
#
1634 
# Description     : Alternate mode of operation
1635 
#                   Extract files from the generated list. This is intended to
235 dpurdie 1636 
#                   be run as a seperate phase taking the 'extract' file
227 dpurdie 1637 
#
1638 
# Inputs          :
1639 
#
1640 
# Returns         :
1641 
#
1642 
sub extract_files
1643 
{
1644 
    my @extract_order;
1645 
    my %extract;
1646 
    ErrorConfig( 'name'    => 'ESCROW-EXTRACT' );
1647 
 
1648 
    #
1649 
    #   Open the file and read in data in one hit
1650 
    #   This will detect file errors early
243 dpurdie 1651 
    #   The lines may have arguments that are quoted.
1652 
    #   Supported forms are:
1653 
    #           "-tag=data"         - data may contain spaces
1654 
    #           -tag=data           - data must not contain spaces
227 dpurdie 1655 
    #
243 dpurdie 1656 
    #
227 dpurdie 1657 
    Error ("Cannot find specified file: $opt_extract")
1658 
        unless ( -f $opt_extract );
1659 
 
1660 
    open (FH, "<$opt_extract" ) || Error ("Cannot open file");
1661 
    while ( <FH> )
1662 
    {
1663 
        s~[\r\n]+$~~;
243 dpurdie 1664 
        Verbose2 ($_);
227 dpurdie 1665 
        next unless ( $_ );
1666 
 
1667 
        my ($view, $label, $path);
243 dpurdie 1668 
        if ( m{(\s"-view=([^"]+)")|(\s-view=(\S+))} )
227 dpurdie 1669 
        {
243 dpurdie 1670 
            $view = $2 || $4;
227 dpurdie 1671 
        }
1672 
 
243 dpurdie 1673 
        if ( m{(\s"-label=([^"]+)")|(\s-label=(\S+))} )
235 dpurdie 1674 
        {
243 dpurdie 1675 
            $label = $2 || $4;
235 dpurdie 1676 
        }
1677 
 
243 dpurdie 1678 
        if ( m{(\s"-path=([^"]+)")|(\s-path=(\S+))} )
235 dpurdie 1679 
        {
243 dpurdie 1680 
            $path = $2 || $4;
235 dpurdie 1681 
        }
1682 
 
1683 
        Error "Bad file format in line: $_" unless ( $view && $label );
227 dpurdie 1684 
        Error "Duplicate view name: $view" if ( exists $extract{$view} );
1685 
        push @extract_order, $view;
1686 
        $extract{$view}{label} = $label;
1687 
        $extract{$view}{path} = $path;
1688 
    }
1689 
    close FH;
1690 
 
1691 
    #
1692 
    #   Log the file processing
1693 
    #
1694 
    my $lfile = "${opt_extract}.log";
243 dpurdie 1695 
    Message ("Creating logfile: ${opt_extract}.log");
227 dpurdie 1696 
    open (FH, ">$lfile" ) || Error ("Cannot open log file: $lfile");
1697 
 
1698 
    #
1699 
    #   Process each entry
1700 
    #
1701 
    foreach my $view ( @extract_order )
1702 
    {
1703 
        my $label = $extract{$view}{label};
1704 
        my $path = $extract{$view}{path};
243 dpurdie 1705 
        if ( $opt_test )
1706 
        {
1707 
            Verbose ("view($view) label($label) path($path)");
1708 
            print FH "view($view) label($label) path($path) : TEST\n";
1709 
        }
1710 
        else
1711 
        {
263 dpurdie 1712 
            my $rv = JatsCmd ('extract', '-extractfiles', "-view=$view", "-label=$label", "-path=$path", "-root=.", "-noprefix");
243 dpurdie 1713 
            print FH "$view : SUCCESS\n" unless $rv;
1714 
            print FH "$view : ERROR\n" if $rv;
1715 
        }
227 dpurdie 1716 
    }
1717 
    close FH;
243 dpurdie 1718 
    Message ("Results in logfile: ${opt_extract}.log");
227 dpurdie 1719 
 
1720 
}
1721 
 
1722 
 
1723 
#-------------------------------------------------------------------------------
1724 
#   Documentation
1725 
#
1726 
 
1727 
=pod
1728 
 
1729 
=head1 NAME
1730 
 
1731 
escrow - Extract Escrow Build Information
1732 
 
1733 
=head1 SYNOPSIS
1734 
 
281 dpurdie 1735 
  jats escrow [options] [name version]
227 dpurdie 1736 
 
1737 
 Options:
1738 
    -help              - brief help message
1739 
    -help -help        - Detailed help message
1740 
    -man               - Full documentation
1741 
    -sbomid=xxx        - Specify the SBOM to process
1742 
    -rtagid=xxx        - Specify the Release to process (Optional)
255 dpurdie 1743 
    -rootpackage=xxx   - Specifies a root package. In conjunction with -rtagid.
227 dpurdie 1744 
    -ignore=name       - Ignore packages with the specified name
1745 
    -extract=fname     - Extract files from a previous run
1746 
    -verbose           - Enable verbose output
1747 
    -[no]patch         - Ignore/Include patches. Default:Include
1748 
    -[no]test          - Reduced package scanning for test
1749 
 
1750 
=head1 OPTIONS
1751 
 
1752 
=over 8
1753 
 
1754 
=item B<-help>
1755 
 
1756 
Print a brief help message and exits.
1757 
 
1758 
=item B<-help -help>
1759 
 
1760 
Print a detailed help message with an explanation for each option.
1761 
 
1762 
=item B<-man>
1763 
 
1764 
Prints the manual page and exits.
1765 
 
1766 
=item B<-sbomid=xxx>
1767 
 
255 dpurdie 1768 
This option specifies the SBOM to process. The sbomid must be determined from
1769 
Deployment Manager.
227 dpurdie 1770 
 
1771 
=item B<-rtagid=xxx>
1772 
 
255 dpurdie 1773 
This option specified an RTAG_ID that must be determined from Release Manager.
227 dpurdie 1774 
 
255 dpurdie 1775 
This option may be used with or without the B<-sbomid=xxx> option.
1776 
 
1777 
With an SBOM_ID this option specifies an RTAG_ID to process in conjunction with the SBOM.
1778 
The program will determine packages that are in the Release, but not in the
1779 
SBOM.
1780 
 
1781 
Without an SBOM_ID, this option will limit the processing to the specified
1782 
release. Less information is generated. This form of the generation may be
1783 
combined with B<-rootpackage=xxx> to further limit the set of packages
1784 
processed.
1785 
 
1786 
=item B<-rootpackage=xxx>
1787 
 
1788 
This option can be used in conjunction with B<-rtagid=xxx> to limit the
1789 
extraction to named package and all of its dependent packages. The tool will
1790 
determine the required version of the package via the specified release.
1791 
 
227 dpurdie 1792 
=item B<-ignore=name>
1793 
 
1794 
All versions of the named package will be ignored. This parameter is options.
1795 
It may be used multiple times.
1796 
 
1797 
=item B<-extract=name>
1798 
 
1799 
This option will process the 'extract' file created in a previous run of this
1800 
program and extract source files for the package-versions found in the file.
1801 
 
1802 
The command will then create a log file recording packages that could ne be
1803 
extracted.
1804 
 
255 dpurdie 1805 
This option cannot be used in conjunction with the -rtagid or -sbomid.
227 dpurdie 1806 
 
1807 
=item B<-[no]patch>
1808 
 
1809 
This option is used ignore patches. If -nopatch is selected, then packages
1810 
versions that look like a patch will be added to the ignore list.
1811 
 
1812 
=item B<-[no]test>
1813 
 
1814 
This option is used for testing. It will only process the first two OS entries
1815 
in the SBOM. This speeds up processing. It does not generate a complete list of
1816 
packages.
1817 
 
255 dpurdie 1818 
=item B<-verbose>
227 dpurdie 1819 
 
1820 
This option will display progress information as the program executes.
1821 
 
1822 
=back
1823 
 
1824 
=head1 DESCRIPTION
1825 
 
1826 
This program is a tool for extracting Escrow build information.
255 dpurdie 1827 
The program has two modes of operation:
227 dpurdie 1828 
 
255 dpurdie 1829 
=over 8
227 dpurdie 1830 
 
281 dpurdie 1831 
=item 1. Generation. Generate files describing packages within an SBOM/Release/
1832 
Package.
255 dpurdie 1833 
 
1834 
=item 2. Extraction  Supervise extraction of source trees.
1835 
 
1836 
=back
1837 
 
1838 
=head2 Generation Operations
1839 
 
281 dpurdie 1840 
This program has several modes of operation. The mode is determined from the
1841 
command line arguments provided.
255 dpurdie 1842 
 
227 dpurdie 1843 
=over 8
1844 
 
281 dpurdie 1845 
=item   Full Escrow
1846 
 
1847 
This mode requires an SBOM_ID. If an RTAG_ID is also provided, then additional
1848 
information will be generated.
1849 
 
1850 
=item   Release Escrow
1851 
 
1852 
If only an RTAG_ID is provided then the processing wil be limited to the
1853 
packages involved in creating the specified release.
1854 
 
1855 
If a 'rootpackage' name is provided, then the processing is limited to
1856 
packages that depend on the named package.
1857 
 
1858 
=item   Single Package
1859 
 
1860 
If a package name and a package version are specified on the command line,
1861 
then the processing will be limited to the specified package and ist dependents.
1862 
No release related information will be provided.
1863 
 
1864 
=back
1865 
 
1866 
The 'Full Escrow' extract is the complete operation. All others are sub-sets of
1867 
this processing. The complete processing is:
1868 
 
1869 
=over 8
1870 
 
227 dpurdie 1871 
=item * Determine all the NODES in the SBOM
1872 
 
1873 
=item * Determine all the Base Packages for each NODE
1874 
 
1875 
=item * Determine all the Packages for each NODE
1876 
 
1877 
=item * Determine all the dependent packages for all packages encountered
1878 
 
1879 
=item * Generate a list of jats commands to extract the package source
1880 
 
1881 
=item * Generate a file describing the build order
1882 
 
1883 
=item * Generate a file describing the packages that cannot be built
1884 
 
1885 
=item * Generate an HTML file with extensive cross reference information
1886 
 
1887 
=over 8
1888 
 
1889 
=item * List of all packages with references into Release Manager
1890 
 
1891 
=item * List of all packages showing dependent packages
1892 
 
1893 
=item * List of all packages showing consumer packages
1894 
 
1895 
=item * List of all packages for which multiple versions are required
1896 
 
1897 
=item * Details of packages that are not built.
1898 
 
1899 
=item * Build order
1900 
 
1901 
=item * Build machines and built types
1902 
 
255 dpurdie 1903 
=item * Deployed target nodes, with references into Deployment Manager
227 dpurdie 1904 
 
1905 
=back
1906 
 
1907 
=back
1908 
 
1909 
This may take some time, as a typical escrow build may contain many hundreds of packages.
1910 
 
1911 
The program will display a list of files that have been created.
1912 
 
255 dpurdie 1913 
=head2 Extraction Operations
1914 
 
227 dpurdie 1915 
Given an 'extract' file from a previous run of this program the program will:
1916 
 
1917 
=over 8
1918 
 
1919 
=item * Parse the 'extract' file
1920 
 
255 dpurdie 1921 
=item * Create subdirectories for each package version within the file. This is done
227 dpurdie 1922 
in such a way that no views are left in place.
1923 
 
1924 
=item * Create a log file showing packages that could not be extracted.
1925 
 
1926 
=back
1927 
 
1928 
=cut
1929