bin/stubify.pl

   1 #!/usr/bin/env perl
   2
   3 use Fcntl;
   4 use POSIX;
   5 use strict;
   6
   7 # simple pkgconfig goodness
   8 my $destdir;
   9 my $recursive = 0;
  10 my $assembler_out = 0;
  11 my %pkg_configs = ();
  12 my @pkg_config_paths = split(/:/, $ENV{PKG_CONFIG_PATH});
  13 push @pkg_config_paths, "/usr";
  14
  15 # Stubify a shared library ...
  16 sub read_gen_symbols($$)
  17 {
  18     my ($shlib, $fh) = @_;
  19     my $obj;
  20
  21     print $fh "\t.file \"$shlib\"\n";
  22     open $obj, "objdump -T $shlib|" || die "Can't objdump $shlib: $!";
  23
  24     while (my $line = <$obj>) {
  25         $line =~ /([0-9a-f]*)\s+([gw ])\s+..\s+(\S*)\s*([0-9a-f]+)..............(.*)/ || next;
  26         my ($address, $linkage, $type, $size, $symbol) = ($1, $2, $3, $4, $5);
  27
  28         next if ($type eq '*UND*' || $type eq '*ABS*');
  29
  30 #       print "Symbol '$symbol' type '$type' '$linkage' addr $address, size $size\n";
  31
  32         $symbol || die "no symbol for line $line";
  33
  34         next if ($symbol eq '_init' || $symbol eq '_fini');
  35
  36         $linkage =~ s/g//g;
  37
  38         my $progbits = '@progbits';
  39         $progbits = '@nobits' if ($type eq '.bss');
  40         print $fh "\t.section $type.$symbol,\"a".$linkage."G\",$progbits,$symbol,comdat\n";
  41         print $fh ".globl $symbol\n";
  42         print $fh "\t.type $symbol,";
  43         if ($type eq '.text') {
  44             print $fh "\@function\n";
  45         } else {
  46             print $fh "\@object\n";
  47         }
  48         print $fh "$symbol:\n";
  49         if ($type eq '.text') {
  50             print $fh "\tret\n";
  51         } else {
  52             my $isize = hex($size);
  53             print $fh "\t.size $symbol, $isize\n";
  54             for (my $i = 0; $i < $isize; $i++) {
  55                 print $fh "\t.byte 0\n";
  56             }
  57         }
  58         print $fh "\n";
  59     }
  60
  61     close $obj;
  62 }
  63
  64 sub stubify($$)
  65 {
  66     my $shlib = shift;
  67     my $output = shift;
  68     my ($pipe, $tmpf);
  69
  70     my $tmpname;
  71     do {
  72         $tmpname = tmpnam();
  73     } until sysopen($tmpf, $tmpname, O_RDWR|O_CREAT|O_EXCL, 0666);
  74     close($tmpf);
  75
  76     if ($assembler_out) {
  77         open ($pipe, ">-");
  78     } else {
  79         open ($pipe, "| as -o $tmpname") || die "can't start assembler: $!";
  80     }
  81     read_gen_symbols ($shlib, $pipe);
  82     close ($pipe) || die "Failed to assemble to: $tmpname: $!";
  83
  84     system ("gcc -shared -o $output $tmpname") && die "failed to exec gcc: $!";
  85     unlink $tmpname;
  86 }
  87
  88 sub help_exit()
  89 {
  90     print "Usage: stubify <destdir> <pkg-config-names>\n";
  91     print "Converts libraries into stubs, and bundles them and their pkg-config files\n";
  92     print "into destdir\n";
  93     print "  -R        stubbify and include all dependent pkgconfig files\n";
  94     exit 1;
  95 }
  96
  97 sub parse_pkgconfig($$)
  98 {
  99     my $name = shift;
 100     my $file = shift;
 101     my $fh;
 102     my %hash;
 103     my @hashes;
 104
 105     print "parse $file\n";
 106     open ($fh, $file) || die "Can't open $file: $!";
 107     while (<$fh>) {
 108         my ($key, $value);
 109         if (/^\s*([^=]+)\s*=\s*([^=]+)\s*$/) {
 110             $key = $1; $value = $2;
 111         } elsif (/^\s*([^:]+)\s*:\s*([^:]+)\s*$/) {
 112             $key = $1; $value = $2;
 113         } elsif (/^\s*$/) {
 114             next;
 115         } else {
 116             die "invalid pkgconfig line: $_\n";
 117         }
 118         chomp ($key); chomp ($value);
 119         $hash{$key} = $value;
 120     }
 121     close ($fh);
 122     for my $key (keys (%hash)) {
 123         print "\t'$key'\t=\t'$hash{$key}'\n";
 124     }
 125
 126     $hash{_Name} = $name;
 127     $hash{_File} = $file;
 128
 129     push @hashes, \%hash;
 130     if ($recursive &&
 131         !defined $pkg_configs{$name} &&
 132         defined $hash{Requires}) {
 133         my @reqs = ();
 134         for my $req (split (/[ ,]/, $hash{Requires})) {
 135             print "parse $req of $name\n";
 136             push @reqs, get_pc_files($req);
 137         }
 138         $hash{_Requires} = \@reqs;
 139         push @hashes, @reqs;
 140     }
 141     $pkg_configs{$name} = \%hash;
 142     return @hashes;
 143 }
 144
 145 sub get_pc_files($)
 146 {
 147     my $name = shift;
 148     for my $prefix (@pkg_config_paths) {
 149         my $path = "$prefix/lib/pkgconfig/$name.pc";
 150         return parse_pkgconfig ($name,$path) if (-f $path);
 151     }
 152     die "Failed to find pkg-config file for $name";
 153 }
 154
 155 # primitive substitution
 156 sub get_var($$)
 157 {
 158     my ($pc, $var) = @_;
 159     my $val = $pc->{"$var"};
 160     while ($val =~ m/^(.*)\$\{\s*(\S+)\s*\}(.*)$/) {
 161         $val = $1 . get_var($pc, $2). $3;
 162     }
 163     return $val;
 164 }
 165
 166 sub copy_lib($@)
 167 {
 168     my $lib = shift;
 169     while (my $path = shift) {
 170         my $name = "$path/$lib";
 171         next if (! -f $name);
 172
 173         # need to run ldconfig post install ...
 174         while (-l $name) {
 175             my $dir = $name;
 176             $dir =~ s/\/[^\/]*$//;
 177             my $link = readlink($name);
 178             if ($link =~ m/^\//) {
 179                 $name = $link;
 180             } else {
 181                 $name = "$dir/$link";
 182             }
 183         }
 184
 185         # ignore /lib - they use monstrous symbol versioning
 186         if ($name =~ m/^\/lib/) {
 187             print "\tskipping system library: $lib in $name\n";
 188             return;
 189         }
 190
 191         stubify ($name, "$destdir/$name");
 192     }
 193 }
 194
 195 sub copy_and_stubify ($)
 196 {
 197     my $pc = shift;
 198
 199     `mkdir -p $destdir/usr/lib/pkgconfig`;
 200     `mkdir -p $destdir/$pc->{libdir}` if (defined $pc->{libdir});
 201     `mkdir -p $destdir/$pc->{includedir}` if (defined $pc->{includedir});
 202
 203     # copy .pc across - FIXME, may need to re-write paths
 204     `cp -a $pc->{_File} $destdir/usr/lib/pkgconfig`;
 205
 206     # copy includes across
 207     my @includes = split (/ /, get_var ($pc, "Cflags"));
 208     for my $arg (@includes) {
 209         if ($arg =~ m/^-I(.*)$/) {
 210             my $srcdir = $1;
 211             if (! -d $srcdir || $srcdir eq '/usr/include') {
 212                 print "Warning: bogus include of '$srcdir' for pkg $pc->{_Name}\n";
 213             } else {
 214                 `mkdir -p $destdir/$srcdir`;
 215                 `cp -a $srcdir/* $destdir/$srcdir`;
 216             }
 217         }
 218     }
 219
 220     # stubify libraries
 221     my @libs = split (/ /, get_var ($pc, "Libs"));
 222     my @libpath = ( "/lib", "/usr/lib" );
 223     for my $arg (@libs) {
 224         if ($arg =~ m/^-l(.*)$/) {
 225             my $lib = "lib".$1.".so";
 226 #           print "lib $lib @libpath?\n";
 227             copy_lib ($lib, @libpath);
 228         } elsif ($arg =~ m/^-L(.*)$/) {
 229             my $path = $1;
 230             push (@libpath, $path) if (! grep ($path, @libpath));
 231         }
 232     }
 233 }
 234
 235 my @pcnames = ();
 236 my @tostub;
 237
 238 for my $arg (@ARGV) {
 239     if ($arg eq '--help' || $arg eq '-h') {
 240         help_exit();
 241     } elsif ($arg eq '-r' || $arg eq '-R') {
 242         $recursive = 1;
 243     } elsif (!defined $destdir) {
 244         $destdir = $arg;
 245     } else {
 246         push @pcnames, $arg;
 247     }
 248 }
 249
 250 help_exit() if (!defined $destdir);
 251 `mkdir -p $destdir`;
 252
 253 for my $name (@pcnames) {
 254     push @tostub, get_pc_files($name);
 255 }
 256 print "stubify: ";
 257 select STDERR; $| = 1;
 258 for my $pc (@tostub) {
 259     print " " . $pc->{_Name} . "\n";
 260     copy_and_stubify ($pc);
 261 }
 262 print "\n";