Subversion Repositories DevTools

Rev

Go to most recent revision | Details | 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 
 
20 
require 5.6.1;
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 
 
233 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();
335 
 
336 
 
337 
#
338 
#   Display names of files created
339 
#
340 
foreach my $file ( sort @create_list )
341 
{
342 
    Message ("Created: $file");
343 
}
344 
exit;
345 
 
346 
 
347 
#-------------------------------------------------------------------------------
348 
# Function        : getOSIDforBOMID
349 
#
350 
# Description     : Get all the os_id's associated with a BOMID
351 
#
352 
# Inputs          : $bom_id             - BOM to process
353 
#
354 
# Returns         :
355 
#
356 
 
357 
sub getOSIDforBOMID
358 
{
359 
    my ($bom_id) = @_;
360 
    my $foundDetails = 0;
361 
    my (@row);
233 dpurdie 362 
Verbose ("getOSIDforBOMID");
227 dpurdie 363 
    connectDM(\$DM_DB) unless ($DM_DB);
364 
 
365 
    my $m_sqlstr = "SELECT distinct os.OS_ID, os.OS_NAME, nn.NODE_NAME, obe.BASE_ENV_ID " .
366 
                   " FROM OPERATING_SYSTEMS os, BOM_CONTENTS bc, NETWORK_NODES nn, OS_BASE_ENV obe" .
367 
                   " 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 ";
368 
 
369 
    my $sth = $DM_DB->prepare($m_sqlstr);
370 
    if ( defined($sth) )
371 
    {
372 
        if ( $sth->execute( ) )
373 
        {
374 
            if ( $sth->rows )
375 
            {
376 
                while ( @row = $sth->fetchrow_array )
377 
                {
378 
                    Verbose ("OS_ID: ".join (',',@row) );
379 
                    $os_id_list{$row[0]}{os_name} = $row[1];
380 
                    $os_id_list{$row[0]}{node_name} = $row[2];
381 
 
382 
                    $os_env_list{$row[3]}{needed} = 1;
383 
                    $os_env_list{$row[3]}{os_id}{$row[0]} = 1;
233 dpurdie 384 
 
385 
                    $foundDetails = 1;
227 dpurdie 386 
                }
387 
            }
388 
            $sth->finish();
389 
        }
233 dpurdie 390 
        else
391 
        {
392 
            Error("getOSIDforBOMID:Execute failure" );
393 
        }
227 dpurdie 394 
    }
395 
    else
396 
    {
397 
        Error("getOSIDforBOMID:Prepare failure" );
398 
    }
233 dpurdie 399 
 
400 
    Error("getOSIDforBOMID:No OS Information Found" ) unless $foundDetails;
401 
 
227 dpurdie 402 
}
403 
 
404 
#-------------------------------------------------------------------------------
405 
# Function        : getPackagesforBaseInstall
406 
#
407 
# Description     : Get all the packages for a given base install
408 
#
409 
# Inputs          :
410 
#
411 
# Returns         :
412 
#
413 
 
414 
sub getPackagesforBaseInstall
415 
{
416 
    my ($base_env_id) =@_;
417 
    my $foundDetails = 0;
418 
    my (@row);
419 
 
420 
    connectDM(\$DM_DB) unless ($DM_DB);
421 
 
422 
    # First get details from pv_id
423 
 
424 
    my $m_sqlstr = "SELECT DISTINCT bec.PROD_ID, pkg.pkg_name, pv.pkg_version, pkg.pkg_id, pv.pv_id" .
425 
                " FROM PACKAGES pkg, PACKAGE_VERSIONS pv,PRODUCT_DETAILS pd, BASE_ENV_CONTENTS bec".
426 
                " WHERE bec.BASE_ENV_ID = $base_env_id AND bec.PROD_ID (+)= pv.PV_ID AND pv.pkg_id = pkg.pkg_id";
427 
 
428 
    my $sth = $DM_DB->prepare($m_sqlstr);
429 
    if ( defined($sth) )
430 
    {
431 
        if ( $sth->execute( ) )
432 
        {
433 
            if ( $sth->rows )
434 
            {
435 
                while ( @row = $sth->fetchrow_array )
436 
                {
437 
                    Verbose ("OS ENV Package($base_env_id}:" . join (',',@row) );
438 
 
439 
                    my $pv_id =     $row[0];
440 
                    my $name =      $row[1]  || 'BadName';
441 
                    my $ver =       $row[2]  || 'BadVer';
442 
 
443 
                    $pv_id{$pv_id}{pkg_name} =$name;
444 
                    $pv_id{$pv_id}{pkg_ver} = $ver;
445 
                    foreach my $os_id ( keys %{$os_env_list{$base_env_id}{os_id}} )
446 
                    {
447 
                        $pv_id{$pv_id}{os_id}{$os_id} = 2;
448 
                    }
449 
                }
450 
            }
451 
            $sth->finish();
452 
        }
453 
        else
454 
        {
455 
            Error ("getPackagesforBaseInstall: Execute error");
456 
        }
457 
    }
458 
    else
459 
    {
460 
        Error("getPackagesforBaseInstall:Prepare failure" );
461 
    }
462 
 
463 
}
464 
 
465 
 
466 
#-------------------------------------------------------------------------------
467 
# Function        : getPackages_by_osid
468 
#
469 
# Description     : Get all the packages used by a given os_id
470 
#
471 
# Inputs          :
472 
#
473 
# Returns         :
474 
#
475 
 
476 
my $count = 0;
477 
sub getPackages_by_osid
478 
{
479 
    my ($os_id) =@_;
480 
    my $foundDetails = 0;
481 
    my (@row);
482 
 
483 
    connectDM(\$DM_DB) unless ($DM_DB);
484 
 
485 
    # First get details from pv_id
486 
 
487 
    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" .
488 
                " FROM PACKAGES pkg, PACKAGE_VERSIONS pv,PRODUCT_DETAILS pd,".
489 
	            "(" .
490 
		        " SELECT osc.seq_num, osc.prod_id".
491 
		        " FROM os_contents osc".
492 
		        " WHERE osc.os_id = $os_id" .
493 
	            " ) osc" .
494 
                " WHERE pd.PROD_ID (+)= pv.PV_ID" .
495 
                "   AND pv.pkg_id = pkg.pkg_id" .
496 
                "   AND osc.PROD_ID = pv.pv_id" .
497 
                " ORDER BY osc.SEQ_NUM desc" ;
498 
 
499 
    my $sth = $DM_DB->prepare($m_sqlstr);
500 
    if ( defined($sth) )
501 
    {
502 
        if ( $sth->execute( ) )
503 
        {
504 
            if ( $sth->rows )
505 
            {
506 
                while ( @row = $sth->fetchrow_array )
507 
                {
508 
next if ( $opt_test && ++$count > 2 );
509 
                    Verbose ("SBOM Package:".join (',',@row) );
510 
                    my $pv_id =     $row[8];
511 
                    my $name =      $row[2]  || 'BadName';
512 
                    my $ver =       $row[3]  || 'BadVer';
513 
 
514 
                    $pv_id{$pv_id}{pkg_name} =$name;
515 
                    $pv_id{$pv_id}{pkg_ver} = $ver;
516 
                    $pv_id{$pv_id}{os_id}{$os_id} = 1;
517 
                }
518 
            }
519 
            $sth->finish();
520 
        }
521 
    }
522 
    else
523 
    {
524 
        Error("getPackages_by_osid:Prepare failure" );
525 
    }
526 
}
527 
 
