Subversion Repositories DevTools

Rev

Rev 5710 | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
392 dpurdie 1
########################################################################
6177 dpurdie 2
# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.
392 dpurdie 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.006_001;
21
use strict;
22
use warnings;
23
use JatsError;
24
use DBI;
25
use JatsRmApi;
26
use Getopt::Long;
27
use Pod::Usage;                             # required for help support
28
use Storable qw (dclone);
29
 
30
 
31
#
32
#   Config Options
33
#
34
my $VERSION = "1.0.0";              # Update this
35
my $opt_help = 0;
36
my $opt_manual;
37
my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose
38
my $opt_sbom_id;
39
my $opt_test = 0;
40
 
41
#
42
#   Global variables
43
#
44
my %os_id_list;                 # os_id in the SBOM
45
my %os_env_list;                # OS Environments
46
my %pv_id;                      # Packages in the SBOM
47
my %Package;                    # Per Package information
48
my @StrayPackages;              # Non-top level packages
49
my @create_list;                # List of files created
50
my $RM_DB;
51
my $DM_DB;
52
our $GBE_RM_BASE;
53
our $GBE_DM_BASE;
54
 
55
#
56
#   Constants, that should be variable
57
#
58
my $rm_base = "/dependencies.asp?pv_id=";
59
my $dm_base = "/OsDefault.asp?bom_id=BOMID&os_id=";
60
 
61
#
62
#   Build types. Should be populated from a table
63
#
64
my %BM_ID = (
65
    1 => "Solaris",
66
    2 => "Win32",
67
    3 => "Linux",
68
    4 => "Generic",
69
);
70
 
71
my %BSA_ID = (
72
    1 => "Jats Debug",
73
    2 => "Jats Prod",
74
    3 => "Jats Debug+Prod",
75
    4 => "Ant Java 1.4",
76
    5 => "Ant Java 1.5",
77
);
78
 
79
 
80
#-------------------------------------------------------------------------------
81
# Function        : Main
82
#
83
# Description     : Main entry point
84
#                   Parse user options
85
#
86
# Inputs          :
87
#
88
# Returns         :
89
#
90
 
91
my $result = GetOptions (
92
                "help+"         => \$opt_help,              # flag, multiple use allowed
93
                "manual"        => \$opt_manual,            # flag
94
                "verbose+"      => \$opt_verbose,           # flag
95
                "sbomid=s"      => \$opt_sbom_id,           # string
96
                "test!"         => \$opt_test,              #[no]flag
97
                );
98
 
99
#
100
#   Process help and manual options
101
#
102
pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result);
103
pod2usage(-verbose => 1)  if ($opt_help == 2 );
104
pod2usage(-verbose => 2)  if ($opt_manual || ($opt_help > 2));
105
 
106
ErrorConfig( 'name'    => 'ESCROW',
107
             'verbose' => $opt_verbose );
108
 
109
#
110
#   Sanity test
111
#
112
Error ("No sbomid provided.", "example: -sbomid=13543, for NZS Phase-1") unless ( $opt_sbom_id );
113
$dm_base =~ s~BOMID~$opt_sbom_id~;
114
 
115
#
116
#
117
#   Import essential EnvVars
118
#
119
EnvImport('GBE_RM_URL');
120
EnvImport('GBE_DM_URL');
121
 
122
$rm_base = $GBE_RM_BASE . $rm_base;
123
$dm_base = $GBE_DM_BASE . $dm_base;
124
 
125
#
126
#   Determines the OS_ID's for the bom
127
#
128
getOSIDforBOMID($opt_sbom_id);
129
 
130
#
131
#   Locate packages associated with the base install for each os
132
#
133
foreach my $base_env_id ( sort keys %os_env_list )
134
{
135
    getPackagesforBaseInstall( $base_env_id );
136
}
137
 
138
#
139
#   Determine all the top level packages in the BOM
140
#
141
foreach my $os_id ( sort keys %os_id_list )
142
{
143
    getPackages_by_osid( $os_id );
144
}
145
 
146
 
147
#
148
#   For each Top Level Package determine the dependent packages
149
#
150
foreach my $pv_id ( keys %pv_id )
151
{
152
    getPkgDetailsByPV_ID( $pv_id);
153
}
154
LocateStrays();
155
 
