Subversion Repositories DevTools

Rev

Rev 2026 | Blame | Compare with Previous | Last modification | View Log | RSS feed 

########################################################################
# Copyright ( C ) 2007 ERG Limited, All rights reserved
#
# Module name   : jats.sh
# Module type   : Makefile system
# Compiler(s)   : n/a
# Environment(s): jats
#
# Description   : Determine packages required to build a given package version
#                 Create various bits of useful information
#                   Extract commands
#                   Build Order
#                   Depenendency Info
#
#
#......................................................................#

require 5.006_001;
use strict;
use warnings;
use JatsEnv;
use JatsError;
use JatsRmApi;
use DBI;
use Getopt::Long;
use Pod::Usage;                             # required for help support
use Storable qw (dclone);


#
#   Config Options
#
my $VERSION = "1.0.0";              # Update this
my $opt_help = 0;
my $opt_manual;
my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose
my $opt_test = 0;

#
#   Data Base Interface
#
my $RM_DB;

#
#   Global variables
#
my $pv_id;                      # Root Package
my $prefix;
my %Package;                    # Per Package information
my @StrayPackages;              # Non-top level packages
my @create_list;                # List of files created

#
#   Build types. Should be populated from a table
#
my %BM_ID = (
    1 => "Solaris",
    2 => "Win32",
    3 => "Linux",
    4 => "Generic",
);

my %BSA_ID = (
    1 => "Jats Debug",
    2 => "Jats Prod",
    3 => "Jats Debug+Prod",
    4 => "Ant Java 1.4",
    5 => "Ant Java 1.5",
);


#-------------------------------------------------------------------------------
# Function        : Main
#
# Description     : Main entry point
#                   Parse user options
#
# Inputs          :
#
# Returns         :
#

my $result = GetOptions (
                "help+"         => \$opt_help,              # flag, multiple use allowed
                "manual"        => \$opt_manual,            # flag
                "verbose+"      => \$opt_verbose,           # flag
                "pv_id=s"       => \$pv_id,
                "test!"         => \$opt_test,              #[no]flag
                );

#
#   Process help and manual options
#
pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result);
pod2usage(-verbose => 1)  if ($opt_help == 2 );
pod2usage(-verbose => 2)  if ($opt_manual || ($opt_help > 2));

ErrorConfig( 'name'    => 'PLAY17',
             'verbose' => $opt_verbose );

#
#   Determine root package
#
unless (( $ARGV[0] && $ARGV[1] ) || ( $pv_id ))
{
    print "Specify a package as 'name' 'version', or a pv_id\n";
    exit;
}

#
#   Determines the PV_ID for the root package
#
if ( $pv_id )
{
    $prefix = 'pvid_' . $pv_id;
}
else
{
    $prefix = $ARGV[0] . '_' . $ARGV[1];
    $pv_id = getPkgDetailsByName(  $ARGV[0], $ARGV[1] );
    Error ("Package version not found") unless ( $pv_id );
}

#
#   Determine the dependent packages for the Top Package
#
getPkgDetailsByPV_ID( $pv_id);
LocateStrays();

#
#   Generate output files
#       1) Jats extract commands
#       2) Error list
my $file;
$file = "${prefix}_extract.txt";
push @create_list, $file;
open (JE, ">$file" ) || Error ("Cannot create $file");

$file = "${prefix}_status.txt";
push @create_list, $file;

open (ST, ">$file" ) || Error("Cannot create $file");
print ST "Cannot build:\n";

foreach my $name ( sort keys %Package )
{
    foreach my $ver ( sort keys %{$Package{$name}} )
    {

        my $label = $Package{$name}{$ver}{label} || '';
        my $path = $Package{$name}{$ver}{path} || '';
        my $mtest = exists ($Package{$name}{$ver}{build} ) || '0';
        my @reason;

        push @reason, 'No Label' unless ( $label );
        push @reason, 'Bad Label, N/A' if ( $label =~ s~^N/A$~~i || $label  =~ s~^na$~~i );

        push @reason, 'No Source Path' unless ( $path );
        push @reason, 'Bad Path, N/A' if ( $path =~ m~^N/A$~i || $path  =~ m~^na$~i );
        push @reason, 'Bad Path, dpkg' if ( $path =~ m~^/dpkg_archive~ || $path  =~ m~^dpkg_archive~ );
        push @reason, 'Bad Path, http' if ( $path =~ m~^http:~i );

        push @reason, 'No Build System' unless ( exists ($Package{$name}{$ver}{build} ) );

        unless ( @reason )
        {
            my $vname = "$name $ver";
            $vname =~ s~ ~_~g;
            $vname =~ s~__~~g;

            print JE "jats extract -view=$vname -label=$label -path=$path -root=. -noprefix\n";
        }
        else
        {
            $Package{$name}{$ver}{bad_extract} = [@reason];
            printf ST "%40s %20s %50s (%s) %s\n", $name, $ver, $label, $mtest, $path ;
        }
    }
}

close (JE);
close (ST);

#
#   Generate build order info
#
BuildOrder();

