Subversion Repositories DevTools

Rev

Rev 229 | Go to most recent revision | Details | Last modification | View Log | RSS feed

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