156
##
157
##   Display a list of all packages found so far
158
##
159
#foreach my $name ( sort keys %Package )
160
#{
161
#    foreach my $ver ( sort keys %{$Package{$name}} )
162
#    {
163
#
164
#        my $label = $Package{$name}{$ver}{label} || '';
165
#        my $path = $Package{$name}{$ver}{path} || '';
166
#
167
#        printf ("%30s %15s %45s %s\n", $name, $ver, $label, $path );
168
#    }
169
#}
170
 
171
#
172
#   Generate output files
173
#       1) Jats extract commands
174
#       2) Error list
175
my $file;
176
$file = "sbom_extract.txt";
177
push @create_list, $file;
178
open (JE, ">$file" ) || Error ("Cannot create $file");
179
 
180
$file = "sbom_status.txt";
181
push @create_list, $file;
182
 
183
open (ST, ">$file" ) || Error("Cannot create $file");
184
print ST "Cannot build:\n";
185
 
186
foreach my $name ( sort keys %Package )
187
{
188
    foreach my $ver ( sort keys %{$Package{$name}} )
189
    {
190
 
191
        my $label = $Package{$name}{$ver}{label} || '';
192
        my $path = $Package{$name}{$ver}{path} || '';
193
        my $mtest = exists ($Package{$name}{$ver}{build} ) || '0';
194
        my @reason;
195
 
196
        push @reason, 'No Label' unless ( $label );
197
        push @reason, 'Bad Label, N/A' if ( $label =~ s~^N/A$~~i || $label  =~ s~^na$~~i );
198
 
199
        push @reason, 'No Source Path' unless ( $path );
200
        push @reason, 'Bad Path, N/A' if ( $path =~ m~^N/A$~i || $path  =~ m~^na$~i );
201
        push @reason, 'Bad Path, dpkg' if ( $path =~ m~^/dpkg_archive~ || $path  =~ m~^dpkg_archive~ );
202
        push @reason, 'Bad Path, http' if ( $path =~ m~^http:~i );
203
 
204
        push @reason, 'No Build System' unless ( exists ($Package{$name}{$ver}{build} ) );
205
 
206
        unless ( @reason )
207
        {
208
            my $vname = "$name $ver";
209
            $vname =~ s~ ~_~g;
210
            $vname =~ s~__~~g;
211
 
212
            print JE "jats extract -view=$vname -label=$label -path=$path -root=. -noprefix\n";
213
        }
214
        else
215
        {
216
            $Package{$name}{$ver}{bad_extract} = [@reason];
217
            printf ST "%40s %20s %50s (%s) %s\n", $name, $ver, $label, $mtest, $path ;
218
        }
219
    }
220
}
221
 
222
close (JE);
223
close (ST);
224
 
225
#
226
#   Generate build order info
227
#
228
BuildOrder();
229
 
230
#
231
#   Generate depenedancy information and other useful stuff
232
#
233
ShowDepends();
234
 
235
 
236
#
237
#   Display names of files created
238
#
239
foreach my $file ( sort @create_list )
240
{
241
    Message ("Created: $file");
242
}
243
exit;
244
 
245
 
246
#-------------------------------------------------------------------------------
247
# Function        : getOSIDforBOMID
248
#
249
# Description     : Get all the os_id's associated with a BOMID
250
#
251
# Inputs          : $bom_id             - BOM to process
252
#
253
# Returns         :
254
#
255
 
256
sub getOSIDforBOMID
257
{
258
    my ($bom_id) = @_;
259
    my $foundDetails = 0;
260
    my (@row);
261
 
262
    connectDM( \$DM_DB) unless $DM_DB;
263
 
264
    my $m_sqlstr = "SELECT distinct os.OS_ID, os.OS_NAME, nn.NODE_NAME, obe.BASE_ENV_ID " .
265
                   " FROM OPERATING_SYSTEMS os, BOM_CONTENTS bc, NETWORK_NODES nn, OS_BASE_ENV obe" .
266
                   " 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 ";
267
 
268
    my $sth = $DM_DB->prepare($m_sqlstr);
269
    if ( defined($sth) )
270
    {
271
        if ( $sth->execute( ) )
272
        {
273
            if ( $sth->rows )
274
            {
275
                while ( @row = $sth->fetchrow_array )
276
                {
277
                    Verbose ("OS_ID: ".join (',',@row) );
278
                    $os_id_list{$row[0]}{os_name} = $row[1];
279
                    $os_id_list{$row[0]}{node_name} = $row[2];
280
 
281
                    $os_env_list{$row[3]}{needed} = 1;
282
                    $os_env_list{$row[3]}{os_id}{$row[0]} = 1;
283
                }
284
            }
285
            $sth->finish();
286
        }
287
    }
288
    else
289
    {
290
        Error("getOSIDforBOMID:Prepare failure" );
291
    }
292
}
293
 
