Subversion Repositories DevTools

Rev

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

Rev Author Line No. Line
392 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 required to build a given package version
10 
#                 Create various bits of useful information
11 
#                   Extract commands
12 
#                   Build Order
13 
#                   Depenendency Info
14 
#
15 
#
16 
#......................................................................#
17 
 
18 
require 5.006_001;
19 
use strict;
20 
use warnings;
21 
use JatsEnv;
22 
use JatsError;
23 
use JatsRmApi;
24 
use DBI;
25 
use Getopt::Long;
26 
use Pod::Usage;                             # required for help support
27 
use Storable qw (dclone);
28 
 
29 
 
30 
#
31 
#   Config Options
32 
#
33 
my $VERSION = "1.0.0";              # Update this
34 
my $opt_help = 0;
35 
my $opt_manual;
36 
my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose
37 
my $opt_test = 0;
38 
 
39 
#
40 
#   Data Base Interface
41 
#
42 
my $RM_DB;
43 
 
44 
#
45 
#   Global variables
46 
#
47 
my $pv_id;                      # Root Package
48 
my $prefix;
49 
my %Package;                    # Per Package information
50 
my @StrayPackages;              # Non-top level packages
51 
my @create_list;                # List of files created
52 
 
53 
#
54 
#   Build types. Should be populated from a table
55 
#
56 
my %BM_ID = (
57 
    1 => "Solaris",
58 
    2 => "Win32",
59 
    3 => "Linux",
60 
    4 => "Generic",
61 
);
62 
 
63 
my %BSA_ID = (
64 
    1 => "Jats Debug",
65 
    2 => "Jats Prod",
66 
    3 => "Jats Debug+Prod",
67 
    4 => "Ant Java 1.4",
68 
    5 => "Ant Java 1.5",
69 
);
70 
 
71 
 
72 
#-------------------------------------------------------------------------------
73 
# Function        : Main
74 
#
75 
# Description     : Main entry point
76 
#                   Parse user options
77 
#
78 
# Inputs          :
79 
#
80 
# Returns         :
81 
#
82 
 
83 
my $result = GetOptions (
84 
                "help+"         => \$opt_help,              # flag, multiple use allowed
85 
                "manual"        => \$opt_manual,            # flag
86 
                "verbose+"      => \$opt_verbose,           # flag
87 
                "pv_id=s"       => \$pv_id,
88 
                "test!"         => \$opt_test,              #[no]flag
89 
                );
90 
 
91 
#
92 
#   Process help and manual options
93 
#
94 
pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result);
95 
pod2usage(-verbose => 1)  if ($opt_help == 2 );
96 
pod2usage(-verbose => 2)  if ($opt_manual || ($opt_help > 2));
97 
 
98 
ErrorConfig( 'name'    => 'PLAY17',
99 
             'verbose' => $opt_verbose );
100 
 
101 
#
102 
#   Determine root package
103 
#
104 
unless (( $ARGV[0] && $ARGV[1] ) || ( $pv_id ))
105 
{
106 
    print "Specify a package as 'name' 'version', or a pv_id\n";
107 
    exit;
108 
}
109 
 
110 
#
111 
#   Determines the PV_ID for the root package
112 
#
113 
if ( $pv_id )
114 
{
115 
    $prefix = 'pvid_' . $pv_id;
116 
}
117 
else
118 
{
119 
    $prefix = $ARGV[0] . '_' . $ARGV[1];
120 
    $pv_id = getPkgDetailsByName(  $ARGV[0], $ARGV[1] );
121 
    Error ("Package version not found") unless ( $pv_id );
122 
}
123 
 
124 
#
125 
#   Determine the dependent packages for the Top Package
126 
#
127 
getPkgDetailsByPV_ID( $pv_id);
128 
LocateStrays();
129 
 
130 
#
131 
#   Generate output files
132 
#       1) Jats extract commands
133 
#       2) Error list
134 
my $file;
135 
$file = "${prefix}_extract.txt";
136 
push @create_list, $file;
137 
open (JE, ">$file" ) || Error ("Cannot create $file");
138 
 
139 
$file = "${prefix}_status.txt";
140 
push @create_list, $file;
141 
 