528 
#-------------------------------------------------------------------------------
529 
# Function        : getPkgDetailsByPV_ID
530 
#
531 
# Description     : Populate the Packages structure given a PV_ID
532 
#                   Called for each package in the SBOM
533 
#
534 
# Inputs          : PV_ID           - Package Unique Identifier
535 
#
536 
# Returns         : Populates Package
537 
#
538 
sub getPkgDetailsByPV_ID
539 
{
540 
    my ($PV_ID) = @_;
541 
    my $foundDetails = 0;
542 
    my (@row);
543 
 
544 
    connectRM(\$RM_DB) unless ($RM_DB);
545 
 
546 
    # First get details from pv_id
547 
 
548 
    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" .
549 
                    " FROM PACKAGE_VERSIONS pv, PACKAGES pkg, PACKAGE_BUILD_INFO pbi" .
550 
                    " WHERE pv.PV_ID = \'$PV_ID\' AND pv.PKG_ID = pkg.PKG_ID AND pv.PV_ID = pbi.PV_ID (+) ";
551 
 
552 
    my $sth = $RM_DB->prepare($m_sqlstr);
553 
    if ( defined($sth) )
554 
    {
555 
        if ( $sth->execute( ) )
556 
        {
557 
            if ( $sth->rows )
558 
            {
559 
                while ( @row = $sth->fetchrow_array )
560 
                {
561 
                    my $pv_id       = $row[0];
562 
                    my $name        = $row[1];
563 
                    my $ver         = $row[2];
564 
                    my $label       = $row[3] || '';
565 
                    my $path        = $row[4] || '';
566 
                    my $deployable  = $row[5];
567 
                    my $build_info  = $row[6] || '';
568 
                    my $build_mach  = $row[7] || '';
569 
 
570 
                    #
571 
                    #   BSA_ID: 1:debug, 2:prod, 3:debug+prod, 4:Java1.4 5: Java 1.5
572 
                    #   BM_ID : 1:solaris, 2:win32, 3: linux, 4:generic
573 
                    #
574 
 
575 
 
576 
                    #
577 
                    #   Does it look like a patch
578 
                    #   We may want to ignore it.
579 
                    #
580 
                    my $patch = "";
581 
                    unless ( $opt_patch )
582 
                    {
583 
                        if ( $ver =~ m~\.p\d+.\w+$~ )
584 
                        {
585 
                            $patch = "Patch";
586 
                            $patch{$name} = 0
587 
                                unless (  exists $patch{$name} );
588 
                            $patch{$name}++;
589 
                        }
590 
                    }
591 
                    Verbose ("getPkgDetailsByPV_ID: $PV_ID, $name, $ver, $build_mach ,$build_info, $patch");
592 
                    next if ( $patch );
593 
 
594 
 
595 
                    if ( exists $ignore{$name} )
596 
                    {
597 
                        Verbose2( "    Ignoring: $PV_ID, $name, $ver, $build_mach ,$build_info, $patch\n");
598 
                        $ignore{$name}++;
599 
                        last;
600 
                    }
601 
 
229 dpurdie 602 
                    $path =~ tr~\\/~/~;
227 dpurdie 603 
 
604 
                    $Package{$name}{$ver}{pvid} = $PV_ID;
605 
                    $Package{$name}{$ver}{done} = 1;
606 
                    $Package{$name}{$ver}{base} = 1;
607 
                    $Package{$name}{$ver}{deployable} = 1 if ($deployable);
608 
                    $Package{$name}{$ver}{label} = $label;
609 
                    $Package{$name}{$ver}{path} = $path;
610 
                    $Package{$name}{$ver}{build}{$build_mach} = $build_info if $build_mach;
611 
 
612 
                    GetDepends( $pv_id, $name, $ver );
613 
 
614 
                }
615 
            }
616 
            else
617 
            {
618 
                Warning ("No Package details for: PVID: $PV_ID");
619 
            }
620 
            $sth->finish();
621 
        }
622 
        else
623 
        {
624 
            Error("getPkgDetailsByPV_ID: Execute failure", $m_sqlstr );
625 
        }
626 
    }
627 
    else
628 
    {
629 
        Error("Prepare failure" );
630 
    }
631 
}
632 
 
633 
#-------------------------------------------------------------------------------
634 
# Function        : GetDepends
635 
#
636 
# Description     : Extract the dependancies for a given package version
637 
#
638 
# Inputs          : $pvid
639 
#
640 
# Returns         :
641 
#
642 
sub GetDepends
643 
{
644 
    my ($pv_id, $pname, $pver ) = @_;
645 
 
646 
    connectRM(\$RM_DB) unless ($RM_DB);
647 
 
648 
    #
649 
    #   Now extract the package dependacies
650 
    #
651 
    my $m_sqlstr = "SELECT pkg.PKG_NAME, pv.PKG_VERSION, pd.DPV_ID" .
652 
                   " FROM PACKAGE_DEPENDENCIES pd, PACKAGE_VERSIONS pv, PACKAGES pkg" .
653 
                   " WHERE pd.PV_ID = \'$pv_id\' AND pd.DPV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID";
654 
    my $sth = $RM_DB->prepare($m_sqlstr);
655 
    if ( defined($sth) )
656 
    {
657 
        if ( $sth->execute( ) )
658 
        {
659 
            if ( $sth->rows )
660 
            {
661 
                my %depends;
662 
                while ( my @row = $sth->fetchrow_array )
663 
                {
664 
#print "$pname $pver ===== @row\n";
665 
                    my $name = $row[0];
666 
                    my $ver = $row[1];
667 
 
668 
                    Verbose2( "       Depends: $name, $ver");
669 
 
670 
                    $depends{$name,$ver} = 1;
671 
                    $Package{$name}{$ver}{usedby}{$pname,$pver} = 1;
672 
 
673 
                    unless ( exists $Package{$name}{$ver}{done} )
674 
                    {
675 
                        my @DATA = ($name, $ver, $row[2]);
676 
                        push @StrayPackages, \@DATA;
677 
                    }
678 
                }
679 
                $Package{$pname}{$pver}{depends} = \%depends;
680 
            }
681 
            $sth->finish();
682 
        }
683 
    }
684 
    else
685 
    {
686 
        Error("GetDepends:Prepare failure" );
687 
    }
688 
}
689 
 
