1#!/usr/bin/env perl 2 3use Fcntl; 4use POSIX; 5use strict; 6 7# simple pkgconfig goodness 8my $destdir; 9my $recursive = 0; 10my $assembler_out = 0; 11my %pkg_configs = (); 12my @pkg_config_paths = split(/:/, $ENV{PKG_CONFIG_PATH}); 13push @pkg_config_paths, "/usr"; 14 15# Stubify a shared library ... 16sub 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 64sub 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 88sub 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 97sub 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 145sub 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 156sub 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 166sub 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 195sub 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 235my @pcnames = (); 236my @tostub; 237 238for 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 250help_exit() if (!defined $destdir); 251`mkdir -p $destdir`; 252 253for my $name (@pcnames) { 254 push @tostub, get_pc_files($name); 255} 256print "stubify: "; 257select STDERR; $| = 1; 258for my $pc (@tostub) { 259 print " " . $pc->{_Name} . "\n"; 260 copy_and_stubify ($pc); 261} 262print "\n"; 263