294
#-------------------------------------------------------------------------------
295
# Function        : getPackagesforBaseInstall
296
#
297
# Description     : Get all the packages for a given base install
298
#
299
# Inputs          :
300
#
301
# Returns         :
302
#
303
 
304
sub getPackagesforBaseInstall
305
{
306
    my ($base_env_id) =@_;
307
    my $foundDetails = 0;
308
    my (@row);
309
 
310
    connectDM( \$DM_DB) unless $DM_DB;
311
 
312
    # First get details from pv_id
313
 
314
    my $m_sqlstr = "SELECT DISTINCT bec.PROD_ID, pkg.pkg_name, pv.pkg_version, pkg.pkg_id, pv.pv_id" .
315
                " FROM PACKAGES pkg, PACKAGE_VERSIONS pv,PRODUCT_DETAILS pd, BASE_ENV_CONTENTS bec".
316
                " WHERE bec.BASE_ENV_ID = $base_env_id AND bec.PROD_ID (+)= pv.PV_ID AND pv.pkg_id = pkg.pkg_id";
317
 
318
    my $sth = $DM_DB->prepare($m_sqlstr);
319
    if ( defined($sth) )
320
    {
321
        if ( $sth->execute( ) )
322
        {
323
            if ( $sth->rows )
324
            {
325
                while ( @row = $sth->fetchrow_array )
326
                {
327
                    Verbose ("OS ENV Package($base_env_id}:" . join (',',@row) );
328
 
329
                    my $pv_id =     $row[0];
330
                    my $name =      $row[1]  || 'BadName';
331
                    my $ver =       $row[2]  || 'BadVer';
332
 
333
                    $pv_id{$pv_id}{pkg_name} =$name;
334
                    $pv_id{$pv_id}{pkg_ver} = $ver;
335
                    foreach my $os_id ( keys %{$os_env_list{$base_env_id}{os_id}} )
336
                    {
337
                        $pv_id{$pv_id}{os_id}{$os_id} = 2;
338
                    }
339
                }
340
            }
341
            $sth->finish();
342
        }
343
        else
344
        {
345
            Error ("getPackagesforBaseInstall: Execute error");
346
        }
347
    }
348
    else
349
    {
350
        Error("getPackagesforBaseInstall:Prepare failure" );
351
    }
352
 
353
}
354
 
355
 
356
#-------------------------------------------------------------------------------
357
# Function        : getPackages_by_osid
358
#
359
# Description     : Get all the packages used by a given os_id
360
#
361
# Inputs          :
362
#
363
# Returns         :
364
#
365
 
366
my $count = 0;
367
sub getPackages_by_osid
368
{
369
    my ($os_id) =@_;
370
    my $foundDetails = 0;
371
    my (@row);
372
 
373
    connectDM( \$DM_DB) unless $DM_DB;
374
 
375
    # First get details from pv_id
376
 
377
    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" .
378
                " FROM PACKAGES pkg, PACKAGE_VERSIONS pv,PRODUCT_DETAILS pd,".
379
	            "(" .
380
		        " SELECT osc.seq_num, osc.prod_id".
381
		        " FROM os_contents osc".
382
		        " WHERE osc.os_id = $os_id" .
383
	            " ) osc" .
384
                " WHERE pd.PROD_ID (+)= pv.PV_ID" .
385
                "   AND pv.pkg_id = pkg.pkg_id" .
386
                "   AND osc.PROD_ID = pv.pv_id" .
387
                " ORDER BY osc.SEQ_NUM desc" ;
388
 
389
    my $sth = $DM_DB->prepare($m_sqlstr);
390
    if ( defined($sth) )
391
    {
392
        if ( $sth->execute( ) )
393
        {
394
            if ( $sth->rows )
395
            {
396
                while ( @row = $sth->fetchrow_array )
397
                {
398
next if ( $opt_test && ++$count > 2 );
399
                    Verbose ("SBOM Package:".join (',',@row) );
400
                    my $pv_id =     $row[8];
401
                    my $name =      $row[2]  || 'BadName';
402
                    my $ver =       $row[3]  || 'BadVer';
403
 
404
                    $pv_id{$pv_id}{pkg_name} =$name;
405
                    $pv_id{$pv_id}{pkg_ver} = $ver;
406
                    $pv_id{$pv_id}{os_id}{$os_id} = 1;
407
                }
408
            }
409
            $sth->finish();
410
        }
411
    }
412
    else
413
    {
414
        Error("getPackages_by_osid:Prepare failure" );
415
    }
416
}
417
 
