Subversion Repositories DevTools

Rev

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

Rev Author Line No. Line
392 dpurdie 1
########################################################################
7300 dpurdie 2
# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.
392 dpurdie 3
#
4
# Module name   : svn_pump2.pl
5
# Module type   : Makefile system
6
# Compiler(s)   : Perl
7
# Environment(s): jats
8
#
9
# Description   : Pump packages into subversion
10
#                 Process all packages in a Release or SBOM
11
#                 Create a file to process, or process directly
12
#
13
#......................................................................#
14
 
15
require 5.006_001;
16
use strict;
17
use warnings;
18
use JatsEnv;
19
use JatsError;
20
use JatsSystem;
21
use JatsRmApi;
22
use DBI;
23
use Getopt::Long;
24
use Pod::Usage;                             # required for help support
25
use Storable qw (dclone);
26
 
27
#
28
#   Config Options
29
#
30
my $VERSION = "1.0.0";              # Update this
31
my $opt_help = 0;
32
my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose
33
my $opt_sbom_id;
34
my $opt_rtag_id;
35
my $opt_test = 0;
36
my $opt_patch = 1;
37
my $opt_extract;
38
my $opt_rootpkg;
39
my $opt_rootpkg_version;
40
my $opt_direct;
41
 
42
#
43
#   Data Base Interface
44
#
45
my $RM_DB;
46
my $DM_DB;
47
 
48
#
49
#   Global variables
50
#
51
my %os_id_list;                 # os_id in the SBOM
52
my %os_env_list;                # OS Environments
53
my %pv_id;                      # Packages in the SBOM
54
my %Package;                    # Per Package information
55
my %Release;                    # Release information
56
my %Release_pvid;               # Release info
57
my @StrayPackages;              # Non-top level packages
58
my @create_list;                # List of files created
59
my $fpref = "sbom";             # Sbom Prefix
60
our $GBE_RM_URL;
61
our $GBE_DM_URL;
62
my $sbom_name;
63
my $sbom_branch;
64
my $sbom_project;
65
my $sbom_version;
66
my $rtag_release;
67
my $rtag_project;
68
 
69
#
70
#   Packages to be ignored
71
#
72
my %ignore;
73
my %patch;
74
 
75
 
76
#-------------------------------------------------------------------------------
77
# Function        : Main
78
#
79
# Description     : Main entry point
80
#                   Parse user options
81
#
82
# Inputs          :
83
#
84
# Returns         :
85
#
86
 
87
my $result = GetOptions (
88
                "help:+"        => \$opt_help,              # flag, multiple use allowed
89
                "manual:3"      => \$opt_help,              # flag, multiple use allowed
90
                "verbose:+"     => \$opt_verbose,           # flag
91
                "sbomid=s"      => \$opt_sbom_id,           # string
92
                "sbom_id=s"     => \$opt_sbom_id,           # string
93
                "rtagid=s"      => \$opt_rtag_id,           # string
94
                "rtag_id=s"     => \$opt_rtag_id,           # string
95
                "rootpackage=s" => \$opt_rootpkg,           # String
96
                "ignore=s",     => sub{my ($a,$i) = @_; $ignore{$i} = 0 },
97
                "test!"         => \$opt_test,              #[no]flag
98
                "patch!"        => \$opt_patch,             #[no]flag
99
                "extract=s"     => \$opt_extract,           # Name of file
100
                "direct"        => \$opt_direct,            #[no]flag
101
                );
102
 
103
#
104
#   Process help and manual options
105
#
106
pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result);
107
pod2usage(-verbose => 1)  if ($opt_help == 2 );
108
pod2usage(-verbose => 2)  if ($opt_help > 2);
109
 
110
ErrorConfig( 'name'    => 'PUMP',
111
             'verbose' => $opt_verbose );
112
 
