Subversion Repositories DevTools

Rev

Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
6887 dpurdie 1 
########################################################################
2 
# Copyright (c) VIX TECHNOLOGY (AUST) LTD
3 
#
4 
# Module name   :
5 
# Module type   : JATS Utility
6 
# Compiler(s)   : Perl
7 
# Environment(s): jats
8 
#
9 
# Description   :  Find all shared libs in dpkg_archive and see if they
10 
#                  have correct soname also in dpkg_archive
11 
#
12 
# Usage         : See POD at the end of this file
13 
#
14 
#......................................................................#
15 
 
16 
require 5.008_002;
17 
use strict;
18 
use warnings;
19 
 
20 
use Pod::Usage;
21 
use Getopt::Long;
22 
 
23 
use JatsError;
24 
 
25 
 
26 
Verbose ("Scanning dpkg_archive");
27 
opendir( PKGS, $ENV{GBE_DPKG} ) || Error ("Cannot open dpkg_archive");
28 
while ( my $pkgName = readdir(PKGS) )
29 
{
30 
    next if ( $pkgName eq '.' );
31 
    next if ( $pkgName eq '..' );
32 
    next if ( $pkgName eq 'lost+found' );
33 
 
34 
    my $pkgDir = join('/', $ENV{GBE_DPKG}, $pkgName );
35 
    if ( -d $pkgDir )
36 
    {
37 
        if (opendir (PV, $pkgDir ) )
38 
        {
39 
 
40 
            while ( my $pkgVersion = readdir(PV) )
41 
            {
42 
                next if ( $pkgVersion eq '.' );
43 
                next if ( $pkgVersion eq '..' );
44 
                next if ( $pkgVersion eq 'latest' );            # Keep latest (often symlink for build system)
45 
                next if ( $pkgVersion =~ m~\.cots$~ );            # DEBUG - COTSONLY
46 
 
47 
                my $pkgPath = join('/', $ENV{GBE_DPKG}, $pkgName,$pkgVersion );
48 
#Message("$pkgName, $pkgVersion, $pkgPath");
49 
                processPackage($pkgName, $pkgVersion, $pkgPath);
50 
            }
51 
            close(PV);
52 
        }
53 
    }
54 
}
55 
close(PKGS);
56 
 
57 
 
58 
#-------------------------------------------------------------------------------
59 
# Function        : processPackage
60 
#
61 
# Description     : Process ONE package
62 
#
63 
# Inputs          :
64 
#
65 
# Returns         :
66 
#
67 
sub processPackage
68 
{
69 
    my ($pkgName, $pkgVersion, $pkgPath) = @_;
70 
    my @dirs;
71 
    foreach my $dir (glob ("$pkgPath/lib.*"))
72 
    {
73 
        push @dirs, $dir if -d $dir;
74 
    }
75 
 
76 
    foreach my $dir (glob ("$pkgPath/lib/*"))
77 
    {
78 
        push @dirs, $dir if -d $dir;
79 
    }
80 
 
81 
#    Message("Process", @dirs);
82 
    foreach my $dir (@dirs)
83 
    {
84 
        next if $dir =~ m~SPARC~;
85 
        foreach my $file (glob( "$dir/*.so.*"))
86 
        {
87 
            next if (-l $file);
88 
            next if ( $file =~ m~\.dbg$~);
89 
            #Message("Process file: $file");
90 
 
91 
            my $soname;
92 
            open(my $fh, '-|', "objdump -p $file | grep SONAME") or die $!;
93 
            while (my $line = <$fh>)
94 
            {
95 
                next unless $line =~ m~SONAME\s+(.*)\s*$~;
96 
                $soname = $1;
97 
                last;
98 
            }
99 
            next unless defined $soname;
100 
            #Message("SONAME: $file, $soname");
101 
 
102 
            #
103 
            #   See of the sonamed file is in the same directory
104 
            #
105 
            my $sfile = join('/', $dir, $soname);
106 
            if (-f $sfile)
107 
            {
108 
                #Message("SONAME - found: $file, $soname");
109 
            }
110 
            else
111 
            {
112 
                Message("SONAME - NOTFOUND: $file, $soname");
113 
            }
114 
        }
115 
    }
116 
}