418
#-------------------------------------------------------------------------------
419
# Function        : getPkgDetailsByPV_ID
420
#
421
# Description     : Populate the Packages structure given a PV_ID
422
#                   Called for each package in the SBOM
423
#
424
# Inputs          : PV_ID           - Package Unique Identifier
425
#
426
# Returns         : Populates Package
427
#
428
sub getPkgDetailsByPV_ID
429
{
430
    my ($PV_ID) = @_;
431
    my $foundDetails = 0;
432
    my (@row);
433
 
434
    connectRM( \$RM_DB ) unless $RM_DB;
435
 
436
    # First get details from pv_id
437
 
438
    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" .
439
                    " FROM PACKAGE_VERSIONS pv, PACKAGES pkg, PACKAGE_BUILD_INFO pbi" .
440
                    " WHERE pv.PV_ID = \'$PV_ID\' AND pv.PKG_ID = pkg.PKG_ID AND pv.PV_ID = pbi.PV_ID (+) ";
441
 
442
    my $sth = $RM_DB->prepare($m_sqlstr);
443
    if ( defined($sth) )
444
    {
445
        if ( $sth->execute( ) )
446
        {
447
            if ( $sth->rows )
448
            {
449
                while ( @row = $sth->fetchrow_array )
450
                {
451
                    my $pv_id       = $row[0];
452
                    my $name        = $row[1];
453
                    my $ver         = $row[2];
454
                    my $label       = $row[3] || '';
455
                    my $path        = $row[4] || '';
456
                    my $deployable  = $row[5];
457
                    my $build_info  = $row[6] || '';
458
                    my $build_mach  = $row[7] || '';
459
 
460
                    #
461
                    #   BSA_ID: 1:debug, 2:prod, 3:debug+prod, 4:Java1.4 5: Java 1.5
462
                    #   BM_ID : 1:solaris, 2:win32, 3: linux, 4:generic
463
                    #
464
 
465
                    Verbose ("getPkgDetailsByPV_ID: $PV_ID, $name, $ver, $build_mach ,$build_info");
466
 
467
                    $path =~ tr~\\/~/~s;
468
 
469
                    $Package{$name}{$ver}{pvid} = $PV_ID;
470
                    $Package{$name}{$ver}{done} = 1;
471
                    $Package{$name}{$ver}{base} = 1;
472
                    $Package{$name}{$ver}{deployable} = 1 if ($deployable);
473
                    $Package{$name}{$ver}{label} = $label;
474
                    $Package{$name}{$ver}{path} = $path;
475
                    $Package{$name}{$ver}{build}{$build_mach} = $build_info if $build_mach;
476
 
477
                    GetDepends( $pv_id, $name, $ver );
478
 
479
                }
480
            }
481
            else
482
            {
483
                Warning ("No Package details for: PVID: $PV_ID");
484
            }
485
            $sth->finish();
486
        }
487
        else
488
        {
489
            Error("getPkgDetailsByPV_ID: Execute failure", $m_sqlstr );
490
        }
491
    }
492
    else
493
    {
494
        Error("Prepare failure" );
495
    }
496
}
497
 
