Description: |
This is a preliminary version -- with/ output via Data::Dumper
and lacking POD (: "it's all in code", see region around
GetOptions()) -- to find linked libraries in files related to
FreeBSD ports.
This came about due to recent OpenSSL security advisories,
necessitating rebuild of ports which were linked to old libraries.
Dmitry Marakasov in message
<20060907181108.GB90551@hades.panopticon> on freebsd-ports
mailing posted ...
for port in `pkg_info -oaq`; do
grep OPENSSL /usr/ports/$port/Makefile >/dev/null &&
echo $port;
done
... which seemed not very reliable as that would miss any port which
does not have "OPENSSL" in its Makefile. "security/nss" is such a port
used by Firefox. So, I decided to just use ldd(1) directly on
the files installed ...
# listpkg (used in filepkg): http://www103.pair.com/parv/comp/src/per
+l/listpkg-0.22
# filepkg: http://www103.pair.com/parv/comp/src/sh/filepkg
filepkg . | egrep '^/.*(bin|libexec)' \
| xargs -I % ldd % 2>/dev/null | less -p'(crypto|ssl)'
... output of which was rather tiresome to search through, and that
was enough to open up my $EDITOR & flex some perly muscle.
|
#!/usr/local/bin/perl
$VERSION = '0.01';
use warnings; use strict;
use Data::Dumper;
$Data::Dumper::Useqq = 1;
$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Terse = 0;
$Data::Dumper::Purity = $Data::Dumper::Deepcopy = 1;
$Data::Dumper::Deparse = 1;
use Getopt::Long;
my %opt =
(
'ports-data' => q{/var/db/pkg}
, 'file-list' => '+CONTENTS'
, 'ports' => []
, 'libs' => []
);
GetOptions
(
'd|dir|ports-data=s' => \$opt{'ports-data'}
, 'p|ports=s@' => $opt{'ports'}
, 'l|libs=s@' => $opt{'libs'}
)
or die;
# Search for files for ALL the installed ports.
push @{ $opt{'ports'} } , '.' unless scalar @{ $opt{'ports'} };
push @{ $opt{'libs'} } , @ARGV if scalar @ARGV;
my $possibly_linked =
get_files
(
{
'list-maker' => [ qw{ pkg_info -L } ]
, 'ports' => find_ports( $opt{'ports'} )
, 'keep' =>
qr{ (?: /(?: s?bin | libexec ) / .+ | /perl\d+/.+?[^/]+\.so )$
+ }x
}
);
my $linked =
find_libs
(
{
'libs-lister' => q{ldd}
, 'ports' => $possibly_linked
, 'keep' => ( map qr{$_}i , join '|' , @{ $opt{'libs'} } )[0]
}
);
print Dumper( $linked );
exit;
sub find_libs
{
my ( $find ) = @_;
my %linked;
my $parse = qr{^ \s* lib[-.,_a-zA-Z0-9]+ \s+ => \s+ .+ };
foreach my $port ( keys %{ $find->{'ports'} } )
{
foreach my $file ( @{ $find->{'ports'}->{ $port } } )
{
# Stringification is needed to send ldd(1) errors to /dev/null;
+ otherwise
# "2>/dev/null: No such file or directory" error message is pro
+duced by
# ldd(1).
my $cmd =
join ' ' , $find->{'libs-lister'} , $file , '2>/dev/null';
open my $ph , '-|' , $cmd or die "Cannot open pipe: $!";
my $skip = quotemeta $file;
$skip = qr{^$skip:};
while ( my $line = <$ph> )
{
next unless $line =~ m/$find->{'keep'}/;
next if $line =~ m/$skip/;
$line =~ s/^\s+//;
chomp $line;
push @{ $linked{ $port }->{ $file } } , $line
}
}
}
return { %linked };
}
sub get_files
{
my ( $find ) = @_;
my %files;
foreach my $p ( @{ $find->{'ports'} } )
{
open my $ph , '-|' , @{ $find->{'list-maker'} } , $p
or die "Cannot open pipe: $!";
while ( my $file = <$ph> )
{
next unless $file =~ m/$find->{'keep'}/ ;
chomp $file;
push @{ $files{ $p } } , $file ;
}
}
return { %files };
}
sub find_ports
{
my ( $re ) = @_;
($re) = map qr{$_}i, join '|' , @{ $re };
my ($dh , $close ) = open_dir( $opt{'ports-data'} );
my @ports;
while ( my $port = readdir $dh )
{
next unless $port =~ m/$re/;
my $path = join '/' , $opt{'ports-data'} , $port;
next
unless -d $path
&& -f join '/' , $path , $opt{'file-list'}
;
push @ports , $port;
}
$close->();
chomp @ports;
return [ sort @ports ];
}
sub open_dir
{
my ( $dir ) = @_;
opendir my $dh , $dir or die "Cannot open $dir: $!";
return ( $dh , sub { closedir $dh or die "Cannot close $dir: $!"; }
+);
}
|