horrendous hack to stubify a library
We dump the library's symbols we're trying to stubify, and then assemble another library that looks just like it, except with all of it's innards sucked out. We also use pkgconfig to find all the relevant dependencies and to build an entire library tree.
This commit is contained in:
Michael Meeks
parent
8c736b8543
commit
eeffb8abdc
1 changed files with 262 additions and 0 deletions
262
bin/stubify.pl
Executable file
262
bin/stubify.pl
Executable file
|
|
@ -0,0 +1,262 @@
|
|||
#!/usr/bin/env perl
|
||||
|
||||
use Fcntl;
|
||||
use POSIX;
|
||||
use strict;
|
||||
|
||||
# simple pkgconfig goodness
|
||||
my $destdir;
|
||||
my $recursive = 0;
|
||||
my $assembler_out = 0;
|
||||
my %pkg_configs = ();
|
||||
my @pkg_config_paths = split(/:/, $ENV{PKG_CONFIG_PATH});
|
||||
push @pkg_config_paths, "/usr";
|
||||
|
||||
# Stubify a shared library ...
|
||||
sub read_gen_symbols($$)
|
||||
{
|
||||
my ($shlib, $fh) = @_;
|
||||
my $obj;
|
||||
|
||||
print $fh "\t.file \"$shlib\"\n";
|
||||
open $obj, "objdump -T $shlib|" || die "Can't objdump $shlib: $!";
|
||||
|
||||
while (my $line = <$obj>) {
|
||||
$line =~ /([0-9a-f]*)\s+([gw ])\s+..\s+(\S*)\s*([0-9a-f]+)..............(.*)/ || next;
|
||||
my ($address, $linkage, $type, $size, $symbol) = ($1, $2, $3, $4, $5);
|
||||
|
||||
next if ($type eq '*UND*' || $type eq '*ABS*');
|
||||
|
||||
# print "Symbol '$symbol' type '$type' '$linkage' addr $address, size $size\n";
|
||||
|
||||
$symbol || die "no symbol for line $line";
|
||||
|
||||
next if ($symbol eq '_init' || $symbol eq '_fini');
|
||||
|
||||
$linkage =~ s/g//g;
|
||||
|
||||
my $progbits = '@progbits';
|
||||
$progbits = '@nobits' if ($type eq '.bss');
|
||||
print $fh "\t.section $type.$symbol,\"a".$linkage."G\",$progbits,$symbol,comdat\n";
|
||||
print $fh ".globl $symbol\n";
|
||||
print $fh "\t.type $symbol,";
|
||||
if ($type eq '.text') {
|
||||
print $fh "\@function\n";
|
||||
} else {
|
||||
print $fh "\@object\n";
|
||||
}
|
||||
print $fh "$symbol:\n";
|
||||
if ($type eq '.text') {
|
||||
print $fh "\tret\n";
|
||||
} else {
|
||||
my $isize = hex($size);
|
||||
print $fh "\t.size $symbol, $isize\n";
|
||||
for (my $i = 0; $i < $isize; $i++) {
|
||||
print $fh "\t.byte 0\n";
|
||||
}
|
||||
}
|
||||
print $fh "\n";
|
||||
}
|
||||
|
||||
close $obj;
|
||||
}
|
||||
|
||||
sub stubify($$)
|
||||
{
|
||||
my $shlib = shift;
|
||||
my $output = shift;
|
||||
my ($pipe, $tmpf);
|
||||
|
||||
my $tmpname;
|
||||
do {
|
||||
$tmpname = tmpnam();
|
||||
} until sysopen($tmpf, $tmpname, O_RDWR|O_CREAT|O_EXCL, 0666);
|
||||
close($tmpf);
|
||||
|
||||
if ($assembler_out) {
|
||||
open ($pipe, ">-");
|
||||
} else {
|
||||
open ($pipe, "| as -o $tmpname") || die "can't start assembler: $!";
|
||||
}
|
||||
read_gen_symbols ($shlib, $pipe);
|
||||
close ($pipe) || die "Failed to assemble to: $tmpname: $!";
|
||||
|
||||
system ("gcc -shared -o $output $tmpname") && die "failed to exec gcc: $!";
|
||||
unlink $tmpname;
|
||||
}
|
||||
|
||||
sub help_exit()
|
||||
{
|
||||
print "Usage: stubify <destdir> <pkg-config-names>\n";
|
||||
print "Converts libraries into stubs, and bundles them and their pkg-config files\n";
|
||||
print "into destdir\n";
|
||||
print " -R stubbify and include all dependent pkgconfig files\n";
|
||||
exit 1;
|
||||
}
|
||||
|
||||
sub parse_pkgconfig($$)
|
||||
{
|
||||
my $name = shift;
|
||||
my $file = shift;
|
||||
my $fh;
|
||||
my %hash;
|
||||
my @hashes;
|
||||
|
||||
print "parse $file\n";
|
||||
open ($fh, $file) || die "Can't open $file: $!";
|
||||
while (<$fh>) {
|
||||
my ($key, $value);
|
||||
if (/^\s*([^=]+)\s*=\s*([^=]+)\s*$/) {
|
||||
$key = $1; $value = $2;
|
||||
} elsif (/^\s*([^:]+)\s*:\s*([^:]+)\s*$/) {
|
||||
$key = $1; $value = $2;
|
||||
} elsif (/^\s*$/) {
|
||||
next;
|
||||
} else {
|
||||
die "invalid pkgconfig line: $_\n";
|
||||
}
|
||||
chomp ($key); chomp ($value);
|
||||
$hash{$key} = $value;
|
||||
}
|
||||
close ($fh);
|
||||
for my $key (keys (%hash)) {
|
||||
print "\t'$key'\t=\t'$hash{$key}'\n";
|
||||
}
|
||||
|
||||
$hash{_Name} = $name;
|
||||
$hash{_File} = $file;
|
||||
|
||||
push @hashes, \%hash;
|
||||
if ($recursive &&
|
||||
!defined $pkg_configs{$name} &&
|
||||
defined $hash{Requires}) {
|
||||
my @reqs = ();
|
||||
for my $req (split (/[ ,]/, $hash{Requires})) {
|
||||
print "parse $req of $name\n";
|
||||
push @reqs, get_pc_files($req);
|
||||
}
|
||||
$hash{_Requires} = \@reqs;
|
||||
push @hashes, @reqs;
|
||||
}
|
||||
$pkg_configs{$name} = \%hash;
|
||||
return @hashes;
|
||||
}
|
||||
|
||||
sub get_pc_files($)
|
||||
{
|
||||
my $name = shift;
|
||||
for my $prefix (@pkg_config_paths) {
|
||||
my $path = "$prefix/lib/pkgconfig/$name.pc";
|
||||
return parse_pkgconfig ($name,$path) if (-f $path);
|
||||
}
|
||||
die "Failed to find pkg-config file for $name";
|
||||
}
|
||||
|
||||
# primitive substitution
|
||||
sub get_var($$)
|
||||
{
|
||||
my ($pc, $var) = @_;
|
||||
my $val = $pc->{"$var"};
|
||||
while ($val =~ m/^(.*)\$\{\s*(\S+)\s*\}(.*)$/) {
|
||||
$val = $1 . get_var($pc, $2). $3;
|
||||
}
|
||||
return $val;
|
||||
}
|
||||
|
||||
sub copy_lib($@)
|
||||
{
|
||||
my $lib = shift;
|
||||
while (my $path = shift) {
|
||||
my $name = "$path/$lib";
|
||||
next if (! -f $name);
|
||||
|
||||
# need to run ldconfig post install ...
|
||||
while (-l $name) {
|
||||
my $dir = $name;
|
||||
$dir =~ s/\/[^\/]*$//;
|
||||
my $link = readlink($name);
|
||||
if ($link =~ m/^\//) {
|
||||
$name = $link;
|
||||
} else {
|
||||
$name = "$dir/$link";
|
||||
}
|
||||
}
|
||||
|
||||
# ignore /lib - they use monstrous symbol versioning
|
||||
if ($name =~ m/^\/lib/) {
|
||||
print "\tskipping system library: $lib in $name\n";
|
||||
return;
|
||||
}
|
||||
|
||||
stubify ($name, "$destdir/$name");
|
||||
}
|
||||
}
|
||||
|
||||
sub copy_and_stubify ($)
|
||||
{
|
||||
my $pc = shift;
|
||||
|
||||
`mkdir -p $destdir/lib/pkgconfig`;
|
||||
`mkdir -p $destdir/$pc->{libdir}` if (defined $pc->{libdir});
|
||||
`mkdir -p $destdir/$pc->{includedir}` if (defined $pc->{includedir});
|
||||
|
||||
# copy .pc across - FIXME, may need to re-write paths
|
||||
`cp -a $pc->{_File} $destdir/lib/pkgconfig`;
|
||||
|
||||
# copy includes across
|
||||
my @includes = split (/ /, get_var ($pc, "Cflags"));
|
||||
for my $arg (@includes) {
|
||||
if ($arg =~ m/^-I(.*)$/) {
|
||||
my $srcdir = $1;
|
||||
if (! -d $srcdir || $srcdir eq '/usr/include') {
|
||||
print "Warning: bogus include of '$srcdir' for pkg $pc->{_Name}\n";
|
||||
} else {
|
||||
`mkdir -p $destdir/$srcdir`;
|
||||
`cp -a $srcdir/* $destdir/$srcdir`;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# stubify libraries
|
||||
my @libs = split (/ /, get_var ($pc, "Libs"));
|
||||
my @libpath = ( "/lib", "/usr/lib" );
|
||||
for my $arg (@libs) {
|
||||
if ($arg =~ m/^-l(.*)$/) {
|
||||
my $lib = "lib".$1.".so";
|
||||
# print "lib $lib @libpath?\n";
|
||||
copy_lib ($lib, @libpath);
|
||||
} elsif ($arg =~ m/^-L(.*)$/) {
|
||||
my $path = $1;
|
||||
push (@libpath, $path) if (! grep ($path, @libpath));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
my @pcnames = ();
|
||||
my @tostub;
|
||||
|
||||
for my $arg (@ARGV) {
|
||||
if ($arg eq '--help' || $arg eq '-h') {
|
||||
help_exit();
|
||||
} elsif ($arg eq '-r' || $arg eq '-R') {
|
||||
$recursive = 1;
|
||||
} elsif (!defined $destdir) {
|
||||
$destdir = $arg;
|
||||
} else {
|
||||
push @pcnames, $arg;
|
||||
}
|
||||
}
|
||||
|
||||
help_exit() if (!defined $destdir);
|
||||
`mkdir -p $destdir`;
|
||||
|
||||
for my $name (@pcnames) {
|
||||
push @tostub, get_pc_files($name);
|
||||
}
|
||||
print "stubify: ";
|
||||
select STDERR; $| = 1;
|
||||
for my $pc (@tostub) {
|
||||
print " " . $pc->{_Name} . "\n";
|
||||
copy_and_stubify ($pc);
|
||||
}
|
||||
print "\n";
|
||||
Loading…
Reference in a new issue