690 
#-------------------------------------------------------------------------------
691 
# Function        : getPkgDetailsByRTAG_ID
692 
#
233 dpurdie 693 
# Description     : Extract all the packages for a given rtag_id
227 dpurdie 694 
#
695 
# Inputs          : RTAG_ID
696 
#
697 
# Returns         :
698 
#
699 
 
700 
sub getPkgDetailsByRTAG_ID
701 
{
233 dpurdie 702 
    my ($RTAG_ID) = @_;
227 dpurdie 703 
    my $foundDetails = 0;
704 
    my (@row);
705 
 
706 
    connectRM(\$RM_DB);
707 
 
708 
    # First get details from pv_id
709 
 
710 
    my $m_sqlstr = "SELECT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION".
711 
                   " FROM RELEASE_CONTENT rc, PACKAGE_VERSIONS pv, PACKAGES pkg" .
712 
                   " WHERE rc.RTAG_ID = $RTAG_ID AND rc.PV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID";
713 
    my $sth = $RM_DB->prepare($m_sqlstr);
714 
    if ( defined($sth) )
715 
    {
716 
        if ( $sth->execute( ) )
717 
        {
718 
            if ( $sth->rows )
719 
            {
720 
                while ( @row = $sth->fetchrow_array )
721 
                {
722 
                    my $pv_id   = $row[0];
723 
                    my $name    = $row[1];
724 
                    my $ver     = $row[2];
725 
                    Verbose ("getPkgDetailsByRTAG_ID: $RTAG_ID, $name, $ver, $pv_id");
726 
 
727 
                    $Release{$name}{$ver}{pv_id} = $pv_id;
728 
                    $Release_pvid{$pv_id} = 1;
729 
                }
730 
            }
731 
            $sth->finish();
732 
        }
733 
    }
734 
    else
735 
    {
736 
        Error("getPkgDetailsByRTAG_ID:Prepare failure" );
737 
    }
738 
}
739 
 
740 
 
741 
#-------------------------------------------------------------------------------
742 
# Function        : LocateStrays
743 
#
744 
# Description     : Locate stray packages
745 
#                   These are packages that have not been defined by the
746 
#                   top level SBOM. These are not really stray
747 
#
748 
# Inputs          :
749 
#
750 
# Returns         :
751 
#
752 
sub LocateStrays
753 
{
233 dpurdie 754 
    my ($mode) = @_;
227 dpurdie 755 
    while ( $#StrayPackages >= 0 )
756 
    {
757 
        my $DATA = pop @StrayPackages;
758 
        my $name = $DATA->[0];
759 
        my $ver = $DATA->[1];
760 
        my $pv_id = $DATA->[2];
761 
 
762 
        next if ( exists $Package{$name}{$ver}{done} );
763 
        getPkgDetailsByPV_ID ( $pv_id );
233 dpurdie 764 
        if ( $mode )
765 
        {
766 
            next if ( exists $Release{$name}{$ver} );
767 
        }
227 dpurdie 768 
        $Package{$name}{$ver}{stray} = 1;
233 dpurdie 769 
#print "Stray: $pv_id, $name, $ver\n";
227 dpurdie 770 
    }
771 
}
772 
 
773 
#-------------------------------------------------------------------------------
774 
# Function        : BuildOrder
775 
#
776 
# Description     : Determine the order to build packages
777 
#
778 
# Inputs          :
779 
#
780 
# Returns         :
781 
#
782 
sub BuildOrder
783 
{
784 
    foreach my $name ( keys %Package )
785 
    {
786 
        foreach my $ver ( keys %{$Package{$name}} )
787 
        {
788 
            AddToBuildList( $name, $ver, $Package{$name}{$ver}{depends} );
789 
        }
790 
    }
791 
 
792 
    DetermineBuildOrder();
793 
}
794 
 
795 
#-------------------------------------------------------------------------------
796 
# Function        : AddToBuildList
797 
#
798 
# Description     : Add packages to a build list
799 
#
800 
# Inputs          : PackageName
801 
#                   PackageVersion
802 
#                   Hash of dependancies
803 
#
804 
# Returns         :
805 
#
806 
my %BuildList;
807 
sub AddToBuildList
808 
{
809 
    my ($name, $ver, $pdepends ) = @_;
810 
 
811 
    Warning ("Duplicate Package to build: $name, $ver") if exists $BuildList{$name,$ver};
812 
 
813 
    #
814 
    #   Clone dependancies as we will destroy the list as we process data
815 
    #
816 
    my $ref;
817 
    $ref = dclone ($pdepends ) if $pdepends;
818 
    $BuildList{$name,$ver}{depends} = $ref;
819 
}
820 
 
821 
#-------------------------------------------------------------------------------
822 
# Function        : DetermineBuildOrder
823 
#
824 
# Description     : Determine the build order
825 
#
826 
# Inputs          :
827 
#
828 
# Returns         :
829 
#
830 
sub DetermineBuildOrder
831 
{
832 
 
833 
    my $file = "${fpref}_buildinfo.txt";
834 
    push @create_list, $file;
835 
 
836 
    open (BI, ">$file" )  || Error ("Cannot create $file");
837 
 
838 
#    DebugDumpData ("BuildList", \%BuildList); exit 1;
839 
 
840 
    my $more = 1;
841 
    my $level = 0;
842 
    while ( $more )
843 
    {
844 
        my @build;
845 
        $level ++;
846 
        $more = 0;
847 
        foreach my $key ( keys %BuildList )
848 
        {
849 
            #
850 
            #   Locate packges with no dependencies left
851 
            #
852 
            next if ( keys %{$BuildList{$key}{depends}} );
853 
            push @build, $key;
854 
        }
855 
 
856 
        foreach my $build ( @build )
857 
        {
858 
            $more = 1;
859 
            delete $BuildList{$build};
860 
            my ($name, $ver) = split $;, $build;
861 
 
862 
            my $label = $Package{$name}{$ver}{label} || '';
863 
            my $path  = $Package{$name}{$ver}{path} || '';
864 
            $Package{$name}{$ver}{buildorder}  = $level;
865 
 
866 
            printf BI "Build(%2d): %40s %15s %-55s %s\n", $level, $name, $ver, $label, $path;
867 
        }
868 
 
869 
        #
870 
        #   Delete dependencies
871 
        #
872 
        foreach my $key ( keys %BuildList )
873 
        {
874 
            foreach my $build ( @build )
875 
            {
876 
                delete $BuildList{$key}{depends}->{$build};
877 
            }
878 
        }
879 
    }
880 
    close BI;
881 
}
882 
 
883 
#-------------------------------------------------------------------------------
884 
# Function        : GenerateHTML
885 
#
886 
# Description     : Generate Dependency information
887 
#                   Generate a nive HTML dependancy table
888 
#                   Shows DependOn and UsedBy
889 
# Inputs          :
890 
#
891 
# Returns         :
892 
#
893 
 
237 dpurdie 894 
sub th
895 
{
896 
    my ($text, $span) = @_;
897 
 
898 
    my $string = '<th style="vertical-align: top;"';
899 
    $string .= " colspan=\"$span\"" if ( $span );
900 
    $string .= '>' . $text . '</th>' . "\n";
901 
    return $string;
902 
}
903 
 
904 
sub thl
905 
{
906 
    my ($text, $span) = @_;
907 
 
908 
    my $string = '<th style="text-align: left;"';
909 
    $string .= " colspan=\"$span\"" if ( $span );
910 
    $string .= '>' . $text . '</th>' . "\n";
911 
    return $string;
912 
}
913 
 
914 
 
227 dpurdie 915 
sub GenerateHTML
916 
{
917 
    my $td = '<td style="vertical-align: top;">' . "\n";
918 
    my $td3 = '<td style="vertical-align: top;" colspan="3">' . "\n";
919 
    my $tdr = '<td style="text-align: right;">';
920 
 
921 
    my $file = "${fpref}_depends.html";
922 
    push @create_list, $file;
923 
    open (DP, ">$file" )  || Error ("Cannot create $file");
924 
 
925 
    #
926 
    #   Generate an index
927 
    #
928 
    print DP "<dl><dt><h1>Index</h1></dt>\n";
929 
    print DP "<dd><a href=\"#Ignore\">Ignored Packages</a></dd>\n";
930 
    print DP "<dd><a href=\"#Depend\">Dependency Info</a></dd>\n";
931 
    print DP "<dd><a href=\"#Multi\">Multiple Package Version</a></dd>\n";
233 dpurdie 932 
    print DP "<dd><a href=\"#Leaf\">Packages that have no parents</a></dd>\n";
227 dpurdie 933 
    print DP "<dd><a href=\"#NoBuild\">Packages that cannot be built</a></dd>\n";
237 dpurdie 934 
    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 ));