142 
open (ST, ">$file" ) || Error("Cannot create $file");
143 
print ST "Cannot build:\n";
144 
 
145 
foreach my $name ( sort keys %Package )
146 
{
147 
    foreach my $ver ( sort keys %{$Package{$name}} )
148 
    {
149 
 
150 
        my $label = $Package{$name}{$ver}{label} || '';
151 
        my $path = $Package{$name}{$ver}{path} || '';
152 
        my $mtest = exists ($Package{$name}{$ver}{build} ) || '0';
153 
        my @reason;
154 
 
155 
        push @reason, 'No Label' unless ( $label );
156 
        push @reason, 'Bad Label, N/A' if ( $label =~ s~^N/A$~~i || $label  =~ s~^na$~~i );
157 
 
158 
        push @reason, 'No Source Path' unless ( $path );
159 
        push @reason, 'Bad Path, N/A' if ( $path =~ m~^N/A$~i || $path  =~ m~^na$~i );
160 
        push @reason, 'Bad Path, dpkg' if ( $path =~ m~^/dpkg_archive~ || $path  =~ m~^dpkg_archive~ );
161 
        push @reason, 'Bad Path, http' if ( $path =~ m~^http:~i );
162 
 
163 
        push @reason, 'No Build System' unless ( exists ($Package{$name}{$ver}{build} ) );
164 
 
165 
        unless ( @reason )
166 
        {
167 
            my $vname = "$name $ver";
168 
            $vname =~ s~ ~_~g;
169 
            $vname =~ s~__~~g;
170 
 
171 
            print JE "jats extract -view=$vname -label=$label -path=$path -root=. -noprefix\n";
172 
        }
173 
        else
174 
        {
175 
            $Package{$name}{$ver}{bad_extract} = [@reason];
176 
            printf ST "%40s %20s %50s (%s) %s\n", $name, $ver, $label, $mtest, $path ;
177 
        }
178 
    }
179 
}
180 
 
181 
close (JE);
182 
close (ST);
183 
 
184 
#
185 
#   Generate build order info
186 
#
187 
BuildOrder();
188 
 
189 
#
190 
#   Display names of files created
191 
#
192 
foreach my $file ( sort @create_list )
193 
{
194 
    Message ("Created: $file");
195 
}
196 
exit;
197 
 
198 
 
199 
sub getPkgDetailsByName
200 
{
201 
    my ($pname, $pver) = @_;
202 
    my $pv_id;
203 
    my (@row);
204 
 
205 
    # if we are not or cannot connect then return 0 as we have not found anything
206 
    connectRM( \$RM_DB);
207 
 
208 
    # First get details for a given package version
209 
 
210 
    my $m_sqlstr = "SELECT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION" .
211 
                    " FROM PACKAGE_VERSIONS pv, PACKAGES pkg" .
212 
                    " WHERE pkg.PKG_NAME = \'$pname\' AND pv.PKG_VERSION = \'$pver\' AND pv.PKG_ID = pkg.PKG_ID";
213 
    my $sth = $RM_DB->prepare($m_sqlstr);
214 
    if ( defined($sth) )
215 
    {
216 
        if ( $sth->execute( ) )
217 
        {
218 
            if ( $sth->rows )
219 
            {
220 
                while ( @row = $sth->fetchrow_array )
221 
                {
222 
                    $pv_id = $row[0];
223 
                    my $name = $row[1];
224 
                    my $ver = $row[2];
225 
                    Verbose( "PV_ID= $pv_id");
226 
                }
227 
            }
228 
            $sth->finish();
229 
        }
230 
    }
231 
    else
232 
    {
233 
        Error("Prepare failure" );
234 
    }
235 
    return $pv_id;
236 
}
237 
 
238 
 