113
#
114
#   Sanity test
115
#
116
unless ( $opt_rtag_id || $opt_sbom_id || $opt_extract || $#ARGV >= 1)
117
{
118
    Error ("Need sbomid and/or rtagid, or -extract",
119
           "Example: -sbomid=13543, for NZS Phase-1",
120
           "Example: -sbomid=13543 -rtagid=xxxx, for NZS Phase-1, comapred against given release",
121
           "Example: -rtagid=2362, for Sydney R1/R2",
122
           "Example: -rtagid=8843 -root=StockholmSBOM",
123
           "Example: PackageName PackageVersion, for extracting a single package",
124
    )
125
}
126
 
127
#
128
#   The extract option is special
129
#   It places the progam in a different mode
130
#
131
if ( $opt_extract )
132
{
133
    Error ("Cannot mix -extract with sbomid or rtagid" )
134
        if ( $opt_rtag_id || $opt_sbom_id || $#ARGV >= 0 );
135
 
136
    Error ("Cannot use -nopatch or -ignore with -extract")
137
        if ( ! $opt_patch || keys %ignore );
138
 
139
    extract_files();
140
    exit (0);
141
}
142
 
143
Warning ("No sbomid provided. Output based an a Release") unless ( $opt_sbom_id );
144
$fpref = "release" unless ( $opt_sbom_id );
145
 
146
#
147
#   Figure out package base
148
#
149
if ( $opt_sbom_id )
150
{
151
    #
152
    #   Determines the OS_ID's for the bom
153
    #
154
    getOSIDforBOMID($opt_sbom_id);
155
    getSBOMDetails($opt_sbom_id);
156
 
157
    #
158
    #   Locate packages associated with the base install for each os
159
    #
160
    foreach my $base_env_id ( sort keys %os_env_list )
161
    {
162
        getPackagesforBaseInstall( $base_env_id );
163
    }
164
 
165
    #
166
    #   Determine all the top level packages in the BOM
167
    #
168
    foreach my $os_id ( sort keys %os_id_list )
169
    {
170
        getPackages_by_osid( $os_id );
171
    }
172
 
173
    #
174
    #   For each Top Level Package determine the dependent packages
175
    #
176
    getPkgDetailsForPVIDs (keys %pv_id);
177
    LocateStrays(0);
178
 
179
    #
180
    #   Determine packages in a given Release
181
    #
182
    if ( $opt_rtag_id )
183
    {
184
        getPkgDetailsByRTAG_ID( $opt_rtag_id );
185
    }
186
}
187
elsif ( $opt_rtag_id )
188
{
189
    getPkgDetailsByRTAG_ID( $opt_rtag_id );
190
    if ( $opt_rootpkg )
191
    {
192
        #
193
        #   Base the report on a single package in a release
194
        #   Determine the package
195
        #
196
        Error ("Root Package not found: $opt_rootpkg") unless ( exists $Release{$opt_rootpkg} );
197
        my @root_vers = keys %{$Release{$opt_rootpkg}};
198
        Error ("Multiple versions of Root Package: $opt_rootpkg", @root_vers ) if ( $#root_vers > 0 );
199
        $opt_rootpkg_version = $root_vers[0];
200
        Message("Root Package: $opt_rootpkg, " . $opt_rootpkg_version);
201
 
202
        getPkgDetailsByPV_ID( $Release{$opt_rootpkg}{$opt_rootpkg_version}{pv_id} );
203
    }
204
    else
205
    {
206
        getPkgDetailsForPVIDs (keys %Release_pvid);
207
    }
208
    LocateStrays(1);
209
}
210
elsif ( $#ARGV >= 1 )
211
{
212
    #
213
    #   Locate package and dependents
214
    #   Convert package name into a PVID
215
    #
216
    my $pv_id = getPkgDetailsByName( @ARGV );
217
    Error ("Cannot locate package by name and version: @ARGV")
218
        unless ( $pv_id );
219
 
220
    #
221
    #   Set package as the root package
222
    $opt_rootpkg = $ARGV[0];
223
    $opt_rootpkg_version = $ARGV[1];
224
    getPkgDetailsByPV_ID( $pv_id  );
225
    LocateStrays(2);
226
}
227
else
228
{
229
    Error ("Don't know what to do with common line arguments provided");
230
}
231
 
232
 
233
#
234
#   Remove packages to be ignored
235
#
236
foreach my $pkg ( keys %ignore )
237
{
238
    delete $Package{$pkg};
239
}
240
 
241
##
242
##   Display a list of all packages found so far
243
##
244
#foreach my $name ( sort keys %Package )
245
#{
246
#    foreach my $ver ( sort keys %{$Package{$name}} )
247
#    {
248
#
249
#        my $label = $Package{$name}{$ver}{label} || '';
250
#        my $path = $Package{$name}{$ver}{path} || '';
251
#
252
#        printf ("%30s %15s %45s %s\n", $name, $ver, $label, $path );
253
#    }
254
#}
255
 
256
#
257
#   Generate output files
258
#       1) Jats extract commands
259
#       2) Error list
260
my $file;
261
$file = "${fpref}_extract.txt";
262
push @create_list, $file;
263
open (JE, ">$file" ) || Error ("Cannot create $file");
264
 
265
$file = "${fpref}_status.txt";
266
push @create_list, $file;
267
 
268
open (ST, ">$file" ) || Error("Cannot create $file");
269
print ST "Cannot build:\n";
270
 
271
foreach my $name ( sort keys %Package )
272
{
273
    foreach my $ver ( sort keys %{$Package{$name}} )
274
    {
275
 
276
        my $label = $Package{$name}{$ver}{label} || '';
277
        my $path = $Package{$name}{$ver}{path} || '';
278
        my $mtest = exists ($Package{$name}{$ver}{build} ) || '0';
279
        my @reason1;            # can't extract files
280
        my @reason2;            # Others
281
 
282
        push @reason1, 'No Label' unless ( $label );
283
        push @reason1, 'Bad Label, N/A' if ( $label =~ s~^N/A$~~i || $label  =~ s~^na$~~i );
284
 
285
        push @reason1, 'No Source Path' unless ( $path );
286
        push @reason1, 'Bad Path, N/A' if ( $path =~ m~^N/A$~i || $path  =~ m~^na$~i );
287
        push @reason1, 'Bad Path, dpkg' if ( $path =~ m~^/dpkg_archive~ || $path  =~ m~^dpkg_archive~ );
288
        push @reason1, 'Bad Path, http' if ( $path =~ m~^http:~i );
289
        push @reason1, 'Bad Path, Drive' if ( $path =~ m~^[A-Za-z]\:~ );
290
        push @reason1, 'Bad Path, UNC' if ( $path =~ m~^//~ );
291
        push @reason1, 'Bad Path, Relative' unless ( $path =~ m~^/~ );
292
 
293
 
294
        push @reason2, 'No Build System' unless ( exists ($Package{$name}{$ver}{build} ) );
295
 
296
        unless ( @reason1 )
297
        {
298
            my $vname = "$name $ver";
299
            $vname =~ s~ ~_~g;
300
            $vname =~ s~__~~g;
301
 
302
            print JE "jats etool svn_pump -package=$name -version=$ver\n";
303
        }
304
 
305
        if ( @reason1 || @reason2 )
306
        {
307
            $Package{$name}{$ver}{bad_extract} = [@reason1, @reason2];
308
            printf ST "%40s %20s %50s (%s) %s\n", $name, $ver, $label, $mtest, $path ;
309
        }
310
    }
311
}
312
 
313
close (JE);
314
close (ST);
315
 
316
#
317
#   Display names of files created
318
#
319
foreach my $file ( sort @create_list )
320
{
321
    Message ("Created: $file");
322
}
323
 
324
#
325
#   Do it all at once
326
#
327
if ( $opt_direct )
328
{
329
    foreach my $name ( sort keys %Package )
330
    {
331
        foreach my $ver ( sort keys %{$Package{$name}} )
332
        {
333
 
334
            my $label = $Package{$name}{$ver}{label} || '';
335
            my $path = $Package{$name}{$ver}{path} || '';
336
            my $rv = JatsTool ('svn_pump', "-package=$name", "-version=$ver", "-label=$label", "-path=$path" );
337
        }
338
    }
339
}
340
 
341
exit;
342
 
343
 
344
#-------------------------------------------------------------------------------
345
# Function        : getSBOMDetails
346
#
347
# Description     : Get some details about the SBOM
348
#                   Used fro descriptive text
349
#
350
# Inputs          : $bom_id             - BOM to process
351
#
352
# Returns         : 
353
#
354
sub getSBOMDetails
355
{
356
    my ($bom_id) = @_;
357
    my $foundDetails = 0;
358
    my (@row);
359
Verbose ("getSBOMDetails");
360
    connectDM(\$DM_DB) unless ($DM_DB);
361
 
362
    my $m_sqlstr = "SELECT distinct dp.PROJ_NAME ,bn.BOM_NAME, br.BRANCH_NAME, bm.BOM_VERSION, bm.BOM_LIFECYCLE" .
363
                   " FROM DEPLOYMENT_MANAGER.BOMS bm, DEPLOYMENT_MANAGER.BOM_NAMES bn, DEPLOYMENT_MANAGER.BRANCHES br, DEPLOYMENT_MANAGER.DM_PROJECTS dp" .
364
                   " WHERE bm.BOM_ID = $bom_id AND bm.BOM_NAME_ID = bn.BOM_NAME_ID AND bm.BRANCH_ID = br.BRANCH_ID AND br.PROJ_ID = dp.PROJ_ID";
365
 
366
    my $sth = $DM_DB->prepare($m_sqlstr);
367
    if ( defined($sth) )
368
    {
369
        if ( $sth->execute( ) )
370
        {
371
            if ( $sth->rows )
372
            {
373
                while ( @row = $sth->fetchrow_array )
374
                {
375
                    $sbom_project   = $row[0];
376
                    $sbom_name      = $row[1];
377
                    $sbom_branch    = $row[2];
378
                    $sbom_version   = $row[3] . '.' . $row[4];
379
                    $foundDetails = 1;
380
                }
381
            }
382
            $sth->finish();
383
        }
384
        else
385
        {
386
            Error("getSBOMDetails:Execute failure", $m_sqlstr );
387
        }
388
    }
389
    else
390
    {
391
        Error("getSBOMDetails:Prepare failure" );
392
    }
393
 
394
    Error("getSBOMDetails:No OS Information Found" ) unless $foundDetails;
395
 
396
}
397
 
398
#-------------------------------------------------------------------------------
399
# Function        : getReleaseDetails
400
#
401
# Description     : Get some details about the Release
402
#                   Used fro descriptive text
403
#
404
# Inputs          : $rtag_id             - RTAG_ID to process
405
#
406
# Returns         : 
407
#
408
sub getReleaseDetails
409
{
410
    my ($rtag_id) = @_;
411
    my $foundDetails = 0;
412
    my (@row);
413
Verbose ("getReleaseDetails");
414
    connectDM(\$DM_DB) unless ($DM_DB);
415
 
416
    my $m_sqlstr = "SELECT distinct rt.RTAG_NAME, pr.PROJ_NAME" .
417
                   " FROM RELEASE_MANAGER.RELEASE_TAGS rt, RELEASE_MANAGER.PROJECTS pr" .
418
                   " WHERE rt.RTAG_ID = $rtag_id AND rt.PROJ_ID = pr.PROJ_ID";
419
 
420
    my $sth = $DM_DB->prepare($m_sqlstr);
421
    if ( defined($sth) )
422
    {
423
        if ( $sth->execute( ) )
424
        {
425
            if ( $sth->rows )
426
            {
427
                while ( @row = $sth->fetchrow_array )
428
                {
429
                    $rtag_release = $row[0];
430
                    $rtag_project = $row[1];
431
                    $foundDetails = 1;
432
                }
433
            }
434
            $sth->finish();
435
        }
436
        else
437
        {
438
            Error("getReleaseDetails:Execute failure", $m_sqlstr );
439
        }
440
    }
441
    else
442
    {
443
        Error("getReleaseDetails:Prepare failure" );
444
    }
445
 
446
    Error("getReleaseDetails:No OS Information Found" ) unless $foundDetails;
447
 
448
}
449
 
450
 
451
 
452
#-------------------------------------------------------------------------------
453
# Function        : getOSIDforBOMID
454
#
455
# Description     : Get all the os_id's associated with a BOMID
456
#
457
# Inputs          : $bom_id             - BOM to process
458
#
459
# Returns         :
460
#
461
 
462
sub getOSIDforBOMID
463
{
464
    my ($bom_id) = @_;
465
    my $foundDetails = 0;
466
    my (@row);
467
Verbose ("getOSIDforBOMID");
468
    connectDM(\$DM_DB) unless ($DM_DB);
469
 
470
    my $m_sqlstr = "SELECT distinct os.OS_ID, os.OS_NAME, nn.NODE_NAME, obe.BASE_ENV_ID " .
471
                   " FROM DEPLOYMENT_MANAGER.OPERATING_SYSTEMS os, DEPLOYMENT_MANAGER.BOM_CONTENTS bc, DEPLOYMENT_MANAGER.NETWORK_NODES nn, DEPLOYMENT_MANAGER.OS_BASE_ENV obe" .
472
                   " 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 ";
473
 
474
    my $sth = $DM_DB->prepare($m_sqlstr);
475
    if ( defined($sth) )
476
    {
477
        if ( $sth->execute( ) )
478
        {
479
            if ( $sth->rows )
480
            {
481
                while ( @row = $sth->fetchrow_array )
482
                {
483
                    Verbose ("OS_ID: ".join (',',@row) );
484
                    $os_id_list{$row[0]}{os_name} = $row[1];
485
                    $os_id_list{$row[0]}{node_name} = $row[2];
486
 
487
                    $os_env_list{$row[3]}{needed} = 1;
488
                    $os_env_list{$row[3]}{os_id}{$row[0]} = 1;
489
 
490
                    $foundDetails = 1;
491
                }
492
            }
493
            $sth->finish();
494
        }
495
        else
496
        {
497
            Error("getOSIDforBOMID:Execute failure" );
498
        }
499
    }
500
    else
501
    {
502
        Error("getOSIDforBOMID:Prepare failure" );
503
    }
504
 
505
    Error("getOSIDforBOMID:No OS Information Found" ) unless $foundDetails;
506
 
507
}
508
 
509
#-------------------------------------------------------------------------------
510
# Function        : getPackagesforBaseInstall
511
#
512
# Description     : Get all the packages for a given base install
513
#
514
# Inputs          :
515
#
516
# Returns         :
517
#
518
 
519
sub getPackagesforBaseInstall
520
{
521
    my ($base_env_id) =@_;
522
    my $foundDetails = 0;
523
    my (@row);
524
 
525
    connectDM(\$DM_DB) unless ($DM_DB);
526
 
527
    # First get details from pv_id
528
    Verbose("getPackagesforBaseInstall");
529
    my $m_sqlstr = "SELECT DISTINCT bec.PROD_ID, pkg.pkg_name, pv.pkg_version, pkg.pkg_id, pv.pv_id" .
530
                " FROM RELEASE_MANAGER.PACKAGES pkg, RELEASE_MANAGER.PACKAGE_VERSIONS pv, DEPLOYMENT_MANAGER.PRODUCT_DETAILS pd, DEPLOYMENT_MANAGER.BASE_ENV_CONTENTS bec".
531
                " WHERE bec.BASE_ENV_ID = $base_env_id AND bec.PROD_ID (+)= pv.PV_ID AND pv.pkg_id = pkg.pkg_id";
532
 
533
    my $sth = $DM_DB->prepare($m_sqlstr);
534
    if ( defined($sth) )
535
    {
536
        if ( $sth->execute( ) )
537
        {
538
            if ( $sth->rows )
539
            {
540
                while ( @row = $sth->fetchrow_array )
541
                {
542
                    Verbose ("OS ENV Package($base_env_id}:" . join (',',@row) );
543
 
544
                    my $pv_id =     $row[0];
545
                    my $name =      $row[1]  || 'BadName';
546
                    my $ver =       $row[2]  || 'BadVer';
547
 
548
                    $pv_id{$pv_id}{pkg_name} =$name;
549
                    $pv_id{$pv_id}{pkg_ver} = $ver;
550
                    foreach my $os_id ( keys %{$os_env_list{$base_env_id}{os_id}} )
551
                    {
552
                        $pv_id{$pv_id}{os_id}{$os_id} = 2;
553
                    }
554
                }
555
            }
556
            $sth->finish();
557
        }
558
        else
559
        {
560
            Error ("getPackagesforBaseInstall: Execute error");
561
        }
562
    }
563
    else
564
    {
565
        Error("getPackagesforBaseInstall:Prepare failure" );
566
    }
567
 
568
}
569
 
570
 
571
#-------------------------------------------------------------------------------
572
# Function        : getPackages_by_osid
573
#
574
# Description     : Get all the packages used by a given os_id
575
#
576
# Inputs          :
577
#
578
# Returns         :
579
#
580
 
581
my $count = 0;
582
sub getPackages_by_osid
583
{
584
    my ($os_id) =@_;
585
    my $foundDetails = 0;
586
    my (@row);
587
 
588
    connectDM(\$DM_DB) unless ($DM_DB);
589
 
590
    # First get details from pv_id
591
    Verbose("getPackages_by_osid");
592
    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" .
593
                " FROM RELEASE_MANAGER.PACKAGES pkg, RELEASE_MANAGER.PACKAGE_VERSIONS pv, DEPLOYMENT_MANAGER.PRODUCT_DETAILS pd,".
594
	            "(" .
595
		        " SELECT osc.seq_num, osc.prod_id".
596
		        " FROM DEPLOYMENT_MANAGER.os_contents osc".
597
		        " WHERE osc.os_id = $os_id" .
598
	            " ) osc" .
599
                " WHERE pd.PROD_ID (+)= pv.PV_ID" .
600
                "   AND pv.pkg_id = pkg.pkg_id" .
601
                "   AND osc.PROD_ID = pv.pv_id" .
602
                " ORDER BY osc.SEQ_NUM desc" ;
603
 
604
    my $sth = $DM_DB->prepare($m_sqlstr);
605
    if ( defined($sth) )
606
    {
607
        if ( $sth->execute( ) )
608
        {
609
            if ( $sth->rows )
610
            {
611
                while ( @row = $sth->fetchrow_array )
612
                {
613
next if ( $opt_test && ++$count > 2 );
614
                    Verbose ("SBOM Package:".join (',',@row) );
615
                    my $pv_id =     $row[8];
616
                    my $name =      $row[2]  || 'BadName';
617
                    my $ver =       $row[3]  || 'BadVer';
618
 
619
                    $pv_id{$pv_id}{pkg_name} =$name;
620
                    $pv_id{$pv_id}{pkg_ver} = $ver;
621
                    $pv_id{$pv_id}{os_id}{$os_id} = 1;
622
                }
623
            }
624
            $sth->finish();
625
        }
626
    }
627
    else
628
    {
629
        Error("getPackages_by_osid:Prepare failure" );
630
    }
631
}
632
 
633
#-------------------------------------------------------------------------------
634
# Function        : getPkgDetailsByPV_ID
635
#
636
# Description     : Populate the Packages structure given a PV_ID
637
#                   Called for each package in the SBOM
638
#
639
# Inputs          : PV_ID           - Package Unique Identifier
640
#
641
# Returns         : Populates Package
642
#
643
sub getPkgDetailsByPV_ID
644
{
645
    my ($PV_ID) = @_;
646
    my $foundDetails = 0;
647
    my (@row);
648
 
649
    connectRM(\$RM_DB) unless ($RM_DB);
650
 
651
    # First get details from pv_id
652
 
653
    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" .
654
                    " FROM RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pkg, RELEASE_MANAGER.PACKAGE_BUILD_INFO pbi" .
655
                    " WHERE pv.PV_ID = \'$PV_ID\' AND pv.PKG_ID = pkg.PKG_ID AND pv.PV_ID = pbi.PV_ID (+) ";
656
 
657
    my $sth = $RM_DB->prepare($m_sqlstr);
658
    if ( defined($sth) )
659
    {
660
        if ( $sth->execute( ) )
661
        {
662
            if ( $sth->rows )
663
            {
664
                while ( @row = $sth->fetchrow_array )
665
                {
666
                    my $pv_id       = $row[0];
667
                    my $name        = $row[1];
668
                    my $ver         = $row[2];
669
                    my $label       = $row[3] || '';
670
                    my $path        = $row[4] || '';
671
                    my $deployable  = $row[5];
672
                    my $build_info  = $row[6] || '';
673
                    my $build_mach  = $row[7] || '';
674
                    my $description = $row[8] || '';
675
 
676
                    #
677
                    #   BSA_ID: 1:debug, 2:prod, 3:debug+prod, 4:Java1.4 5: Java 1.5
678
                    #   BM_ID : 1:solaris, 2:win32, 3: linux, 4:generic
679
                    #
680
 
681
 
682
                    #
683
                    #   Does it look like a patch
684
                    #   We may want to ignore it.
685
                    #
686
                    my $patch = "";
687
                    unless ( $opt_patch )
688
                    {
689
                        if ( $ver =~ m~\.p\d+.\w+$~ )
690
                        {
691
                            $patch = "Patch";
692
                            $patch{$name} = 0
693
                                unless (  exists $patch{$name} );
694
                            $patch{$name}++;
695
                        }
696
                    }
697
                    Verbose ("getPkgDetailsByPV_ID: $PV_ID, $name, $ver, $build_mach ,$build_info, $patch");
698
                    next if ( $patch );
699
 
700
 
701
                    if ( exists $ignore{$name} )
702
                    {
703
                        Verbose2( "    Ignoring: $PV_ID, $name, $ver, $build_mach ,$build_info, $patch\n");
704
                        $ignore{$name}++;
705
                        last;
706
                    }
707
 
708
                    $path =~ tr~\\/~/~;
709
 
710
                    $Package{$name}{$ver}{pvid} = $PV_ID;
711
                    $Package{$name}{$ver}{done} = 1;
712
                    $Package{$name}{$ver}{base} = 1;
713
                    $Package{$name}{$ver}{deployable} = 1 if ($deployable);
714
                    $Package{$name}{$ver}{label} = $label;
715
                    $Package{$name}{$ver}{path} = $path;
716
                    $Package{$name}{$ver}{build}{$build_mach} = $build_info if $build_mach;
717
                    $Package{$name}{$ver}{description} = $description;
718
 
719
                    GetDepends( $pv_id, $name, $ver );
720
 
721
                }
722
            }
723
            else
724
            {
725
                Warning ("No Package details for: PVID: $PV_ID");
726
            }
727
            $sth->finish();
728
        }
729
        else
730
        {
731
            Error("getPkgDetailsByPV_ID: Execute failure", $m_sqlstr );
732
        }
733
    }
734
    else
735
    {
736
        Error("Prepare failure" );
737
    }
738
}
739
 
740
#-------------------------------------------------------------------------------
741
# Function        : getPkgDetailsByName
742
#
743
# Description     : Determine the PVID for a given package name and version
744
#
745
# Inputs          : $pname          - Package name
746
#                   $pver           - Package Version
747
#
748
# Returns         : 
749
#
750
 
751
sub getPkgDetailsByName
752
{
753
    my ($pname, $pver) = @_;
754
    my $pv_id;
755
    my (@row);
756
 
757
    connectRM(\$RM_DB) unless ($RM_DB);
758
 
759
    # First get details for a given package version
760
 
761
    my $m_sqlstr = "SELECT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION" .
762
                    " FROM RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pkg" .
763
                    " WHERE pkg.PKG_NAME = \'$pname\' AND pv.PKG_VERSION = \'$pver\' AND pv.PKG_ID = pkg.PKG_ID";
764
    my $sth = $RM_DB->prepare($m_sqlstr);
765
    if ( defined($sth) )
766
    {
767
        if ( $sth->execute( ) )
768
        {
769
            if ( $sth->rows )
770
            {
771
                while ( @row = $sth->fetchrow_array )
772
                {
773
                    $pv_id = $row[0];
774
                    my $name = $row[1];
775
                    my $ver = $row[2];
776
                    Verbose( "getPkgDetailsByName :PV_ID= $pv_id");
777
                }
778
            }
779
            $sth->finish();
780
        }
781
    }
782
    else
783
    {
784
        Error("Prepare failure" );
785
    }
786
    return $pv_id;
787
}
788
 
789
#-------------------------------------------------------------------------------
790
# Function        : getPkgDetailsForPVIDs
791
#
792
# Description     : Get all package details by PVID, from a list of PVIDs
793
#
794
# Inputs          : List of PVID's to process
795
#
796
# Returns         : Nothing
797
#
798
sub getPkgDetailsForPVIDs
799
{
800
 
801
    my $count = 0;
802
    foreach my $pv_id ( @_ )
803
    {
804
        next if ( $opt_test && ++$count > 2 );
805
        getPkgDetailsByPV_ID( $pv_id);
806
    }
807
}
808
 
809
#-------------------------------------------------------------------------------
810
# Function        : GetDepends
811
#
812
# Description     : Extract the dependancies for a given package version
813
#
814
# Inputs          : $pvid
815
#
816
# Returns         :
817
#
818
sub GetDepends
819
{
820
    my ($pv_id, $pname, $pver ) = @_;
821
 
822
    connectRM(\$RM_DB) unless ($RM_DB);
823
 
824
    #
825
    #   Now extract the package dependacies
826
    #
827
    my $m_sqlstr = "SELECT pkg.PKG_NAME, pv.PKG_VERSION, pd.DPV_ID" .
828
                   " FROM RELEASE_MANAGER.PACKAGE_DEPENDENCIES pd, RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pkg" .
829
                   " WHERE pd.PV_ID = \'$pv_id\' AND pd.DPV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID";
830
    my $sth = $RM_DB->prepare($m_sqlstr);
831
    if ( defined($sth) )
832
    {
833
        if ( $sth->execute( ) )
834
        {
835
            if ( $sth->rows )
836
            {
837
                my %depends;
838
                while ( my @row = $sth->fetchrow_array )
839
                {
840
#print "$pname $pver ===== @row\n";
841
                    my $name = $row[0];
842
                    my $ver = $row[1];
843
 
844
                    Verbose2( "       Depends: $name, $ver");
845
 
846
                    $depends{$name,$ver} = 1;
847
                    $Package{$name}{$ver}{usedby}{$pname,$pver} = 1;
848
 
849
                    unless ( exists $Package{$name}{$ver}{done} )
850
                    {
851
                        my @DATA = ($name, $ver, $row[2]);
852
                        push @StrayPackages, \@DATA;
853
                    }
854
                }
855
                $Package{$pname}{$pver}{depends} = \%depends;
856
            }
857
            $sth->finish();
858
        }
859
    }
860
    else
861
    {
862
        Error("GetDepends:Prepare failure" );
863
    }
864
}
865
 
866
#-------------------------------------------------------------------------------
867
# Function        : getPkgDetailsByRTAG_ID
868
#
869
# Description     : Extract all the packages for a given rtag_id
870
#
871
# Inputs          : RTAG_ID
872
#
873
# Returns         : 
874
#
875
 
876
sub getPkgDetailsByRTAG_ID
877
{
878
    my ($RTAG_ID) = @_;
879
    my $foundDetails = 0;
880
    my (@row);
881
 
882
    Verbose("getPkgDetailsByRTAG_ID");
883
    connectRM(\$RM_DB) unless ($RM_DB);
884
    # First get details from pv_id
885
    my $m_sqlstr = "SELECT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION".
886
                   " FROM RELEASE_MANAGER.RELEASE_CONTENT rc, RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pkg" .
887
                   " WHERE rc.RTAG_ID = $RTAG_ID AND rc.PV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID";
888
    my $sth = $RM_DB->prepare($m_sqlstr);
889
    if ( defined($sth) )
890
    {
891
        if ( $sth->execute( ) )
892
        {
893
            if ( $sth->rows )
894
            {
895
                while ( @row = $sth->fetchrow_array )
896
                {
897
                    my $pv_id   = $row[0];
898
                    my $name    = $row[1];
899
                    my $ver     = $row[2];
900
                    Verbose ("getPkgDetailsByRTAG_ID: $RTAG_ID, $name, $ver, $pv_id");
901
 
902
                    $Release{$name}{$ver}{pv_id} = $pv_id;
903
                    $Release_pvid{$pv_id} = 1;
904
                }
905
            }
906
            $sth->finish();
907
        }
908
    }
909
    else
910
    {
911
        Error("getPkgDetailsByRTAG_ID:Prepare failure" );
912
    }
913
}
914
 
915
 
916
#-------------------------------------------------------------------------------
917
# Function        : LocateStrays
918
#
919
# Description     : Locate stray packages
920
#                   These are packages that have not been defined by the
921
#                   top level SBOM. These are not really stray
922
#
923
# Inputs          : $mode           2: No stray tagging
924
#                                   0: Mark all as stray
925
#                                   1: Don't mark packages as stray
926
#                                      if they are in releases hash
927
# Returns         : Nothing
928
#
929
sub LocateStrays
930
{
931
    my ($mode) = @_;
932
    while ( $#StrayPackages >= 0 )
933
    {
934
        my $DATA = pop @StrayPackages;
935
        my $name = $DATA->[0];
936
        my $ver = $DATA->[1];
937
        my $pv_id = $DATA->[2];
938
 
939
        next if ( exists $Package{$name}{$ver}{done} );
940
        getPkgDetailsByPV_ID ( $pv_id );
941
 
942
        next if ( $mode > 1 );
943
        if ( $mode )
944
        {
945
            next if ( exists $Release{$name}{$ver} );
946
        }
947
        $Package{$name}{$ver}{stray} = 1;
948
#print "Stray: $pv_id, $name, $ver\n";
949
    }
950
}
951
 
952
#-------------------------------------------------------------------------------
953
# Function        : extract_files
954
#
955
# Description     : Alternate mode of operation
956
#                   Extract files from the generated list. This is intended to
957
#                   be run as a seperate phase taking the 'extract' file
958
#
959
# Inputs          :
960
#
961
# Returns         : 
962
#
963
sub extract_files
964
{
965
    my @extract_order;
966
    my %extract;
967
    ErrorConfig( 'name'    => 'ESCROW-EXTRACT' );
968
 
969
    #
970
    #   Open the file and read in data in one hit
971
    #   This will detect file errors early
972
    #   The lines may have arguments that are quoted.
973
    #   Supported forms are:
974
    #           "-tag=data"         - data may contain spaces
975
    #           -tag=data           - data must not contain spaces
976
    #
977
    #
978
    Error ("Cannot find specified file: $opt_extract")
979
        unless ( -f $opt_extract );
980
 
981
    open (FH, "<$opt_extract" ) || Error ("Cannot open file");
982
    while ( <FH> )
983
    {
984
        s~[\r\n]+$~~;
985
        Verbose2 ($_);
986
        next unless ( $_ );
987
 
988
        my ($name, $version);
989
        if ( m{(\s"-name=([^"]+)")|(\s-name=(\S+))} )
990
        {
991
            $name = $2 || $4;
992
        }
993
 
994
        if ( m{(\s"-version=([^"]+)")|(\s-version=(\S+))} )
995
        {
996
            $version = $2 || $4;
997
        }
998
 
999
        Error "Bad file format in line: $_" unless ( $name && $version );
1000
        my $view = "${name} ${version}";
1001
        Error "Duplicate view name: $view" if ( exists $extract{$view} );
1002
        push @extract_order, $view;
1003
        $extract{$view}{name} = $name;
1004
        $extract{$view}{version} = $version;
1005
    }
1006
    close FH;
1007
 
1008
    #
1009
    #   Log the file processing
1010
    #
1011
    my $lfile = "${opt_extract}.log";
1012
    Message ("Creating logfile: ${opt_extract}.log");
1013
    open (FH, ">$lfile" ) || Error ("Cannot open log file: $lfile");
1014
 
1015
    #
1016
    #   Process each entry
1017
    #
1018
    foreach my $view ( @extract_order )
1019
    {
1020
        my $name = $extract{$view}{name};
1021
        my $version = $extract{$view}{version};
1022
        if ( $opt_test )
1023
        {
1024
            Verbose ("$name :: $version");
1025
            print FH "$name :: $version : TEST\n";
1026
        }
1027
        else
1028
        {
1029
            my $rv = JatsTool ('svn_pump', $name, $version);
1030
            print FH "$name, $version : SUCCESS\n" unless $rv;
1031
            print FH "$name, $version : ERROR\n" if $rv;
1032
        }
1033
    }
1034
    close FH;
1035
    Message ("Results in logfile: ${opt_extract}.log");
1036
 
1037
}
1038
 
1039
 
1040
#-------------------------------------------------------------------------------
1041
#   Documentation
1042
#
1043
 
1044
=pod
1045
 
1046
=head1 NAME
1047
 
1048
escrow - Extract Escrow Build Information
1049
 
1050
=head1 SYNOPSIS
1051
 
1052
  jats escrow [options] [name version]
1053
 
1054
 Options:
1055
    -help              - brief help message
1056
    -help -help        - Detailed help message
1057
    -man               - Full documentation
1058
    -sbomid=xxx        - Specify the SBOM to process
1059
    -rtagid=xxx        - Specify the Release to process (Optional)
1060
    -rootpackage=xxx   - Specifies a root package. In conjunction with -rtagid.
1061
    -ignore=name       - Ignore packages with the specified name
1062
    -extract=fname     - Extract files from a previous run
1063
    -verbose           - Enable verbose output
1064
    -[no]patch         - Ignore/Include patches. Default:Include
1065
    -[no]test          - Reduced package scanning for test
1066
 
1067
=head1 OPTIONS
1068
 
1069
=over 8
1070
 
1071
=item B<-help>
1072
 
1073
Print a brief help message and exits.
1074
 
1075
=item B<-help -help>
1076
 
1077
Print a detailed help message with an explanation for each option.
1078
 
1079
=item B<-man>
1080
 
1081
Prints the manual page and exits.
1082
 
1083
=item B<-sbomid=xxx>
1084
 
1085
This option specifies the SBOM to process. The sbomid must be determined from
1086
Deployment Manager.
1087
 
1088
=item B<-rtagid=xxx>
1089
 
1090
This option specified an RTAG_ID that must be determined from Release Manager.
1091
 
1092
This option may be used with or without the B<-sbomid=xxx> option.
1093
 
1094
With an SBOM_ID this option specifies an RTAG_ID to process in conjunction with the SBOM.
1095
The program will determine packages that are in the Release, but not in the
1096
SBOM.
1097
 
1098
Without an SBOM_ID, this option will limit the processing to the specified
1099
release. Less information is generated. This form of the generation may be
1100
combined with B<-rootpackage=xxx> to further limit the set of packages
1101
processed.
1102
 
1103
=item B<-rootpackage=xxx>
1104
 
1105
This option can be used in conjunction with B<-rtagid=xxx> to limit the
1106
extraction to named package and all of its dependent packages. The tool will
1107
determine the required version of the package via the specified release.
1108
 
1109
=item B<-ignore=name>
1110
 
1111
All versions of the named package will be ignored. This parameter is options.
1112
It may be used multiple times.
1113
 
1114
=item B<-extract=name>
1115
 
1116
This option will process the 'extract' file created in a previous run of this
1117
program and extract source files for the package-versions found in the file.
1118
 
1119
The command will then create a log file recording packages that could ne be
1120
extracted.
1121
 
1122
This option does not not interwork with many of the other command line options.
1123
This option cannot be used in conjunction with the -rtagid, -sbomid, rootpackage
1124
and -nopatch.
1125
 
1126
=item B<-[no]patch>
1127
 
1128
This option is used ignore patches. If -nopatch is selected, then packages
1129
versions that look like a patch will be added to the ignore list.
1130
 
1131
=item B<-[no]test>
1132
 
1133
This option is used for testing. It will only process the first two OS entries
1134
in the SBOM. This speeds up processing. It does not generate a complete list of
1135
packages.
1136
 
1137
=item B<-verbose>
1138
 
1139
This option will display progress information as the program executes.
1140
 
1141
=back
1142
 
1143
=head1 DESCRIPTION
1144
 
1145
This program is a tool for extracting Escrow build information.
1146
The program has two modes of operation:
1147
 
1148
=over 8
1149
 
1150
=item 1. Generation. Generate files describing packages within an SBOM/Release/
1151
Package.
1152
 
1153
=item 2. Extraction  Supervise extraction of source trees.
1154
 
1155
=back
1156
 
1157
=head2 Generation Operations
1158
 
1159
This program has several modes of operation. The mode is determined from the
1160
command line arguments provided.
1161
 
1162
=over 8
1163
 
1164
=item   Full Escrow
1165
 
1166
This mode requires an SBOM_ID. If an RTAG_ID is also provided, then additional
1167
information will be generated.
1168
 
1169
=item   Release Escrow
1170
 
1171
If only an RTAG_ID is provided then the processing wil be limited to the
1172
packages involved in creating the specified release.
1173
 
1174
If a 'rootpackage' name is provided, then the processing is limited to
1175
packages that depend on the named package.
1176
 
1177
=item   Single Package
1178
 
1179
If a package name and a package version are specified on the command line,
1180
then the processing will be limited to the specified package and ist dependents.
1181
No release related information will be provided.
1182
 
1183
=back
1184
 
1185
The 'Full Escrow' extract is the complete operation. All others are sub-sets of
1186
this processing. The complete processing is:
1187
 
1188
=over 8
1189
 
1190
=item * Determine all the NODES in the SBOM
1191
 
1192
=item * Determine all the Base Packages for each NODE
1193
 
1194
=item * Determine all the Packages for each NODE
1195
 
1196
=item * Determine all the dependent packages for all packages encountered
1197
 
1198
=item * Generate a list of jats commands to extract the package source
1199
 
1200
=item * Generate a file describing the build order
1201
 
1202
=item * Generate a file describing the packages that cannot be built
1203
 
1204
=item * Generate an HTML file with extensive cross reference information
1205
 
1206
=over 8
1207
 
1208
=item * List of all packages with references into Release Manager
1209
 
1210
=item * List of all packages showing dependent packages
1211
 
1212
=item * List of all packages showing consumer packages
1213
 
1214
=item * List of all packages for which multiple versions are required
1215
 
1216
=item * Details of packages that are not built.
1217
 
1218
=item * Build order
1219
 
1220
=item * Build machines and built types
1221
 
1222
=item * Deployed target nodes, with references into Deployment Manager
1223
 
1224
=back
1225
 
1226
=back
1227
 
1228
This may take some time, as a typical escrow build may contain many hundreds of packages.
1229
 
1230
The program will display a list of files that have been created.
1231
 
1232
=head2 Extraction Operations
1233
 
1234
Given an 'extract' file from a previous run of this program the program will:
1235
 
1236
=over 8
1237
 
1238
=item * Parse the 'extract' file
1239
 
1240
=item * Create subdirectories for each package version within the file. This is done
1241
in such a way that no views are left in place.
1242
 
1243
=item * Create a log file showing packages that could not be extracted.
1244
 
1245
=back
1246
 
1247
=cut
1248