935 
    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 936 
    print DP "<dd><a href=\"#Inconsistent\">Packages in the Release, with inconsistent dependencies</a></dd>\n" if ( $opt_rtag_id && !$opt_sbom_id );
937 
 
938 
    print DP "</dl>\n";
939 
 
940 
    #
941 
    #   Ignored Packages
942 
    #
943 
    print DP "<h1><a name=\"Ignore\">Ignored Packages</a></h1>\n";
944 
 
945 
    print DP "The following package, and all dependents, have been ignored.<br><br>\n";
946 
 
947 
    foreach my $name ( sort keys %ignore )
948 
    {
949 
        print DP "$name: $ignore{$name} versions<br>\n";
950 
    }
951 
 
952 
    unless ( $opt_patch )
953 
    {
954 
        print DP "The following package have patches that have been ignored.<br><br>\n";
955 
        foreach my $name ( sort keys %patch )
956 
        {
957 
            print DP "$name: $patch{$name} patches<br>\n";
958 
        }
959 
    }
960 
 
961 
    #
962 
    #   Dependency Information
963 
    #
964 
    print DP "<h1><a name=\"Depend\">Dependency Info</a></h1>\n";
965 
 
966 
    print DP "<table border=\"1\"><tbody>\n";
967 
    print DP "<tr>\n";
237 dpurdie 968 
    print DP th("Package Dependency");
969 
    print DP th("Package Used by");
970 
    print DP th("Build Info");
227 dpurdie 971 
    print DP "</tr>\n";
237 dpurdie 972 
    my $package_count = 0;
227 dpurdie 973 
    foreach my $name ( sort keys %Package )
974 
    {
975 
        foreach my $ver ( sort keys %{$Package{$name}} )
976 
        {
977 
            print DP "<tr>\n";
237 dpurdie 978 
            $package_count++;
227 dpurdie 979 
            #
980 
            #   Depends On info
981 
            #
982 
 
983 
            print DP $td;
984 
            my $anchor= "${name}_${ver}";
985 
            my $tag = "usedby_${name}_${ver}";
986 
            printf  DP "<dl><dt><a name=\"$anchor\"></a><a href=\"#$tag\">%s&nbsp;%s</a> Depends on:</dt>\n", $name, $ver;
987 
            foreach my $depend ( sort keys %{$Package{$name}{$ver}{depends}} )
988 
            {
989 
                my ($dname, $dver) = split $;, $depend;
990 
                my $tag = "${dname}_${dver}";
991 
                printf  DP "    <dd><a href=\"#$tag\">%s&nbsp;%s</a></dd>\n", $dname, $dver;
992 
            }
993 
            print DP "</dl>\n";
994 
            print DP "</td>\n";
995 
 
996 
 
997 
            #
998 
            #   Used By information
999 
            #
1000 
            print DP $td;
1001 
            $anchor= "usedby_${name}_${ver}";
1002 
            $tag = "${name}_${ver}";
1003 
            printf  DP "<dl><dt><a name=\"$anchor\"></a><a href=\"#$tag\">%s&nbsp;%s</a> Used by:</dt>\n", $name, $ver;
1004 
            foreach my $depend ( sort keys %{$Package{$name}{$ver}{usedby}} )
1005 
            {
1006 
                my ($dname, $dver) = split $;, $depend;
1007 
                my $tag = "usedby_${dname}_${dver}";
1008 
                printf  DP "    <dd><a href=\"#$tag\">%s&nbsp;%s</a></dd>\n", $dname, $dver;
1009 
            }
1010 
            print DP "</dl>\n";
1011 
            print DP "</td>\n";
1012 
 
1013 
            #
1014 
            #   Build Info
1015 
            #
1016 
            print DP $td;
1017 
            print DP "<table>";
1018 
            my $stray = ( exists ($Package{$name}{$ver}{stray}) && $Package{$name}{$ver}{stray} );
1019 
 
1020 
            my $pv_id = $Package{$name}{$ver}{pvid} || 'No PVID';
1021 
            my $pv_id_ref = $rm_base . $pv_id;
1022 
               $pv_id_ref .= "&rtag_id=" . $opt_rtag_id if ($opt_rtag_id && !$stray);
233 dpurdie 1023 
            my $pv_id_str = "<a href=\"$pv_id_ref\" TARGET=\"_blank\">$pv_id</a>";
227 dpurdie 1024 
 
1025 
            printf DP "<tr>${tdr}Pvid:</td><td>%s</td></tr>\n", $pv_id_str;
1026 
            printf DP "<tr>${tdr}Label:</td><td>%s</td></tr>\n", $Package{$name}{$ver}{label} || 'NoneProvided';
1027 
            printf DP "<tr>${tdr}Path:</td><td>%s</td></tr>\n", $Package{$name}{$ver}{path}  || 'NoneProvided';
1028 
 
1029 
            my $order = 'Not Built';
1030 
            my @machs;
1031 
 
1032 
            if ( exists($Package{$name}{$ver}{build}) )
1033 
            {
1034 
                $order = $Package{$name}{$ver}{buildorder};
1035 
                @machs = sort keys %{$Package{$name}{$ver}{build}};
1036 
            }
1037 
            else
1038 
            {
1039 
                my $tag = "notbuilt_${name}_${ver}";
1040 
                $order = "<a href=\"#$tag\">Not Built</a>"
1041 
            }
1042 
 
1043 
            printf DP "<tr>${tdr}Build Order:</td><td>%s</td></tr>\n", $order;
1044 
 
1045 
            my $text = "Build:";
1046 
            foreach my $mach ( @machs )
1047 
            {
1048 
                my $type = $Package{$name}{$ver}{build}{$mach};
1049 
                printf DP "<tr>${tdr}$text</td><td>%s&nbsp;%s</td></tr>\n", $BM_ID{$mach} || "Unknown, $mach", $BSA_ID{$type} || 'Unknown';
1050 
                $text = '';
1051 
            }
1052 
 
1053 
            my $pvid = $Package{$name}{$ver}{pvid};
1054 
            $text = "Deployed:";
1055 
            foreach my $osid ( sort keys %{ $pv_id{$pvid}{os_id}  } )
1056 
            {
1057 
                my $os_name = $os_id_list{$osid}{os_name};
1058 
                my $node =    $os_id_list{$osid}{node_name};
1059 
 
1060 
                my $ref = $dm_base . $osid;
1061 
                my $str = "<a href=\"$ref\">$node,($os_name)</a>";
1062 
 
1063 
 
1064 
                printf DP "<tr>${tdr}$text</td><td>$str</td></tr>\n";
1065 
                $text = '';
1066 
            }
1067 
 
1068 
            if ( $stray )
1069 
            {
1070 
                printf DP "<tr>${tdr}Stray:</td><td>Package included indirectly</td></tr>\n";
1071 
            }
1072 
 
1073 
 
1074 
 
1075 
            print DP "</table>";
1076 
            print DP "</td>\n";
1077 
 
1078 
            #
1079 
            #   End of Row
1080 
            #
1081 
            print DP "</tr>\n";
1082 
        }
1083 
    }