239 
#-------------------------------------------------------------------------------
240 
# Function        : getPkgDetailsByPV_ID
241 
#
242 
# Description     : Populate the Packages structure given a PV_ID
243 
#                   Called for each package in the SBOM
244 
#
245 
# Inputs          : PV_ID           - Package Unique Identifier
246 
#
247 
# Returns         : Populates Package
248 
#
249 
sub getPkgDetailsByPV_ID
250 
{
251 
    my ($PV_ID) = @_;
252 
    my $foundDetails = 0;
253 
    my (@row);
254 
 
255 
    connectRM(\$RM_DB) unless ($RM_DB);
256 
 
257 
    # First get details from pv_id
258 
 
259 
    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" .
260 
                    " FROM PACKAGE_VERSIONS pv, PACKAGES pkg, PACKAGE_BUILD_INFO pbi" .
261 
                    " WHERE pv.PV_ID = \'$PV_ID\' AND pv.PKG_ID = pkg.PKG_ID AND pv.PV_ID = pbi.PV_ID (+) ";
262 
 
263 
    my $sth = $RM_DB->prepare($m_sqlstr);
264 
    if ( defined($sth) )
265 
    {
266 
        if ( $sth->execute( ) )
267 
        {
268 
            if ( $sth->rows )
269 
            {
270 
                while ( @row = $sth->fetchrow_array )
271 
                {
272 
                    my $pv_id       = $row[0];
273 
                    my $name        = $row[1];
274 
                    my $ver         = $row[2];
275 
                    my $label       = $row[3] || '';
276 
                    my $path        = $row[4] || '';
277 
                    my $deployable  = $row[5];
278 
                    my $build_info  = $row[6] || '';
279 
                    my $build_mach  = $row[7] || '';
280 
 
281 
                    #
282 
                    #   BSA_ID: 1:debug, 2:prod, 3:debug+prod, 4:Java1.4 5: Java 1.5
283 
                    #   BM_ID : 1:solaris, 2:win32, 3: linux, 4:generic
284 
                    #
285 
 
286 
                    Verbose ("getPkgDetailsByPV_ID: $PV_ID, $name, $ver, $build_mach ,$build_info");
287 
 
288 
                    $path =~ tr~\\/~/~s;
289 
 
290 
                    $Package{$name}{$ver}{pvid} = $PV_ID;
291 
                    $Package{$name}{$ver}{done} = 1;
292 
                    $Package{$name}{$ver}{base} = 1;
293 
                    $Package{$name}{$ver}{deployable} = 1 if ($deployable);
294 
                    $Package{$name}{$ver}{label} = $label;
295 
                    $Package{$name}{$ver}{path} = $path;
296 
                    $Package{$name}{$ver}{build}{$build_mach} = $build_info if $build_mach;
297 
 
298 
                    GetDepends( $pv_id, $name, $ver );
299 
 
300 
                }
301 
            }
302 
            else
303 
            {
304 
                Warning ("No Package details for: PVID: $PV_ID");
305 
            }
306 
            $sth->finish();
307 
        }
308 
        else
309 
        {
310 
            Error("getPkgDetailsByPV_ID: Execute failure", $m_sqlstr );
311 
        }
312 
    }
313 
    else
314 
    {
315 
        Error("Prepare failure" );
316 
    }
317 
}
318 
 
319 
#-------------------------------------------------------------------------------
320 
# Function        : GetDepends
321 
#
322 
# Description     : Extract the dependancies for a given package version
323 
#
324 
# Inputs          : $pvid
325 
#
326 
# Returns         :
327 
#
328 
sub GetDepends
329 
{
330 
    my ($pv_id, $pname, $pver ) = @_;
331 
 
332 
    connectRM(\$RM_DB) unless ($RM_DB);
333 
 
334 
    #
335 
    #   Now extract the package dependacies
336 
    #
337 
    my $m_sqlstr = "SELECT pkg.PKG_NAME, pv.PKG_VERSION, pd.DPV_ID" .
338 
                   " FROM PACKAGE_DEPENDENCIES pd, PACKAGE_VERSIONS pv, PACKAGES pkg" .
339 
                   " WHERE pd.PV_ID = \'$pv_id\' AND pd.DPV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID";
340 
    my $sth = $RM_DB->prepare($m_sqlstr);
341 
    if ( defined($sth) )
342 
    {
343 
        if ( $sth->execute( ) )
344 
        {
345 
            if ( $sth->rows )
346 
            {
347 
                my %depends;
348 
                while ( my @row = $sth->fetchrow_array )
349 
                {
350 
#print "$pname $pver ===== @row\n";
351 
                    my $name = $row[0];
352 
                    my $ver = $row[1];
353 
 
354 
                    Verbose2( "       Depends: $name, $ver");
355 
 
356 
                    $depends{$name,$ver} = 1;
357 
                    $Package{$name}{$ver}{usedby}{$pname,$pver} = 1;
358 
 
359 
                    unless ( exists $Package{$name}{$ver}{done} )
360 
                    {
361 
                        my @DATA = ($name, $ver, $row[2]);
362 
                        push @StrayPackages, \@DATA;
363 
                    }
364 
                }
365 
                $Package{$pname}{$pver}{depends} = \%depends;
366 
            }
367 
            $sth->finish();
368 
        }
369 
    }
370 
    else
371 
    {
372 
        Error("GetDepends:Prepare failure" );
373 
    }
374 
}
375 
 
