Subversion Repositories DevTools

########################################################################
# Copyright (c) VIX TECHNOLOGY (AUST) LTD
#
# Module name   : 
# Module type   : JATS Utility
# Compiler(s)   : Perl
# Environment(s): jats
#
# Description   :  Find all shared libs in dpkg_archive and see if they
#                  have correct soname also in dpkg_archive
#
# Usage         : See POD at the end of this file
#
#......................................................................#

require 5.008_002;
use strict;
use warnings;

use Pod::Usage;
use Getopt::Long;

use JatsError;


Verbose ("Scanning dpkg_archive");
opendir( PKGS, $ENV{GBE_DPKG} ) || Error ("Cannot open dpkg_archive");
while ( my $pkgName = readdir(PKGS) )
{
    next if ( $pkgName eq '.' );
    next if ( $pkgName eq '..' );
    next if ( $pkgName eq 'lost+found' );

    my $pkgDir = join('/', $ENV{GBE_DPKG}, $pkgName );
    if ( -d $pkgDir )
    {
        if (opendir (PV, $pkgDir ) )
        {

            while ( my $pkgVersion = readdir(PV) )
            {
                next if ( $pkgVersion eq '.' );
                next if ( $pkgVersion eq '..' );
                next if ( $pkgVersion eq 'latest' );            # Keep latest (often symlink for build system)
                next if ( $pkgVersion =~ m~\.cots$~ );            # DEBUG - COTSONLY

                my $pkgPath = join('/', $ENV{GBE_DPKG}, $pkgName,$pkgVersion );
#Message("$pkgName, $pkgVersion, $pkgPath");
                processPackage($pkgName, $pkgVersion, $pkgPath);
            }
            close(PV);
        }
    }
}
close(PKGS);


#-------------------------------------------------------------------------------
# Function        : processPackage  
#
# Description     : Process ONE package
#
# Inputs          : 
#
# Returns         : 
#
sub processPackage
{
    my ($pkgName, $pkgVersion, $pkgPath) = @_;
    my @dirs;
    foreach my $dir (glob ("$pkgPath/lib.*"))
    {
        push @dirs, $dir if -d $dir;
    }

    foreach my $dir (glob ("$pkgPath/lib/*"))
    {
        push @dirs, $dir if -d $dir;
    }

#    Message("Process", @dirs);
    foreach my $dir (@dirs)
    {
        next if $dir =~ m~SPARC~;
        foreach my $file (glob( "$dir/*.so.*"))
        {
            next if (-l $file);
            next if ( $file =~ m~\.dbg$~);
            #Message("Process file: $file");

            my $soname;
            open(my $fh, '-|', "objdump -p $file | grep SONAME") or die $!;
            while (my $line = <$fh>)
            {
                next unless $line =~ m~SONAME\s+(.*)\s*$~;
                $soname = $1;
                last;
            }
            next unless defined $soname;
            #Message("SONAME: $file, $soname");

            #
            #   See of the sonamed file is in the same directory
            #
            my $sfile = join('/', $dir, $soname);
            if (-f $sfile)
            {
                #Message("SONAME - found: $file, $soname");
            }
            else
            {
                Message("SONAME - NOTFOUND: $file, $soname");
            }
        }
    }
}