237 dpurdie 1084 
    print DP "<tr>\n";
1085 
    print DP thl("Total Count: $package_count", 3);
1086 
    print DP "</tr>\n";
1087 
 
227 dpurdie 1088 
    print DP "</tbody></table>\n";
1089 
 
1090 
 
1091 
    #
1092 
    #   Multiple versions of a package
1093 
    #
1094 
    print DP "<h1><a name=\"Multi\">Multiple Package Versions</a></h1>\n";
1095 
    print DP "<table border=\"1\"><tbody>\n";
1096 
    print DP "<tr>\n";
237 dpurdie 1097 
    print DP th("Multiple Versions");
227 dpurdie 1098 
    print DP "</tr>\n";
237 dpurdie 1099 
    my $multiple_count = 0;
227 dpurdie 1100 
    foreach my $name ( sort keys %Package )
1101 
    {
1102 
        my @versions = keys %{$Package{$name}};
1103 
        next unless ( $#versions > 0 );
237 dpurdie 1104 
        $multiple_count++;
227 dpurdie 1105 
        print DP "<tr>\n";
1106 
        print DP $td;
1107 
        printf  DP "<dl><dt>$name</a> Versions:<dt>\n";
1108 
 
1109 
        foreach my $ver ( sort @versions )
1110 
        {
1111 
            my $tag = "${name}_${ver}";
1112 
            printf  DP "    <dd>";
1113 
            printf  DP "<a href=\"#$tag\">%s&nbsp;%s</a>\n", $name, $ver;
1114 
            print   DP " - Not in Release" if ($opt_rtag_id && $Package{$name}{$ver}{stray});
1115 
            printf  DP "</dd>\n", $name, $ver;
1116 
        }
1117 
        print DP "</dl>\n";
1118 
        print DP "</td>\n";
1119 
        print DP "</tr>\n";
1120 
    }
237 dpurdie 1121 
    print DP "<tr>\n";
1122 
    print DP thl("Total Count: $multiple_count");
1123 
    print DP "</tr>\n";
1124 
 
227 dpurdie 1125 
    print DP "</tbody></table>\n";
1126 
 
1127 
 
1128 
    #
233 dpurdie 1129 
    #   Leaf Packages
1130 
    #
1131 
    print DP "<h1><a name=\"Leaf\">Packages that have no parents</a></h1>\n";
1132 
    print DP "<table border=\"1\"><tbody>\n";
1133 
    print DP "<tr>\n";
237 dpurdie 1134 
    print DP th("Leaf Packages");
233 dpurdie 1135 
    print DP "</tr>\n";
237 dpurdie 1136 
    my $leaf_count = 0;
233 dpurdie 1137 
    foreach my $name ( sort keys %Package )
1138 
    {
1139 
        foreach my $ver ( sort keys %{$Package{$name}} )
1140 
        {
1141 
            my @usedby = keys %{$Package{$name}{$ver}{usedby}};
1142 
            next if ( @usedby );
237 dpurdie 1143 
            $leaf_count++;
233 dpurdie 1144 
 
1145 
            print DP "<tr>\n";
1146 
            print DP $td;
1147 
 
1148 
            my $tag = "${name}_${ver}";
1149 
 
1150 
            printf  DP "<dt><a href=\"#$tag\">%s&nbsp;%s</a>\n", $name, $ver;
1151 
 
1152 
            print DP "</td>\n";
1153 
            print DP "</tr>\n";
1154 
        }
1155 
    }
237 dpurdie 1156 
    print DP "<tr>\n";
1157 
    print DP thl("Total Count: $leaf_count");
1158 
    print DP "</tr>\n";
233 dpurdie 1159 
    print DP "</tbody></table>\n";
1160 
 
1161 
 
1162 
 
1163 
    #
227 dpurdie 1164 
    #   Packages that cannot be built
1165 
    #
1166 
    print DP "<h1><a name=\"NoBuild\">Packages that cannot be built</a></h1>\n";
1167 
    print DP "<table border=\"1\"><tbody>\n";
1168 
    print DP "<tr>\n";
237 dpurdie 1169 
    print DP th("Not Built");
227 dpurdie 1170 
    print DP "</tr>\n";
233 dpurdie 1171 
    my $no_build_count = 0;
227 dpurdie 1172 
 
1173 
    foreach my $name ( sort keys %Package )
1174 
    {
1175 
        my @versions = keys %{$Package{$name}};
1176 
        foreach my $ver ( sort @versions )
1177 
        {
1178 
            next unless exists($Package{$name}{$ver}{bad_extract});
233 dpurdie 1179 
            $no_build_count++;
227 dpurdie 1180 
            my @reasons = @{$Package{$name}{$ver}{bad_extract}};
1181 
 
1182 
            print DP "<tr><dl>\n";
1183 
            print DP $td;
1184 
 
1185 
            my $tag = "${name}_${ver}";
1186 
            my $anchor = "notbuilt_${name}_${ver}";
1187 
 
1188 
            printf  DP "<dt><a name=\"$anchor\"></a><a href=\"#$tag\">%s&nbsp;%s</a></dt>\n", $name, $ver;
1189 
            foreach my $reason ( @reasons )
1190 
            {
1191 
                print  DP "<dd>$reason</dd>\n";
1192 
            }
1193 
 
1194 
 
1195 
            print DP "</dl>\n";
1196 
            print DP "</td>\n";
1197 
            print DP "</tr>\n";
1198 
 
1199 
        }
1200 
    }
233 dpurdie 1201 
    print DP "<tr>\n";
237 dpurdie 1202 
    print DP thl("Total Count: $no_build_count");
233 dpurdie 1203 
    print DP "</tr>\n";
1204 
 
227 dpurdie 1205 
    print DP "</tbody></table>\n";
1206 
 
1207 
    #
1208 
    #   Packages that are in a specified release, but not described by the SBOM
1209 
    #
237 dpurdie 1210 
    if ( $opt_rtag_id && ($opt_sbom_id || $opt_rootpkg) )
227 dpurdie 1211 
    {
1212 
        print DP "<h1><a name=\"Excess\">Excess Packages from Release: $opt_rtag_id</a></h1>\n";
1213 
        print DP "<table border=\"1\"><tbody>\n";
1214 
        print DP "<tr>\n";
237 dpurdie 1215 
        print DP th("Excess Packages",3);
227 dpurdie 1216 
        print DP "</tr>\n";
1217 
 
1218 
        print DP "<tr>\n";
237 dpurdie 1219 
        print DP th("Package");
1220 
        print DP th("PVID");
1221 
        print DP th("Used Package");
227 dpurdie 1222 
        print DP "</tr>\n";
1223 
 
1224 
        my $were_found = 0;
1225 
        my $not_found = 0;
1226 
        foreach my $name ( sort keys %Release )
1227 
        {
1228 
            my @versions = keys %{$Release{$name}};
1229 
            foreach my $ver ( sort @versions )
1230 
            {
1231 
                if (exists($Package{$name}{$ver}))
1232 
                {
1233 
                    $were_found++;
1234 
                    next;
1235 
                }
1236 
                $not_found++;
1237 
 
1238 
                print DP "<tr>\n";
1239 
                print DP $td;
1240 
 
1241 
                my $pv_id = $Release{$name}{$ver}{pv_id} || 'No PVID';
1242 
                my $pv_id_ref = $rm_base . $pv_id . "&rtag_id=" . $opt_rtag_id;
233 dpurdie 1243 
                my $pv_id_str = "<a href=\"$pv_id_ref\" TARGET=\"_blank\">$pv_id</a>";
227 dpurdie 1244 
 
1245 
                printf  DP "$name $ver ", $name, $ver;
1246 
                print DP "</td>\n";
1247 
 
1248 
                print DP $td;
1249 
                printf DP "Pvid: %s\n", $pv_id_str;
1250 
                print DP "</td>\n";
1251 
 
1252 
                print DP $td;
1253 
                my @pver = keys %{$Package{$name}};
1254 
                if (@pver)
1255 
                {
1256 
                    printf  DP "<dl><dt> Uses Versions:<dt>\n";
1257 
                    foreach my $ver ( sort @pver  )
1258 
                    {
1259 
                        my $tag = "${name}_${ver}";
1260 
                        printf  DP "    <dd><a href=\"#$tag\">%s&nbsp;%s</a></dd>\n", $name, $ver;
1261 
                    }
1262 
                    print DP "</dl>\n";
1263 
                }
1264 
                else
1265 
                {
1266 
                    printf DP "No Versions of this package used\n"
1267 
                }
1268 
                print DP "</td>\n";
1269 
 
1270 
 
1271 
                print DP "</tr>\n";
1272 
            }
1273 
        }
1274 
 
1275 
        print DP "<tr>\n";
237 dpurdie 1276 
        print DP thl("Packages found in SBOM: $were_found",3);
227 dpurdie 1277 
        print DP "</td>\n";
1278 
        print DP "</tr>\n";
1279 
 
1280 
        print DP "<tr>\n";
237 dpurdie 1281 
        print DP thl("Packages NOT found in SBOM: $not_found", 3);
227 dpurdie 1282 
        print DP "</td>\n";
1283 
        print DP "</tr>\n";
1284 
 
1285 
        print DP "</tbody></table>\n";
1286 
    }
1287 
 
1288 
    #
1289 
    #   Packages that are strays
1290 
    #   They are not top level packages in the release
1291 
    #
237 dpurdie 1292 
    if ( $opt_rtag_id && ! ($opt_sbom_id || $opt_rootpkg) )
227 dpurdie 1293 
    {
1294 
        print DP "<h1><a name=\"Stray\">Required Packages, not part of the release</a></h1>\n";
1295 
        print DP "<table border=\"1\"><tbody>\n";
1296 
        print DP "<tr>\n";
237 dpurdie 1297 
        print DP th("Stray Packages",3);
227 dpurdie 1298 
        print DP "</tr>\n";
1299 
 
1300 
        print DP "<tr>\n";
237 dpurdie 1301 
        print DP th("Inconsisient Package");
1302 
        print DP th("PVID");
1303 
        print DP th("Preferred Package");
227 dpurdie 1304 
        print DP "</tr>\n";
237 dpurdie 1305 
        my $stray_count = 0;
227 dpurdie 1306 
 
1307 
        foreach my $name ( sort keys %Package )
1308 
        {
1309 
 
1310 
            my @versions = keys %{$Package{$name}};
1311 
            foreach my $ver ( sort @versions )
1312 
            {
1313 
                unless (exists($Package{$name}{$ver}{stray}) && $Package{$name}{$ver}{stray} )
1314 
                {
1315 
                    next;
1316 
                }
1317 
 
1318 
                #
1319 
                #   Determine preferred package version(s)
1320 
                #   These will be those without a 'stray' tag
1321 
                #
1322 
                my @preferred = ();
1323 
                foreach my $pver ( keys %{$Package{$name}} )
1324 
                {
1325 
                    next if (exists($Package{$name}{$pver}{stray} ) && $Package{$name}{$pver}{stray} );
1326 
                    push @preferred, $pver;
1327 
                }
1328 
 
1329 
                print DP "<tr>\n";
237 dpurdie 1330 
                $stray_count++;
227 dpurdie 1331 
 
1332 
                #
1333 
                #  Package name and Used By information
1334 
                #
1335 
                print DP $td;
1336 
                my $anchor= "usedby_${name}_${ver}";
1337 
                my $tag = "${name}_${ver}";
1338 
                printf  DP "<dl><dt><a name=\"$anchor\"></a><a href=\"#$tag\">%s&nbsp;%s</a> Used by:</dt>\n", $name, $ver;
1339 
                foreach my $depend ( sort keys %{$Package{$name}{$ver}{usedby}} )
1340 
                {
1341 
                    my ($dname, $dver) = split $;, $depend;
1342 
                    my $tag = "usedby_${dname}_${dver}";
1343 
                    printf  DP "    <dd><a href=\"#$tag\">%s&nbsp;%s</a></dd>\n", $dname, $dver;
1344 
                }
1345 
                print DP "</dl>\n";
1346 
                print DP "</td>\n";
1347 
 
1348 
 
1349 
                my $pv_id = $Package{$name}{$ver}{pvid} || 'No PVID';
1350 
 
1351 
                my $pv_id_ref = $rm_base . $pv_id;
233 dpurdie 1352 
                my $pv_id_str = "<a href=\"$pv_id_ref\" TARGET=\"_blank\">$pv_id</a>";
227 dpurdie 1353 
 
1354 
                print DP $td;
1355 
                printf DP "Pvid: %s\n", $pv_id_str;
1356 
                print DP "</td>\n";
1357 
 
1358 
                #
1359 
                #   Insert Preferred package(s)
1360 
                #
1361 
                print DP $td;
1362 
                print DP "<table>\n";
1363 
                foreach my $pver ( sort @preferred )
1364 
                {
1365 
                    my $tag = "${name}_${pver}";
1366 
                    printf  DP "<tr><td><a href=\"#$tag\">%s&nbsp;%s</a></td></tr>\n", $name, $pver;
1367 
                }
1368 
 
1369 
                print DP "</table>\n";
1370 
                print DP "</tr>\n";
1371 
 
1372 
            }
1373 
        }
1374 
 
237 dpurdie 1375 
        print DP "<tr>\n";
1376 
        print DP thl("Total Count: $stray_count", 3);
1377 
        print DP "</tr>\n";
227 dpurdie 1378 
        print DP "</tbody></table>\n";
1379 
    }
1380 
 
1381 
    #
1382 
    #   Packages that have components not in the release
1383 
    #   They are not top level packages in the release
1384 
    #
1385 
    if ( $opt_rtag_id && !$opt_sbom_id )
1386 
    {
1387 
        print DP "<h1><a name=\"Inconsistent\">Packages in the Release, with inconsistent dependencies</a></h1>\n";
1388 
        print DP "<table border=\"1\"><tbody>\n";
1389 
 
1390 
        print DP "<tr>\n";
237 dpurdie 1391 
        print DP th("Inconsisient Package");
227 dpurdie 1392 
        print DP "</tr>\n";
237 dpurdie 1393 
        my $inconsistent_count = 0;
227 dpurdie 1394 
 
1395 
        foreach my $name ( sort keys %Package )
1396 
        {
1397 
 
1398 
            my @versions = keys %{$Package{$name}};
1399 
            foreach my $ver ( sort @versions )
1400 
            {
1401 
                #
1402 
                #   Ignore 'stray' packages
1403 
                #
1404 
                next if (exists($Package{$name}{$ver}{stray}) && $Package{$name}{$ver}{stray} );
1405 
 
1406 
                #
1407 
                #   Is it inconsitient
1408 
                #
1409 
                my $ok = 1;
1410 
                foreach my $depend ( sort keys %{$Package{$name}{$ver}{depends}} )
1411 
                {
1412 
                    my ($dname, $dver) = split $;, $depend;
1413 
                    if (exists($Package{$dname}{$dver}{stray}) && $Package{$dname}{$dver}{stray} )
1414 
                    {
1415 
                        $ok = 0;
1416 
                        last;
1417 
                    }
1418 
                }
1419 
 
1420 
                next if ( $ok );
237 dpurdie 1421 
                $inconsistent_count++;
227 dpurdie 1422 
 
1423 
                #
1424 
                #   Depends On info
1425 
                #
1426 
 
1427 
                print DP "<tr>\n";
1428 
                print DP $td;
1429 
                my $anchor= "${name}_${ver}";
1430 
                my $tag = "usedby_${name}_${ver}";
1431 
                printf  DP "<dl><dt><a name=\"$anchor\"></a><a href=\"#$tag\">%s&nbsp;%s</a> Inconsistent::</dt>\n", $name, $ver;
1432 
                foreach my $depend ( sort keys %{$Package{$name}{$ver}{depends}} )
1433 
                {
1434 
                    my ($dname, $dver) = split $;, $depend;
1435 
                    next unless (exists($Package{$dname}{$dver}{stray}) && $Package{$dname}{$dver}{stray} );
1436 
 
1437 
                    my $tag = "${dname}_${dver}";
1438 
                    printf  DP "    <dd><a href=\"#$tag\">%s&nbsp;%s</a></dd>\n", $dname, $dver;
1439 
                }
1440 
                print DP "</dl>\n";
1441 
                print DP "</td>\n";
1442 
                print DP "<tr>\n";
1443 
 
1444 
            }
1445 
        }
1446 
 
237 dpurdie 1447 
        print DP "<tr>\n";
1448 
        print DP thl("Total Count: $inconsistent_count");
1449 
        print DP "</tr>\n";
227 dpurdie 1450 
        print DP "</tbody></table>\n";
1451 
    }
1452 
 
1453 
    close DP;
1454 
}
1455 
 