376 
 
377 
#-------------------------------------------------------------------------------
378 
# Function        : LocateStrays
379 
#
380 
# Description     : Locate stray packages
381 
#                   These are packages that have not been defined by the
382 
#                   top level SBOM. These are not really stray
383 
#
384 
# Inputs          :
385 
#
386 
# Returns         :
387 
#
388 
sub LocateStrays
389 
{
390 
    while ( $#StrayPackages >= 0 )
391 
    {
392 
        my $DATA = pop @StrayPackages;
393 
        my $name = $DATA->[0];
394 
        my $ver = $DATA->[1];
395 
        my $pv_id = $DATA->[2];
396 
 
397 
        next if ( exists $Package{$name}{$ver}{done} );
398 
#print "Stray: $pv_id, $name, $ver\n";
399 
        getPkgDetailsByPV_ID ( $pv_id );
400 
        $Package{$name}{$ver}{stray} = 1;
401 
    }
402 
}
403 
 
404 
#-------------------------------------------------------------------------------
405 
# Function        : BuildOrder
406 
#
407 
# Description     : Determine the order to build packages
408 
#
409 
# Inputs          :
410 
#
411 
# Returns         :
412 
#
413 
sub BuildOrder
414 
{
415 
    foreach my $name ( keys %Package )
416 
    {
417 
        foreach my $ver ( keys %{$Package{$name}} )
418 
        {
419 
            AddToBuildList( $name, $ver, $Package{$name}{$ver}{depends} );
420 
        }
421 
    }
422 
 
423 
    DetermineBuildOrder();
424 
}
425 
 
426 
#-------------------------------------------------------------------------------
427 
# Function        : AddToBuildList
428 
#
429 
# Description     : Add packages to a build list
430 
#
431 
# Inputs          : PackageName
432 
#                   PackageVersion
433 
#                   Hash of dependancies
434 
#
435 
# Returns         :
436 
#
437 
my %BuildList;
438 
sub AddToBuildList
439 
{
440 
    my ($name, $ver, $pdepends ) = @_;
441 
 
442 
    Warning ("Duplicate Package to build: $name, $ver") if exists $BuildList{$name,$ver};
443 
 
444 
    #
445 
    #   Clone dependancies as we will destroy the list as we process data
446 
    #
447 
    my $ref;
448 
    $ref = dclone ($pdepends ) if $pdepends;
449 
    $BuildList{$name,$ver}{depends} = $ref;
450 
}
451 
 
452 
#-------------------------------------------------------------------------------
453 
# Function        : DetermineBuildOrder
454 
#
455 
# Description     : Determine the build order
456 
#
457 
# Inputs          :
458 
#
459 
# Returns         :
460 
#
461 
sub DetermineBuildOrder
462 
{
463 
 
464 
    my $file = "${prefix}_buildinfo.txt";
465 
    push @create_list, $file;
466 
 
467 
    open (BI, ">$file" )  || Error ("Cannot create $file");
468 
 
469 
#    DebugDumpData ("BuildList", \%BuildList); exit 1;
470 
 
471 
    my $more = 1;
472 
    my $level = 0;
473 
    while ( $more )
474 
    {
475 
        my @build;
476 
        $level ++;
477 
        $more = 0;
478 
        foreach my $key ( keys %BuildList )
479 
        {
480 
            #
481 
            #   Locate packges with no dependencies left
482 
            #
483 
            next if ( keys %{$BuildList{$key}{depends}} );
484 
            push @build, $key;
485 
        }
486 
 
487 
        foreach my $build ( @build )
488 
        {
489 
            $more = 1;
490 
            delete $BuildList{$build};
491 
            my ($name, $ver) = split $;, $build;
492 
 
493 
            my $label = $Package{$name}{$ver}{label} || '';
494 
            my $path  = $Package{$name}{$ver}{path} || '';
495 
            $Package{$name}{$ver}{buildorder}  = $level;
496 
 
497 
            printf BI "Build(%2d): %40s %15s %-55s %s\n", $level, $name, $ver, $label, $path;
498 
            printf "Build(%2d): %40s %15s %s\n", $level, $name, $ver, $label;
499 
        }
500 
 
501 
        #
502 
        #   Delete dependencies
503 
        #
504 
        foreach my $key ( keys %BuildList )
505 
        {
506 
            foreach my $build ( @build )
507 
            {
508 
                delete $BuildList{$key}{depends}->{$build};
509 
            }
510 
        }
511 
    }
512 
    close BI;
513 
}
514 
 
515 
 
516 
 
517 
#-------------------------------------------------------------------------------
518 
#   Documentation
519 
#
520 
 
521 
=pod
522 
 
523 
=head1 NAME
524 
 
525 
escrow - Extract Escrow Build Information
526 
 
527 
=head1 SYNOPSIS
528 
 
529 
  jats escrow [options] -sbomid=<sbomid>
530 
 
531 
 Options:
532 
    -help              - brief help message
533 
    -help -help        - Detailed help message
534 
    -man               - Full documentation
535 
    -verbose           - Enable verbose output
536 
    -[no]test          - Reduced package scanning for test
537 
 
538 
=head1 OPTIONS
539 
 
540 
=over 8
541 
 
542 
=item B<-help>
543 
 
544 
Print a brief help message and exits.
545 
 
546 
=item B<-help -help>
547 
 
548 
Print a detailed help message with an explanation for each option.
549 
 
550 
=item B<-man>
551 
 
552 
Prints the manual page and exits.
553 
 
554 
=item B<[no]test>
555 
 
556 
This option is used for testing. It will only process the first two OS entries
557 
in the SBOM. This speeds up processing. It does not generate a complete list of
558 
packages.
559 
 
560 
 
561 
=item B<verbose>
562 
 
563 
This option will display progress information as the program executes.
564 
 
565 
=back
566 
 
567 
=head1 DESCRIPTION
568 
 
569 
This program is a tool for extracting Escrow build information.
570 
 
571 
Given an SBOM_ID this program will:
572 
 
573 
=over 8
574 
 
575 
=item * Determine all the NODES in the SBOM
576 
 
577 
=item * Determine all the Base Packages for each NODE
578 
 
579 
=item * Determine all the Packages for each NODE
580 
 
581 
=item * Determine all the dependent packages for all packages encountered
582 
 
583 
=item * Generate a list of jats commands to extract the package source
584 
 
585 
=item * Generate a file describing the build order
586 
 
587 
=item * Generate a file describing the packages that cannot be built
588 
 
589 
=item * Generate an HTML file with extensive cross reference information
590 
 
591 
=over 8
592 
 
593 
=item * List of all packages with references into Release Manager
594 
 
595 
=item * List of all packages showing dependent packages
596 
 
597 
=item * List of all packages showing consumer packages
598 
 
599 
=item * List of all packages for which multiple versions are required
600 
 
601 
=item * Details of packages that are not built.
602 
 
603 
=item * Build order
604 
 
605 
=item * Build machines and built types
606 
 
607 
=item * Deployed target nodes, with references into deployment manager
608 
 
609 
=back
610 
 
611 
=back
612 
 
613 
This may take some time, as a typical escrow build may contain many hundreds of packages.
614 
 
615 
The program will display a list of files that have been created.
616 
 
617 
=cut
618