Subversion Repositories DevTools

Rev

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

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