1456 
#-------------------------------------------------------------------------------
1457 
# Function        : extract_files
1458 
#
1459 
# Description     : Alternate mode of operation
1460 
#                   Extract files from the generated list. This is intended to
235 dpurdie 1461 
#                   be run as a seperate phase taking the 'extract' file
227 dpurdie 1462 
#
1463 
# Inputs          :
1464 
#
1465 
# Returns         :
1466 
#
1467 
sub extract_files
1468 
{
1469 
    my @extract_order;
1470 
    my %extract;
1471 
    ErrorConfig( 'name'    => 'ESCROW-EXTRACT' );
1472 
 
1473 
    #
1474 
    #   Open the file and read in data in one hit
1475 
    #   This will detect file errors early
1476 
    #
1477 
    Error ("Cannot find specified file: $opt_extract")
1478 
        unless ( -f $opt_extract );
1479 
 
1480 
    open (FH, "<$opt_extract" ) || Error ("Cannot open file");
1481 
    while ( <FH> )
1482 
    {
1483 
        s~[\r\n]+$~~;
1484 
        next unless ( $_ );
1485 
 
1486 
        my ($view, $label, $path);
235 dpurdie 1487 
        if ( m~\s-view=(\S+)~ )
227 dpurdie 1488 
        {
235 dpurdie 1489 
            $view = $1;
227 dpurdie 1490 
        }
1491 
 
235 dpurdie 1492 
        if ( m~\s-label=(\S+)~ )
1493 
        {
1494 
            $label = $1;
1495 
        }
1496 
 
1497 
        if ( m~\s-path="(.+)"~ )
1498 
        {
1499 
            $path = $1;
1500 
        }
1501 
        elsif ( m~\s-path=(\S+)~ )
1502 
        {
1503 
            $path = $1;
1504 
        }
1505 
 
1506 
        Error "Bad file format in line: $_" unless ( $view && $label );
227 dpurdie 1507 
        Error "Duplicate view name: $view" if ( exists $extract{$view} );
1508 
        push @extract_order, $view;
1509 
        $extract{$view}{label} = $label;
1510 
        $extract{$view}{path} = $path;
1511 
    }
1512 
    close FH;
1513 
 
1514 
    #
1515 
    #   Log the file processing
1516 
    #
1517 
    my $lfile = "${opt_extract}.log";
1518 
    open (FH, ">$lfile" ) || Error ("Cannot open log file: $lfile");
1519 
 
1520 
    #
1521 
    #   Process each entry
1522 
    #
1523 
    foreach my $view ( @extract_order )
1524 
    {
1525 
        my $label = $extract{$view}{label};
1526 
        my $path = $extract{$view}{path};
235 dpurdie 1527 
        my $rv = JatsCmd ("extract -extractfiles -view=$view -label=$label -path=\"$path\" -root=. -noprefix");
227 dpurdie 1528 
        print FH "$view : SUCCESS\n" unless $rv;
1529 
        print FH "$view : ERROR\n" if $rv;
1530 
    }
1531 
    close FH;
1532 
 
1533 
}
1534 
 