498
#-------------------------------------------------------------------------------
499
# Function        : GetDepends
500
#
501
# Description     : Extract the dependancies for a given package version
502
#
503
# Inputs          : $pvid
504
#
505
# Returns         :
506
#
507
sub GetDepends
508
{
509
    my ($pv_id, $pname, $pver ) = @_;
510
 
511
    connectRM( \$RM_DB ) unless $RM_DB;
512
 
513
    #
514
    #   Now extract the package dependacies
515
    #
516
    my $m_sqlstr = "SELECT pkg.PKG_NAME, pv.PKG_VERSION, pd.DPV_ID" .
517
                   " FROM PACKAGE_DEPENDENCIES pd, PACKAGE_VERSIONS pv, PACKAGES pkg" .
518
                   " WHERE pd.PV_ID = \'$pv_id\' AND pd.DPV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID";
519
    my $sth = $RM_DB->prepare($m_sqlstr);
520
    if ( defined($sth) )
521
    {
522
        if ( $sth->execute( ) )
523
        {
524
            if ( $sth->rows )
525
            {
526
                my %depends;
527
                while ( my @row = $sth->fetchrow_array )
528
                {
529
#print "$pname $pver ===== @row\n";
530
                    my $name = $row[0];
531
                    my $ver = $row[1];
532
 
533
                    Verbose2( "       Depends: $name, $ver");
534
 
535
                    $depends{$name,$ver} = 1;
536
                    $Package{$name}{$ver}{usedby}{$pname,$pver} = 1;
537
 
538
                    unless ( exists $Package{$name}{$ver}{done} )
539
                    {
540
                        my @DATA = ($name, $ver, $row[2]);
541
                        push @StrayPackages, \@DATA;
542
                    }
543
                }
544
                $Package{$pname}{$pver}{depends} = \%depends;
545
            }
546
            $sth->finish();
547
        }
548
    }
549
    else
550
    {
551
        Error("GetDepends:Prepare failure" );
552
    }
553
}
554
 
555
 