#
#   Display names of files created
#
foreach my $file ( sort @create_list )
{
    Message ("Created: $file");
}
exit;


sub getPkgDetailsByName
{
    my ($pname, $pver) = @_;
    my $pv_id;
    my (@row);

    # if we are not or cannot connect then return 0 as we have not found anything
    connectRM( \$RM_DB);

    # First get details for a given package version

    my $m_sqlstr = "SELECT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION" .
                    " FROM PACKAGE_VERSIONS pv, PACKAGES pkg" .
                    " WHERE pkg.PKG_NAME = \'$pname\' AND pv.PKG_VERSION = \'$pver\' AND pv.PKG_ID = pkg.PKG_ID";
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    $pv_id = $row[0];
                    my $name = $row[1];
                    my $ver = $row[2];
                    Verbose( "PV_ID= $pv_id");
                }
            }
            $sth->finish();
        }
    }
    else
    {
        Error("Prepare failure" );
    }
    return $pv_id;
}


#-------------------------------------------------------------------------------
# Function        : getPkgDetailsByPV_ID
#
# Description     : Populate the Packages structure given a PV_ID
#                   Called for each package in the SBOM
#
# Inputs          : PV_ID           - Package Unique Identifier
#
# Returns         : Populates Package
#
sub getPkgDetailsByPV_ID
{
    my ($PV_ID) = @_;
    my $foundDetails = 0;
    my (@row);

    connectRM(\$RM_DB) unless ($RM_DB);

    # First get details from pv_id

    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" .
                    " FROM PACKAGE_VERSIONS pv, PACKAGES pkg, PACKAGE_BUILD_INFO pbi" .
                    " WHERE pv.PV_ID = \'$PV_ID\' AND pv.PKG_ID = pkg.PKG_ID AND pv.PV_ID = pbi.PV_ID (+) ";

    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                while ( @row = $sth->fetchrow_array )
                {
                    my $pv_id       = $row[0];
                    my $name        = $row[1];
                    my $ver         = $row[2];
                    my $label       = $row[3] || '';
                    my $path        = $row[4] || '';
                    my $deployable  = $row[5];
                    my $build_info  = $row[6] || '';
                    my $build_mach  = $row[7] || '';

                    #
                    #   BSA_ID: 1:debug, 2:prod, 3:debug+prod, 4:Java1.4 5: Java 1.5
                    #   BM_ID : 1:solaris, 2:win32, 3: linux, 4:generic
                    #

                    Verbose ("getPkgDetailsByPV_ID: $PV_ID, $name, $ver, $build_mach ,$build_info");

                    $path =~ tr~\\/~/~s;

                    $Package{$name}{$ver}{pvid} = $PV_ID;
                    $Package{$name}{$ver}{done} = 1;
                    $Package{$name}{$ver}{base} = 1;
                    $Package{$name}{$ver}{deployable} = 1 if ($deployable);
                    $Package{$name}{$ver}{label} = $label;
                    $Package{$name}{$ver}{path} = $path;
                    $Package{$name}{$ver}{build}{$build_mach} = $build_info if $build_mach;

                    GetDepends( $pv_id, $name, $ver );

                }
            }
            else
            {
                Warning ("No Package details for: PVID: $PV_ID");
            }
            $sth->finish();
        }
        else
        {
            Error("getPkgDetailsByPV_ID: Execute failure", $m_sqlstr );
        }
    }
    else
    {
        Error("Prepare failure" );
    }
}

#-------------------------------------------------------------------------------
# Function        : GetDepends
#
# Description     : Extract the dependancies for a given package version
#
# Inputs          : $pvid
#
# Returns         :
#
sub GetDepends
{
    my ($pv_id, $pname, $pver ) = @_;

    connectRM(\$RM_DB) unless ($RM_DB);

    #
    #   Now extract the package dependacies
    #
    my $m_sqlstr = "SELECT pkg.PKG_NAME, pv.PKG_VERSION, pd.DPV_ID" .
                   " FROM PACKAGE_DEPENDENCIES pd, PACKAGE_VERSIONS pv, PACKAGES pkg" .
                   " WHERE pd.PV_ID = \'$pv_id\' AND pd.DPV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID";
    my $sth = $RM_DB->prepare($m_sqlstr);
    if ( defined($sth) )
    {
        if ( $sth->execute( ) )
        {
            if ( $sth->rows )
            {
                my %depends;
                while ( my @row = $sth->fetchrow_array )
                {
#print "$pname $pver ===== @row\n";
                    my $name = $row[0];
                    my $ver = $row[1];

                    Verbose2( "       Depends: $name, $ver");

                    $depends{$name,$ver} = 1;
                    $Package{$name}{$ver}{usedby}{$pname,$pver} = 1;

                    unless ( exists $Package{$name}{$ver}{done} )
                    {
                        my @DATA = ($name, $ver, $row[2]);
                        push @StrayPackages, \@DATA;
                    }
                }
                $Package{$pname}{$pver}{depends} = \%depends;
            }
            $sth->finish();
        }
    }
    else
    {
        Error("GetDepends:Prepare failure" );
    }
}