1535 
 
1536 
#-------------------------------------------------------------------------------
1537 
#   Documentation
1538 
#
1539 
 
1540 
=pod
1541 
 
1542 
=head1 NAME
1543 
 
1544 
escrow - Extract Escrow Build Information
1545 
 
1546 
=head1 SYNOPSIS
1547 
 
1548 
  jats escrow [options]
1549 
 
1550 
 Options:
1551 
    -help              - brief help message
1552 
    -help -help        - Detailed help message
1553 
    -man               - Full documentation
1554 
    -sbomid=xxx        - Specify the SBOM to process
1555 
    -rtagid=xxx        - Specify the Release to process (Optional)
1556 
    -ignore=name       - Ignore packages with the specified name
1557 
    -extract=fname     - Extract files from a previous run
1558 
    -verbose           - Enable verbose output
1559 
    -[no]patch         - Ignore/Include patches. Default:Include
1560 
    -[no]test          - Reduced package scanning for test
1561 
 
1562 
=head1 OPTIONS
1563 
 
1564 
=over 8
1565 
 
1566 
=item B<-help>
1567 
 
1568 
Print a brief help message and exits.
1569 
 
1570 
=item B<-help -help>
1571 
 
1572 
Print a detailed help message with an explanation for each option.
1573 
 