556
#-------------------------------------------------------------------------------
557
# Function        : LocateStrays
558
#
559
# Description     : Locate stray packages
560
#                   These are packages that have not been defined by the
561
#                   top level SBOM. These are not really stray
562
#
563
# Inputs          :
564
#
565
# Returns         :
566
#
567
sub LocateStrays
568
{
569
    while ( $#StrayPackages >= 0 )
570
    {
571
        my $DATA = pop @StrayPackages;
572
        my $name = $DATA->[0];
573
        my $ver = $DATA->[1];
574
        my $pv_id = $DATA->[2];
575
 
576
        next if ( exists $Package{$name}{$ver}{done} );
577
#print "Stray: $pv_id, $name, $ver\n";
578
        getPkgDetailsByPV_ID ( $pv_id );
579
        $Package{$name}{$ver}{stray} = 1;
580
    }
581
}
582
 
583
#-------------------------------------------------------------------------------
584
# Function        : BuildOrder
585
#
586
# Description     : Determine the order to build packages
587
#
588
# Inputs          :
589
#
590
# Returns         :
591
#
592
sub BuildOrder
593
{
594
    foreach my $name ( keys %Package )
595
    {
596
        foreach my $ver ( keys %{$Package{$name}} )
597
        {
598
            AddToBuildList( $name, $ver, $Package{$name}{$ver}{depends} );
599
        }
600
    }
601
 
602
    DetermineBuildOrder();
603
}
604
 
605
#-------------------------------------------------------------------------------
606
# Function        : AddToBuildList
607
#
608
# Description     : Add packages to a build list
609
#
610
# Inputs          : PackageName
611
#                   PackageVersion
612
#                   Hash of dependancies
613
#
614
# Returns         :
615
#
616
my %BuildList;
617
sub AddToBuildList
618
{
619
    my ($name, $ver, $pdepends ) = @_;
620
 
621
    Warning ("Duplicate Package to build: $name, $ver") if exists $BuildList{$name,$ver};
622
 
623
    #
624
    #   Clone dependancies as we will destroy the list as we process data
625
    #
626
    my $ref;
627
    $ref = dclone ($pdepends ) if $pdepends;
628
    $BuildList{$name,$ver}{depends} = $ref;
629
}
630
 
631
#-------------------------------------------------------------------------------
632
# Function        : DetermineBuildOrder
633
#
634
# Description     : Determine the build order
635
#
636
# Inputs          :
637
#
638
# Returns         :
639
#
640
sub DetermineBuildOrder
641
{
642
 
643
    my $file = "sbom_buildinfo.txt";
644
    push @create_list, $file;
645
 
646
    open (BI, ">$file" )  || Error ("Cannot create $file");
647
 
648
#    DebugDumpData ("BuildList", \%BuildList); exit 1;
649
 
650
    my $more = 1;
651
    my $level = 0;
652
    while ( $more )
653
    {
654
        my @build;
655
        $level ++;
656
        $more = 0;
657
        foreach my $key ( keys %BuildList )
658
        {
659
            #
660
            #   Locate packges with no dependencies left
661
            #
662
            next if ( keys %{$BuildList{$key}{depends}} );
663
            push @build, $key;
664
        }
665
 
666
        foreach my $build ( @build )
667
        {
668
            $more = 1;
669
            delete $BuildList{$build};
670
            my ($name, $ver) = split $;, $build;
671
 
672
            my $label = $Package{$name}{$ver}{label} || '';
673
            my $path  = $Package{$name}{$ver}{path} || '';
674
            $Package{$name}{$ver}{buildorder}  = $level;
675
 
676
            printf BI "Build(%2d): %40s %15s %-55s %s\n", $level, $name, $ver, $label, $path;
677
        }
678
 
679
        #
680
        #   Delete dependencies
681
        #
682
        foreach my $key ( keys %BuildList )
683
        {
684
            foreach my $build ( @build )
685
            {
686
                delete $BuildList{$key}{depends}->{$build};
687
            }
688
        }
689
    }
690
    close BI;
691
}
692
 
693
#-------------------------------------------------------------------------------
694
# Function        : ShowDepends
695
#
696
# Description     : Generate Dependency information
697
#                   Generate a nive HTML dependancy table
698
#                   Shows DependOn and UsedBy
699
# Inputs          :
700
#
701
# Returns         :
702
#
703
 
704
sub ShowDepends
705
{
706
    my $td = '<td style="vertical-align: top;">' . "\n";
707
    my $tdr = '<td style="text-align: right;">';
708
 
709
    my $file = "sbom_depends.html";
710
    push @create_list, $file;
711
    open (DP, ">$file" )  || Error ("Cannot create $file");
712
 
713
    #
714
    #   Generate an index
715
    #
716
    print DP "<dl><dt><h1>Index</h1></dt>\n";
717
    print DP "<dd><a href=\"#Depend\">Dependency Info</a></dd>\n";
718
    print DP "<dd><a href=\"#Multi\">Multiple Package Version</a></dd>\n";
719
    print DP "<dd><a href=\"#NoBuild\">Packages that cannot be built</a></dd>\n";
720
    print DP "</dl>\n";
721
 
722
 
723
    #
724
    #   Dependency Information
725
    #
726
    print DP "<h1><a name=\"Depend\">Dependency Info</a></h1>\n";
727
 
728
    print DP "<table border=\"1\"><tbody>\n";
729
    print DP "<tr>\n";
730
    print DP "<th>Package Dependency</th>\n";
731
    print DP "<th>Package Used by</th>\n";
732
    print DP "<th>Build Info</th>\n";
733
    print DP "</tr>\n";
734
 
735
    foreach my $name ( sort keys %Package )
736
    {
737
        foreach my $ver ( sort keys %{$Package{$name}} )
738
        {
739
            print DP "<tr>\n";
740
            #
741
            #   Depends On info
742
            #
743
 
744
            print DP $td;
745
            my $anchor= "${name}_${ver}";
746
            my $tag = "usedby_${name}_${ver}";
747
            printf  DP "<dl><dt><a name=\"$anchor\"></a><a href=\"#$tag\">%s %s</a> Depends on:</dt>\n", $name, $ver;
748
            foreach my $depend ( sort keys %{$Package{$name}{$ver}{depends}} )
749
            {
750
                my ($dname, $dver) = split $;, $depend;
751
                my $tag = "${dname}_${dver}";
752
                printf  DP "    <dd><a href=\"#$tag\">%s %s</a></dd>\n", $dname, $dver;
753
            }
754
            print DP "</dl>\n";
755
            print DP "</td>\n";
756
 
757
 
758
            #
759
            #   Used By information
760
            #
761
            print DP $td;
762
            $anchor= "usedby_${name}_${ver}";
763
            $tag = "${name}_${ver}";
764
            printf  DP "<dl><dt><a name=\"$anchor\"></a><a href=\"#$tag\">%s %s</a> Used by:</dt>\n", $name, $ver;
765
            foreach my $depend ( sort keys %{$Package{$name}{$ver}{usedby}} )
766
            {
767
                my ($dname, $dver) = split $;, $depend;
768
                my $tag = "usedby_${dname}_${dver}";
769
                printf  DP "    <dd><a href=\"#$tag\">%s %s</a></dd>\n", $dname, $dver;
770
            }
771
            print DP "</dl>\n";
772
            print DP "</td>\n";
773
 
774
            #
775
            #   Build Info
776
            #
777
            print DP $td;
778
            print DP "<table>";
779
 
780
            my $pv_id = $Package{$name}{$ver}{pvid} || 'No PVID';
781
            my $pv_id_ref = $rm_base . $pv_id;
782
            my $pv_id_str = "<a href=\"$pv_id_ref\">$pv_id</a>";
783
 
784
            printf DP "<tr>${tdr}Pvid:</td><td>%s</td></tr>\n", $pv_id_str;
785
            printf DP "<tr>${tdr}Label:</td><td>%s</td></tr>\n", $Package{$name}{$ver}{label} || 'NoneProvided';
786
            printf DP "<tr>${tdr}Path:</td><td>%s</td></tr>\n", $Package{$name}{$ver}{path}  || 'NoneProvided';
787
 
788
            my $order = 'Not Built';
789
            my @machs;
790
 
791
            if ( exists($Package{$name}{$ver}{build}) )
792
            {
793
                $order = $Package{$name}{$ver}{buildorder};
794
                @machs = sort keys %{$Package{$name}{$ver}{build}};
795
            }
796
            else
797
            {
798
                my $tag = "notbuilt_${name}_${ver}";
799
                $order = "<a href=\"#$tag\">Not Built</a>"
800
            }
801
 
802
            printf DP "<tr>${tdr}Build Order:</td><td>%s</td></tr>\n", $order;
803
 
804
            my $text = "Build:";
805
            foreach my $mach ( @machs )
806
            {
807
                my $type = $Package{$name}{$ver}{build}{$mach};
808
                printf DP "<tr>${tdr}$text</td><td>%s %s</td></tr>\n", $BM_ID{$mach} || "Unknown, $mach", $BSA_ID{$type} || 'Unknown';
809
                $text = '';
810
            }
811
 
812
            my $pvid = $Package{$name}{$ver}{pvid};
813
            $text = "Deployed:";
814
            foreach my $osid ( sort keys %{ $pv_id{$pvid}{os_id}  } )
815
            {
816
                my $os_name = $os_id_list{$osid}{os_name};
817
                my $node =    $os_id_list{$osid}{node_name};
818
 
819
                my $ref = $dm_base . $osid;
820
                my $str = "<a href=\"$ref\">$node,($os_name)</a>";
821
 
822
 
823
                printf DP "<tr>${tdr}$text</td><td>$str</td></tr>\n";
824
                $text = '';
825
            }
826
 
827
 
828
            print DP "</table>";
829
            print DP "</td>\n";
830
 
831
            #
832
            #   End of Row
833
            #
834
            print DP "</tr>\n";
835
        }
836
    }
837
    print DP "</tbody></table>\n";
838
 
839
 
840
    #
841
    #   Multiple versions of a package
842
    #
843
    print DP "<h1><a name=\"Multi\">Multiple Package Versions</a></h1>\n";
844
    print DP "<table border=\"1\"><tbody>\n";
845
    print DP "<tr>\n";
846
    print DP "<th>Multiple Versions</th>\n";
847
    print DP "</tr>\n";
848
 
849
    foreach my $name ( sort keys %Package )
850
    {
851
        my @versions = keys %{$Package{$name}};
852
        next unless ( $#versions > 0 );
853
        print DP "<tr>\n";
854
        print DP $td;
855
        printf  DP "<dl><dt>$name</a> Versions:<dt>\n";
856
 
857
        foreach my $ver ( sort @versions )
858
        {
859
            my $tag = "${name}_${ver}";
860
            printf  DP "    <dd><a href=\"#$tag\">%s %s</a></dd>\n", $name, $ver;
861
        }
862
        print DP "</dl>\n";
863
        print DP "</td>\n";
864
        print DP "</tr>\n";
865
    }
866
    print DP "</tbody></table>\n";
867
 
868
 
869
    #
870
    #   Packages that cannot be built
871
    #
872
    print DP "<h1><a name=\"NoBuild\">Packages that cannot be built</a></h1>\n";
873
    print DP "<table border=\"1\"><tbody>\n";
874
    print DP "<tr>\n";
875
    print DP "<th>Not Built</th>\n";
876
    print DP "</tr>\n";
877
 
878
    foreach my $name ( sort keys %Package )
879
    {
880
        my @versions = keys %{$Package{$name}};
881
        foreach my $ver ( sort @versions )
882
        {
883
            next unless exists($Package{$name}{$ver}{bad_extract});
884
            my @reasons = @{$Package{$name}{$ver}{bad_extract}};
885
 
886
            print DP "<tr><dl>\n";
887
            print DP $td;
888
 
889
            my $tag = "${name}_${ver}";
890
            my $anchor = "notbuilt_${name}_${ver}";
891
 
892
            printf  DP "<dt><a name=\"$anchor\"></a><a href=\"#$tag\">%s %s</a></dt>\n", $name, $ver;
893
            foreach my $reason ( @reasons )
894
            {
895
                print  DP "<dd>$reason</dd>\n";
896
            }
897
 
898
 
899
            print DP "</dl>\n";
900
            print DP "</td>\n";
901
            print DP "</tr>\n";
902
 
903
        }
904
    }
905
    print DP "</tbody></table>\n";
906
 
907
 
908
    close DP;
909
}
910
 
911
 
912
#-------------------------------------------------------------------------------
913
#   Documentation
914
#
915
 
916
=pod
917
 
918
=head1 NAME
919
 
920
escrow - Extract Escrow Build Information
921
 
922
=head1 SYNOPSIS
923
 
924
  jats escrow [options] -sbomid=<sbomid>
925
 
926
 Options:
927
    -help              - brief help message
928
    -help -help        - Detailed help message
929
    -man               - Full documentation
930
    -sbomid=xxx        - Specify the SBOM to process
931
    -verbose           - Enable verbose output
932
    -[no]test          - Reduced package scanning for test
933
 
934
=head1 OPTIONS
935
 
936
=over 8
937
 
938
=item B<-help>
939
 
940
Print a brief help message and exits.
941
 
942
=item B<-help -help>
943
 
944
Print a detailed help message with an explanation for each option.
945
 
946
=item B<-man>
947
 
948
Prints the manual page and exits.
949
 
950
=item B<-sbomid=xxx>
951
 
952
This option is mandatory. It specifies the SBOM to process. The sbomid must be
953
determined from Deployment Manager.
954
 
955
=item B<[no]test>
956
 
957
This option is used for testing. It will only process the first two OS entries
958
in the SBOM. This speeds up processing. It does not generate a complete list of
959
packages.
960
 
961
 
962
=item B<verbose>
963
 
964
This option will display progress information as the program executes.
965
 
966
=back
967
 
968
=head1 DESCRIPTION
969
 
970
This program is a tool for extracting Escrow build information.
971
 
972
Given an SBOM_ID this program will:
973
 
974
=over 8
975
 
976
=item * Determine all the NODES in the SBOM
977
 
978
=item * Determine all the Base Packages for each NODE
979
 
980
=item * Determine all the Packages for each NODE
981
 
982
=item * Determine all the dependent packages for all packages encountered
983
 
984
=item * Generate a list of jats commands to extract the package source
985
 
986
=item * Generate a file describing the build order
987
 
988
=item * Generate a file describing the packages that cannot be built
989
 
990
=item * Generate an HTML file with extensive cross reference information
991
 
992
=over 8
993
 
994
=item * List of all packages with references into Release Manager
995
 
996
=item * List of all packages showing dependent packages
997
 
998
=item * List of all packages showing consumer packages
999
 
1000
=item * List of all packages for which multiple versions are required
1001
 
1002
=item * Details of packages that are not built.
1003
 
1004
=item * Build order
1005
 
1006
=item * Build machines and built types
1007
 
1008
=item * Deployed target nodes, with references into deployment manager
1009
 
1010
=back
1011
 
1012
=back
1013
 
1014
This may take some time, as a typical escrow build may contain many hundreds of packages.
1015
 
1016
The program will display a list of files that have been created.
1017
 
1018
=cut
1019