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