#-------------------------------------------------------------------------------
# Function        : LocateStrays
#
# Description     : Locate stray packages
#                   These are packages that have not been defined by the
#                   top level SBOM. These are not really stray
#
# Inputs          :
#
# Returns         :
#
sub LocateStrays
{
    while ( $#StrayPackages >= 0 )
    {
        my $DATA = pop @StrayPackages;
        my $name = $DATA->[0];
        my $ver = $DATA->[1];
        my $pv_id = $DATA->[2];

        next if ( exists $Package{$name}{$ver}{done} );
#print "Stray: $pv_id, $name, $ver\n";
        getPkgDetailsByPV_ID ( $pv_id );
        $Package{$name}{$ver}{stray} = 1;
    }
}

#-------------------------------------------------------------------------------
# Function        : BuildOrder
#
# Description     : Determine the order to build packages
#
# Inputs          :
#
# Returns         :
#
sub BuildOrder
{
    foreach my $name ( keys %Package )
    {
        foreach my $ver ( keys %{$Package{$name}} )
        {
            AddToBuildList( $name, $ver, $Package{$name}{$ver}{depends} );
        }
    }
    
    DetermineBuildOrder();
}

#-------------------------------------------------------------------------------
# Function        : AddToBuildList
#
# Description     : Add packages to a build list
#
# Inputs          : PackageName
#                   PackageVersion
#                   Hash of dependancies
#
# Returns         :
#
my %BuildList;
sub AddToBuildList
{
    my ($name, $ver, $pdepends ) = @_;

    Warning ("Duplicate Package to build: $name, $ver") if exists $BuildList{$name,$ver};

    #
    #   Clone dependancies as we will destroy the list as we process data
    #
    my $ref;
    $ref = dclone ($pdepends ) if $pdepends;
    $BuildList{$name,$ver}{depends} = $ref;
}

#-------------------------------------------------------------------------------
# Function        : DetermineBuildOrder
#
# Description     : Determine the build order
#
# Inputs          :
#
# Returns         :
#
sub DetermineBuildOrder
{

    my $file = "${prefix}_buildinfo.txt";
    push @create_list, $file;
    
    open (BI, ">$file" )  || Error ("Cannot create $file");

#    DebugDumpData ("BuildList", \%BuildList); exit 1;

    my $more = 1;
    my $level = 0;
    while ( $more )
    {
        my @build;
        $level ++;
        $more = 0;
        foreach my $key ( keys %BuildList )
        {
            #
            #   Locate packges with no dependencies left
            #
            next if ( keys %{$BuildList{$key}{depends}} );
            push @build, $key;
        }

        foreach my $build ( @build )
        {
            $more = 1;
            delete $BuildList{$build};
            my ($name, $ver) = split $;, $build;

            my $label = $Package{$name}{$ver}{label} || '';
            my $path  = $Package{$name}{$ver}{path} || '';
            $Package{$name}{$ver}{buildorder}  = $level;

            printf BI "Build(%2d): %40s %15s %-55s %s\n", $level, $name, $ver, $label, $path;
            printf "Build(%2d): %40s %15s %s\n", $level, $name, $ver, $label;
        }

        #
        #   Delete dependencies
        #
        foreach my $key ( keys %BuildList )
        {
            foreach my $build ( @build )
            {
                delete $BuildList{$key}{depends}->{$build};
            }
        }
    }
    close BI;
}



#-------------------------------------------------------------------------------
#   Documentation
#

=pod

=head1 NAME

escrow - Extract Escrow Build Information

=head1 SYNOPSIS

  jats escrow [options] -sbomid=<sbomid>

 Options:
    -help              - brief help message
    -help -help        - Detailed help message
    -man               - Full documentation
    -verbose           - Enable verbose output
    -[no]test          - Reduced package scanning for test

=head1 OPTIONS

=over 8

=item B<-help>

Print a brief help message and exits.

=item B<-help -help>

Print a detailed help message with an explanation for each option.

=item B<-man>

Prints the manual page and exits.

=item B<[no]test>

This option is used for testing. It will only process the first two OS entries
in the SBOM. This speeds up processing. It does not generate a complete list of
packages.


=item B<verbose>

This option will display progress information as the program executes.

=back

=head1 DESCRIPTION

This program is a tool for extracting Escrow build information.

Given an SBOM_ID this program will:

=over 8

=item * Determine all the NODES in the SBOM

=item * Determine all the Base Packages for each NODE

=item * Determine all the Packages for each NODE

=item * Determine all the dependent packages for all packages encountered

=item * Generate a list of jats commands to extract the package source

=item * Generate a file describing the build order

=item * Generate a file describing the packages that cannot be built

=item * Generate an HTML file with extensive cross reference information

=over 8

=item * List of all packages with references into Release Manager

=item * List of all packages showing dependent packages

=item * List of all packages showing consumer packages

=item * List of all packages for which multiple versions are required

=item * Details of packages that are not built.

=item * Build order

=item * Build machines and built types

=item * Deployed target nodes, with references into deployment manager

=back

=back

This may take some time, as a typical escrow build may contain many hundreds of packages.

The program will display a list of files that have been created.

=cut