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();
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
1567 
    #
1568 
    Error ("Cannot find specified file: $opt_extract")
1569 
        unless ( -f $opt_extract );
1570 
 
1571 
    open (FH, "<$opt_extract" ) || Error ("Cannot open file");
1572 
    while ( <FH> )
1573 
    {
1574 
        s~[\r\n]+$~~;
1575 
        next unless ( $_ );
1576 
 
1577 
        my ($view, $label, $path);
235 dpurdie 1578 
        if ( m~\s-view=(\S+)~ )
227 dpurdie 1579 
        {
235 dpurdie 1580 
            $view = $1;
227 dpurdie 1581 
        }
1582 
 
235 dpurdie 1583 
        if ( m~\s-label=(\S+)~ )
1584 
        {
1585 
            $label = $1;
1586 
        }
1587 
 
1588 
        if ( m~\s-path="(.+)"~ )
1589 
        {
1590 
            $path = $1;
1591 
        }
1592 
        elsif ( m~\s-path=(\S+)~ )
1593 
        {
1594 
            $path = $1;
1595 
        }
1596 
 
1597 
        Error "Bad file format in line: $_" unless ( $view && $label );
227 dpurdie 1598 
        Error "Duplicate view name: $view" if ( exists $extract{$view} );
1599 
        push @extract_order, $view;
1600 
        $extract{$view}{label} = $label;
1601 
        $extract{$view}{path} = $path;
1602 
    }
1603 
    close FH;
1604 
 
1605 
    #
1606 
    #   Log the file processing
1607 
    #
1608 
    my $lfile = "${opt_extract}.log";
1609 
    open (FH, ">$lfile" ) || Error ("Cannot open log file: $lfile");
1610 
 
1611 
    #
1612 
    #   Process each entry
1613 
    #
1614 
    foreach my $view ( @extract_order )
1615 
    {
1616 
        my $label = $extract{$view}{label};
1617 
        my $path = $extract{$view}{path};
235 dpurdie 1618 
        my $rv = JatsCmd ("extract -extractfiles -view=$view -label=$label -path=\"$path\" -root=. -noprefix");
227 dpurdie 1619 
        print FH "$view : SUCCESS\n" unless $rv;
1620 
        print FH "$view : ERROR\n" if $rv;
1621 
    }
1622 
    close FH;
1623 
 
1624 
}
1625 
 
1626 
 
1627 
#-------------------------------------------------------------------------------
1628 
#   Documentation
1629 
#
1630 
 
1631 
=pod
1632 
 
1633 
=head1 NAME
1634 
 
1635 
escrow - Extract Escrow Build Information
1636 
 
1637 
=head1 SYNOPSIS
1638 
 
1639 
  jats escrow [options]
1640 
 
1641 
 Options:
1642 
    -help              - brief help message
1643 
    -help -help        - Detailed help message
1644 
    -man               - Full documentation
1645 
    -sbomid=xxx        - Specify the SBOM to process
1646 
    -rtagid=xxx        - Specify the Release to process (Optional)
1647 
    -ignore=name       - Ignore packages with the specified name
1648 
    -extract=fname     - Extract files from a previous run
1649 
    -verbose           - Enable verbose output
1650 
    -[no]patch         - Ignore/Include patches. Default:Include
1651 
    -[no]test          - Reduced package scanning for test
1652 
 
1653 
=head1 OPTIONS
1654 
 
1655 
=over 8
1656 
 
1657 
=item B<-help>
1658 
 
1659 
Print a brief help message and exits.
1660 
 
1661 
=item B<-help -help>
1662 
 
1663 
Print a detailed help message with an explanation for each option.
1664 
 
1665 
=item B<-man>
1666 
 
1667 
Prints the manual page and exits.
1668 
 
1669 
=item B<-sbomid=xxx>
1670 
 
1671 
This option is mandatory. It specifies the SBOM to process. The sbomid must be
1672 
determined from Deployment Manager.
1673 
 
1674 
=item B<-rtagid=xxx>
1675 
 
1676 
If provided, this option specifies an RTAG_ID to process in conjunction with the SBOM.
1677 
The RTAG_ID must be determined from Release Manager. The program will determine
1678 
packages that are in th Release, but not in the SBOM.
1679 
 
1680 
=item B<-ignore=name>
1681 
 
1682 
All versions of the named package will be ignored. This parameter is options.
1683 
It may be used multiple times.
1684 
 
1685 
=item B<-extract=name>
1686 
 
1687 
This option will process the 'extract' file created in a previous run of this
1688 
program and extract source files for the package-versions found in the file.
1689 
 
1690 
The command will then create a log file recording packages that could ne be
1691 
extracted.
1692 
 
1693 
This option cannot be used in conjunction wit the -rtagid or -sbomid.
1694 
 
1695 
=item B<-[no]patch>
1696 
 
1697 
This option is used ignore patches. If -nopatch is selected, then packages
1698 
versions that look like a patch will be added to the ignore list.
1699 
 
1700 
=item B<-[no]test>
1701 
 
1702 
This option is used for testing. It will only process the first two OS entries
1703 
in the SBOM. This speeds up processing. It does not generate a complete list of
1704 
packages.
1705 
 
1706 
=item B<verbose>
1707 
 
1708 
This option will display progress information as the program executes.
1709 
 
1710 
=back
1711 
 
1712 
=head1 DESCRIPTION
1713 
 
1714 
This program is a tool for extracting Escrow build information.
1715 
 
1716 
Given an SBOM_ID this program will:
1717 
 
1718 
=over 8
1719 
 
1720 
=item * Determine all the NODES in the SBOM
1721 
 
1722 
=item * Determine all the Base Packages for each NODE
1723 
 
1724 
=item * Determine all the Packages for each NODE
1725 
 
1726 
=item * Determine all the dependent packages for all packages encountered
1727 
 
1728 
=item * Generate a list of jats commands to extract the package source
1729 
 
1730 
=item * Generate a file describing the build order
1731 
 
1732 
=item * Generate a file describing the packages that cannot be built
1733 
 
1734 
=item * Generate an HTML file with extensive cross reference information
1735 
 
1736 
=over 8
1737 
 
1738 
=item * List of all packages with references into Release Manager
1739 
 
1740 
=item * List of all packages showing dependent packages
1741 
 
1742 
=item * List of all packages showing consumer packages
1743 
 
1744 
=item * List of all packages for which multiple versions are required
1745 
 
1746 
=item * Details of packages that are not built.
1747 
 
1748 
=item * Build order
1749 
 
1750 
=item * Build machines and built types
1751 
 
1752 
=item * Deployed target nodes, with references into deployment manager
1753 
 
1754 
=back
1755 
 
1756 
=back
1757 
 
1758 
This may take some time, as a typical escrow build may contain many hundreds of packages.
1759 
 
1760 
The program will display a list of files that have been created.
1761 
 
1762 
Given an 'extract' file from a previous run of this program the program will:
1763 
 
1764 
=over 8
1765 
 
1766 
=item * Parse the 'extract' file
1767 
 
1768 
=item * Create subdirectoroes for each package version within the file. This is done
1769 
in such a way that no views are left in place.
1770 
 
1771 
=item * Create a log file showing packages that could not be extracted.
1772 
 
1773 
 
1774 
=back
1775 
 
1776 
=cut
1777