1574 
=item B<-man>
1575 
 
1576 
Prints the manual page and exits.
1577 
 
1578 
=item B<-sbomid=xxx>
1579 
 
1580 
This option is mandatory. It specifies the SBOM to process. The sbomid must be
1581 
determined from Deployment Manager.
1582 
 
1583 
=item B<-rtagid=xxx>
1584 
 
1585 
If provided, this option specifies an RTAG_ID to process in conjunction with the SBOM.
1586 
The RTAG_ID must be determined from Release Manager. The program will determine
1587 
packages that are in th Release, but not in the SBOM.
1588 
 
1589 
=item B<-ignore=name>
1590 
 
1591 
All versions of the named package will be ignored. This parameter is options.
1592 
It may be used multiple times.
1593 
 
1594 
=item B<-extract=name>
1595 
 
1596 
This option will process the 'extract' file created in a previous run of this
1597 
program and extract source files for the package-versions found in the file.
1598 
 
1599 
The command will then create a log file recording packages that could ne be
1600 
extracted.
1601 
 
1602 
This option cannot be used in conjunction wit the -rtagid or -sbomid.
1603 
 
1604 
=item B<-[no]patch>
1605 
 
1606 
This option is used ignore patches. If -nopatch is selected, then packages
1607 
versions that look like a patch will be added to the ignore list.
1608 
 
1609 
=item B<-[no]test>
1610 
 
1611 
This option is used for testing. It will only process the first two OS entries
1612 
in the SBOM. This speeds up processing. It does not generate a complete list of
1613 
packages.
1614 
 
1615 
=item B<verbose>
1616 
 
1617 
This option will display progress information as the program executes.
1618 
 
1619 
=back
1620 
 
1621 
=head1 DESCRIPTION
1622 
 
1623 
This program is a tool for extracting Escrow build information.
1624 
 
1625 
Given an SBOM_ID this program will:
1626 
 
1627 
=over 8
1628 
 
1629 
=item * Determine all the NODES in the SBOM
1630 
 
1631 
=item * Determine all the Base Packages for each NODE
1632 
 
1633 
=item * Determine all the Packages for each NODE
1634 
 
1635 
=item * Determine all the dependent packages for all packages encountered
1636 
 
1637 
=item * Generate a list of jats commands to extract the package source
1638 
 
1639 
=item * Generate a file describing the build order
1640 
 
1641 
=item * Generate a file describing the packages that cannot be built
1642 
 
1643 
=item * Generate an HTML file with extensive cross reference information
1644 
 
1645 
=over 8
1646 
 
1647 
=item * List of all packages with references into Release Manager
1648 
 
1649 
=item * List of all packages showing dependent packages
1650 
 
1651 
=item * List of all packages showing consumer packages
1652 
 
1653 
=item * List of all packages for which multiple versions are required
1654 
 
1655 
=item * Details of packages that are not built.
1656 
 
1657 
=item * Build order
1658 
 
1659 
=item * Build machines and built types
1660 
 
1661 
=item * Deployed target nodes, with references into deployment manager
1662 
 
1663 
=back
1664 
 
1665 
=back
1666 
 
1667 
This may take some time, as a typical escrow build may contain many hundreds of packages.
1668 
 
1669 
The program will display a list of files that have been created.
1670 
 
1671 
Given an 'extract' file from a previous run of this program the program will:
1672 
 
1673 
=over 8
1674 
 
1675 
=item * Parse the 'extract' file
1676 
 
1677 
=item * Create subdirectoroes for each package version within the file. This is done
1678 
in such a way that no views are left in place.
1679 
 
1680 
=item * Create a log file showing packages that could not be extracted.
1681 
 
1682 
 
1683 
=back
1684 
 
1685 
=cut
1686