Subversion Repositories DevTools

Rev

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

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