#!/usr/bin/perl # $OpenBSD: libtool,v 1.63 2008/11/11 10:46:14 steven Exp $ # Copyright (c) 2007-2008 Steven Mestdagh # # Permission to use, copy, modify, and distribute this software for any # purpose with or without fee is hereby granted, provided that the above # copyright notice and this permission notice appear in all copies. # # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. use strict; use warnings; use feature qw(say switch state); use Cwd qw(getcwd abs_path); use File::Basename; use File::Glob ':glob'; use File::Path; use Getopt::Long; use Getopt::Std; package main; use subs qw( create_symlinks do_link find_la find_lib generate_objlist get_search_dirs guess_implicit_mode help is_prog_wrapper notyet parse_linkargs_list parse_version_info process_deplibs resolve_la_list reverse_zap_duplicates_ref write_prog_wrapper ); package Trace; sub print(&) { my $val = shift; if (defined $ENV{'TRACE_LIBTOOL'}) { state $trace_file; if (!defined $trace_file) { open $trace_file, '>>', $ENV{'TRACE_LIBTOOL'}; } if (defined $trace_file) { print $trace_file (&$val); } } } sub debug(&;$) { my ($args, $level) = @_; $level = 1 if !defined $level; if (defined $main::D && $main::D >= $level) { print (&$args); } } { package Exec; my $dry = 0; my $verbose = 0; my $performed = 0; sub performed { return $performed; } sub dry_run { $dry = 1; } sub verbose_run { $verbose = 1; } sub new { my $class = shift; bless {}, $class; } sub chdir { my ($self, $dir) = @_; my $class = ref($self) || $self; bless {dir => $dir}, $class; } sub command_run { my ($self, @l) = @_; if ($self->{dir}) { Trace::print {"cd $self->{dir} && "}; } Trace::print { "@l\n" }; my $pid = fork(); if ($pid == -1) { die "Couldn't fork while running @l\n"; } if ($pid == 0) { if ($self->{dir}) { CORE::chdir($self->{dir}) or die "Can't chdir to $self->{dir}\n"; } exec(@l); die "Exec failed @l\n"; } else { my $kid = waitpid($pid, 0); if ($? != 0) { die "Error while executing @l\n"; } } } sub shell { my ($self, @cmds) = @_; # create an object "on the run" if (!ref($self)) { $self = $self->new; } for my $c (@cmds) { say $c if $verbose || $dry; if (!$dry) { $self->command_run($c); } } $performed++; } sub command { my ($self, @l) = @_; # create an object "on the run" if (!ref($self)) { $self = $self->new; } say "@l" if $verbose || $dry; if (!$dry) { $self->command_run(@l); } $performed++; } } package LaLoFile; my %file_cache; # which files have been parsed my $cache_by_fullname = {}; my $cache_by_inode = {}; # allows special treatment for some keywords sub set { my ($self, $k, $v) = @_; $self->{$k} = $v; } sub stringize { my ($self, $k) = @_; return $self->{$k} || ''; } sub read { my ($class, $filename) = @_; my $info = $class->new; open(my $fh, '<', $filename) or die "cannot read $filename: $!\n"; my $_; while (<$fh>) { chomp; next if /^\#/; next if /^\s*$/; if (m/^(\S+)\=\'(.*)\'$/) { $info->set($1, $2); } elsif (m/^(\S+)\=(\S+)$/) { $info->set($1, $2); } } return $info; } sub parse { my ($class, $filename) = @_; Trace::debug {"parsing $filename"}; if (defined $cache_by_fullname->{$filename}) { Trace::debug {" (cached)\n"}; return $cache_by_fullname->{$filename}; } my $key = join("/", (stat $filename)[0,1]); if (defined $cache_by_inode->{$key}) { Trace::debug {" (cached)\n"}; return $cache_by_inode->{$key}; } Trace::debug {"\n"}; return $cache_by_inode->{$key} = $cache_by_fullname->{$filename} = $class->read($filename); } sub new { my $class = shift; bless {}, $class; } package LaFile; our @ISA=(qw(LaLoFile)); use File::Basename; # allows special treatment for some keywords sub set { my ($self, $k, $v) = @_; $self->SUPER::set($k, $v); if ($k eq 'dependency_libs') { my @l = split /\s+/, $v; $self->{deplib_list} = \@l; } } sub deplib_list { my $self = shift; return $self->{deplib_list} } # XXX not sure how much of this cruft we need sub write { my ($lainfo, $filename, $name) = @_; my $libname = $lainfo->stringize('libname'); my $sharedlibname = $lainfo->stringize('dlname'); my $staticlibname = $lainfo->stringize('old_library'); my $librarynames = $lainfo->stringize('library_names'); my $deplibs = $lainfo->stringize('dependency_libs'); my $current = $lainfo->stringize('current'); my $revision = $lainfo->stringize('revision'); my $age = $lainfo->stringize('age'); my $installed = $lainfo->stringize('installed'); my $shouldnotlink = $lainfo->stringize('shouldnotlink'); my $libdir = $lainfo->stringize('libdir'); open(my $la, '>', $filename) or die "cannot write $filename: $!\n"; say "creating $filename" if $main::verbose || $main::D; print $la <stringize('picobj'); my $nonpicobj = $self->stringize('nonpicobj'); my $name = basename $filename; open(my $lo, '>', $filename) or die "cannot write $filename: $!\n"; say "creating $filename" if $main::verbose || $main::D; print $lo <{picobj}) { my @cmd = ($compiler); push @cmd, @$args if (@$args); push @cmd, @main::picflags, '-o'; my $o = ($odir eq '.') ? '' : "$odir/"; $o .= $self->{picobj}; push @cmd, $o; Exec->command(@cmd); } if (defined $self->{nonpicobj}) { my @cmd = ($compiler); push @cmd, @$args if (@$args); push @cmd, '-o'; my $o = ($odir eq '.') ? '' : "$odir/"; $o .= $self->{nonpicobj}; push @cmd, $o; Exec->command(@cmd); } } package main; use constant { OBJECT => 0, LIBRARY => 1, PROGRAM => 2, }; my $calls = 0; our $version = '1.5.26'; # pretend to be this version of libtool my @no_shared_archs = qw(m88k vax); # XXX my $machine_arch = `machine -a`; my $machine_arch = 'amd64'; (my $gnu_arch = $machine_arch) =~ s/amd64/x86_64/; my @valid_modes = qw(clean compile execute finish install link uninstall); my @valid_src = qw(asm c cc cpp cxx f s); my $cwd = getcwd(); my $ltdir = '.libs'; our @picflags = ('-fPIC', '-DPIC'); my $sharedflag = '-shared'; my $instlibdir = '/usr/local/lib'; my @libsearchdirs; $instlibdir = $ENV{'LIBDIR'} if defined $ENV{'LIBDIR'}; my $mode; our $D = 0; # debug flag my $verbose = 1; my %opts; # options passed to libtool my @Ropts; # -R options on the command line my @Rresolved; # -R options originating from .la resolution my @RPopts; # -rpath options my @tags; # list of --tag options passed to libtool my $deplibs = []; # list of dependent libraries (both -L and -l flags) my $libs = {}; # libraries my $libstofind = {}; my $orderedlibs = []; # ordered library keys (may contain duplicates) my $dirs = {}; # paths to find libraries # just to be clear: # when building a library: # * -R libdir records libdir in dependency_libs # * -rpath is the path where the (shared) library will be installed # when building a program: # * both -R libdir and -rpath libdir add libdir to the run-time path # -Wl,-rpath,libdir will bypass libtool. # build static/shared objects? my $static = 1; my $shared = 0; my $noshared = 0; if (grep { $_ eq $machine_arch } @no_shared_archs) { $noshared = 1; } # put a priority in the dir hash # always look here $dirs->{'/usr/lib'} = 3; my $gp = new Getopt::Long::Parser; # require_order so we stop parsing at the first non-option or argument, # instead of parsing the whole ARGV. $gp->configure( 'no_ignore_case', 'pass_through', 'no_auto_abbrev', 'require_order' ); $gp->getoptions('config' => \&config, 'debug' => \$D, 'dry-run|n' => sub { Exec->dry_run }, 'features' => \¬yet, 'finish' => sub { $mode = 'finish'; }, 'help' => \&help, # does not return 'mode=s{1}' => \$mode, 'quiet' => sub { $verbose = 0; }, 'silent' => sub { $verbose = 0; }, 'tag=s{1}' => \@tags, 'version' => sub { say $version ; exit(0); }, ); if ($verbose || $D) { Exec->verbose_run; } # what are we going to run (cc, c++, ...) my $ltprog = shift @ARGV or die "no libtool command\n"; # check mode and guess it if needed if (!($mode && grep { $_ eq $mode } @valid_modes)) { $mode = guess_implicit_mode(); if ($mode) { Trace::debug {"implicit mode: $mode\n"}; } else { die "MODE must be one of:\n@valid_modes\n"; } } # from here, options may be intermixed with arguments $gp->configure('permute'); #print "\n###\n### WARNING: ", # "This version of libtool is EXPERIMENTAL. ###\n###\n\n"; if ($mode eq 'compile') { # deal with multi-arg ltprog while (@ARGV && $ltprog !~ m/(cc|c\+\+|f77|g77|asm)$/) { my $arg = shift @ARGV; $ltprog .= " $arg"; } $gp->getoptions('o=s' => \$opts{'o'}, 'prefer-pic' => \$opts{'prefer-pic'}, 'prefer-non-pic'=> \$opts{'prefer-non-pic'}, 'static' => \$opts{'static'}, ); # XXX options ignored: -prefer-pic and -prefer-non-pic my $pic = 0; my $nonpic = 1; # assume we need to build pic objects $pic = 1 if (!$noshared); $nonpic = 0 if ($pic && grep { $_ eq 'disable-static' } @tags); $pic = 0 if ($nonpic && grep { $_ eq 'disable-shared' } @tags); $nonpic = 1 if ($opts{'static'}); my ($outfile, $odir, $ofile, $srcfile, $srcext); # XXX check whether -c flag is present and if not, die? if ($opts{'o'}) { $outfile = $opts{'o'}; # fix extension if needed $outfile =~ s/\.o$/.lo/; $odir = dirname $outfile; $ofile = basename $outfile; } else { # XXX sometimes no -o flag is present and we need another way my $srcre = join '|', @valid_src; my $found = 0; foreach my $a (@ARGV) { if ($a =~ m/\.($srcre)$/i) { $srcfile = $a; $srcext = $1; $found = 1; last; } } $found or die "cannot find source file in command\n"; # the output file ends up in the current directory $odir = '.'; $ofile = basename $srcfile; $ofile =~ s/\.($srcext)$/.lo/i; $outfile = "$odir/$ofile"; } Trace::debug {"srcfile = $srcfile\n"} if $srcfile; Trace::debug {"outfile = $outfile\n"}; (my $nonpicobj = $ofile) =~ s/\.lo$/.o/; my $picobj = "$ltdir/$nonpicobj"; mkdir "$odir/$ltdir" if (! -d "$odir/$ltdir"); my $lofile = LoFile->new; $lofile->{picobj} = $picobj if $pic; $lofile->{nonpicobj} = $nonpicobj if $nonpic; $lofile->compile($ltprog, $odir, \@ARGV); $lofile->write($outfile); } elsif ($mode eq 'install') { # deal with multi-arg ltprog (e.g. /bin/sh install-sh ...) while (@ARGV && $ltprog !~ m/(install([.-]sh)?|cp)$/) { my $arg = shift @ARGV; $ltprog .= " $arg"; } # we just parse the options in order to find the actual arguments my @argvcopy = @ARGV; my %install_opts; if ($ltprog =~ m/install([.-]sh)?$/) { getopts('BbCcdf:g:m:o:pSs', \%install_opts); if (@ARGV < 2 && (!defined $install_opts{'d'} && @ARGV == 1)) { die "wrong number of arguments for install\n"; } } elsif ($ltprog =~ m/cp$/) { getopts('HLPRfipr', \%install_opts); if (@ARGV < 2) { die "wrong number of arguments for install\n"; } } else { die "unsupported install program $ltprog\n"; } my @instopts = @argvcopy[0 .. (@argvcopy - @ARGV - 1)]; my $dst = pop @ARGV; my @src = @ARGV; my $dstdir; if (-d $dst) { $dstdir = $dst; } else { # dst is not a directory, i.e. a file if (@src > 1) { # XXX not really libtool's task to check this die "multiple source files combined with file destination"; } else { $dstdir = dirname $dst; } } my %toinstall; my %tosymlink; # for libraries with a -release in their name my $addedmode = 0; foreach my $s (@src) { my $dstfile = basename $s; # resolve symbolic links, so we don't try to test later # whether the symlink is a program wrapper etc. if (-l $s) { $s = readlink($s) or die "Cannot readlink $s"; } my $srcdir = dirname $s; my $srcfile = basename $s; Trace::debug {"srcdir = $srcdir\nsrcfile = $srcfile\n"}; Trace::debug {"dstdir = $dstdir\ndstfile = $dstfile\n"}; if ($srcfile =~ m/^\S+\.la$/) { # we are installing a .la library if ($ltprog =~ m/install([.-]sh)?$/) { push @instopts, '-m', '644' unless $addedmode; $addedmode = 1; } my $lainfo = LaFile->parse($s); # replace info where needed when installing the .la file my $sharedlib = $lainfo->{'dlname'}; my $staticlib = $lainfo->{'old_library'}; my @libnames = split /\s+/, $lainfo->{'library_names'}; my $laipath = "$srcdir/$ltdir/$srcfile".'i'; $toinstall{"$srcdir/$ltdir/$staticlib"} = "$dstdir/$staticlib" if ($staticlib); $toinstall{"$srcdir/$ltdir/$sharedlib"} = "$dstdir/$sharedlib" if ($sharedlib); $toinstall{"$laipath"} = "$dstdir/$dstfile" if ($sharedlib); foreach my $n (@libnames) { $tosymlink{$n} = $sharedlib if ($n ne $sharedlib); } } elsif (-f "$srcdir/$ltdir/$srcfile" && is_prog_wrapper($s)) { $toinstall{"$srcdir/$ltdir/$srcfile"} = $dst; } else { $toinstall{$s} = $dst; } } while (my ($s, $d) = each %toinstall) { my @realinstopts = @instopts; # do not try to strip .la files if ($s =~ m/\.la$/ || $d =~ m /\.la$/) { map { $_ = '' if $_ eq '-s' } @realinstopts; } Exec->shell("$ltprog @realinstopts $s $d"); } while (my ($d, $s) = each %tosymlink) { unlink("$dstdir/$d"); symlink($s, "$dstdir/$d"); } if (defined $install_opts{'d'}) { Exec->shell("$ltprog @instopts @ARGV"); } } elsif ($mode eq 'link') { my $cmd; $gp->getoptions('all-static' => \$opts{'all-static'}, 'avoid-version' => \$opts{'avoid-version'}, 'dlopen=s{1}' => \$opts{'dlopen'}, 'dlpreopen=s{1}' => \$opts{'dlpreopen'}, 'export-dynamic' => \$opts{'export-dynamic'}, 'export-symbols=s' => \$opts{'export-symbols'}, 'export-symbols-regex=s'=> \$opts{'export-symbols-regex'}, 'module' => \$opts{'module'}, 'no-fast-install' => \$opts{'no-fast-install'}, 'no-install' => \$opts{'no-install'}, 'no-undefined' => \$opts{'no-undefined'}, 'o=s' => \$opts{'o'}, 'objectlist=s' => \$opts{'objectlist'}, 'precious-files-regex=s'=> \$opts{'precious-files-regex'}, 'prefer-pic' => \$opts{'prefer-pic'}, 'prefer-non-pic' => \$opts{'prefer-non-pic'}, 'release=s' => \$opts{'release'}, 'rpath=s' => \@RPopts, 'R=s' => \@Ropts, 'shrext=s' => \$opts{'shrext'}, 'static' => \$opts{'static'}, 'thread-safe' => \$opts{'thread-safe'}, 'version-info=s{1}' => \$opts{'version-info'}, 'version_info=s{1}' => \$opts{'version-info'}, 'version-number=s{1}' => \$opts{'version-info'}, ); # XXX options ignored: dlopen, dlpreopen, no-fast-install, # no-install, no-undefined, precious-files-regex, # shrext, thread-safe, prefer-pic, prefer-non-pic @libsearchdirs = get_search_dirs(); # add the .libs dir as well in case people try to link directly # with the real library instead of the .la library push @libsearchdirs, './.libs'; my $outfile = $opts{'o'}; if (!$outfile) { die "no output file given.\n"; } Trace::debug {"outfile = $outfile\n"}; my $odir = dirname $outfile; my $absodir = abs_path($odir); my $ofile = basename $outfile; # what are we linking? my $linkmode = PROGRAM; if ($ofile =~ m/\.la$/) { $linkmode = LIBRARY; } elsif ($ofile =~ s/\.a$/.la/) { $outfile =~ s/\.a$/.la/; $linkmode = LIBRARY; $noshared = 1; $static = 1; # XXX improve! } Trace::debug {"linkmode: $linkmode\n"}; my $args = parse_linkargs_list(\@ARGV, 1); @ARGV = @$args; Trace::debug {"deplibs = @$deplibs\n"}; # eat multiple version-info arguments, we only accept the first. map { $_ = '' if ($_ =~ m/\d+:\d+:\d+/); } @ARGV; my @objs; my @sobjs; my $allpicobj; if ($opts{'objectlist'}) { my $objectlist = $opts{'objectlist'}; open(my $ol, '<', $objectlist) or die "cannot open $objectlist: $!\n"; my @objlist = <$ol>; for (@objlist) { chomp; } $allpicobj = generate_objlist(\@objs, \@sobjs, \@objlist); } else { $allpicobj = generate_objlist(\@objs, \@sobjs, \@ARGV); } Trace::debug {"objs = @objs\n"}; Trace::debug {"sobjs = @sobjs\n"}; if ($linkmode == PROGRAM) { # XXX give higher priority to dirs of not installed libs # XXX no static linking yet here if ($opts{'export-dynamic'}) { push(@ARGV, "-Wl,-E"); } my $objlist = \@objs; if (@objs == 0) { if (@sobjs > 0) { Trace::debug {"no non-pic libtool objects found, trying pic objects...\n"}; $objlist = \@sobjs; } elsif (@sobjs == 0) { Trace::debug {"no libtool objects of any kind found\n"}; Trace::debug {"hoping for real objects in ARGV...\n"}; } } do_link($ofile, $ofile, $odir, PROGRAM, 1, $objlist); write_prog_wrapper($outfile); chmod 0755, $outfile; } elsif ($linkmode == LIBRARY) { (my $libname = $ofile) =~ s/\.la$//; # remove extension my $staticlib = $libname.'.a'; my $sharedlib = $libname.'.so'; my $sharedlib_symlink; # XXX how is the creation of a shared library switched on? # XXX to do: deal with -rpath correctly $shared = 1 if ($opts{'version-info'} || $opts{'avoid-version'} || $opts{'module'} || @RPopts); if ($opts{'static'} || !@RPopts) { $shared = 0; $static = 1; } $shared = 0 if $noshared; my $sover = '0.0'; # environment overrides -version-info (my $envlibname = $libname) =~ s/[.+-]/_/g; my ($current, $revision, $age) = (0, 0, 0); if ($ENV{"${envlibname}_ltversion"}) { $sover = $ENV{"${envlibname}_ltversion"}; ($current, $revision) = split /\./, $sover; $age = 0; } elsif ($opts{'version-info'}) { ($current, $revision, $age) = parse_version_info($opts{'version-info'}); $sover = "$current.$revision"; } if ($opts{'release'}) { $sharedlib_symlink = $sharedlib; $sharedlib = $libname.'-'.$opts{'release'}.'.so'; } if ($opts{'avoid-version'} || ($opts{'release'} && !$opts{'version-info'})) { # don't add a version in these cases } else { $sharedlib .= ".$sover"; if ($opts{'release'}) { $sharedlib_symlink .= ".$sover"; } } # XXX add error condition somewhere... $static = 0 if ($shared && grep { $_ eq 'disable-static' } @tags); $shared = 0 if ($static && grep { $_ eq 'disable-shared' } @tags); Trace::debug {"SHARED: $shared\nSTATIC: $static\n"}; my $lainfo = LaFile->new; $lainfo->{'libname'} = $libname; if ($shared) { $lainfo->{'dlname'} = $sharedlib; $lainfo->{'library_names'} = $sharedlib; $lainfo->{'library_names'} .= " $sharedlib_symlink" if ($opts{'release'}); do_link($ofile, $sharedlib, $odir, LIBRARY, 1, \@sobjs); Trace::debug {"sharedlib: $sharedlib\n"}; $lainfo->{'current'} = $current; $lainfo->{'revision'} = $revision; $lainfo->{'age'} = $age; } if ($static) { $lainfo->{'old_library'} = $staticlib; do_link($ofile, $staticlib, $odir, LIBRARY, 0, ($allpicobj) ? \@sobjs : \@objs); Trace::debug {"staticlib: $staticlib\n"}; } $lainfo->{'installed'} = 'no'; $lainfo->{'shouldnotlink'} = $opts{'module'} ? 'yes' : 'no'; map { $_ = "-R$_" } @Ropts; unshift @$deplibs, @Ropts if (@Ropts); Trace::debug {"deplibs = @$deplibs\n"}; my $finaldeplibs = reverse_zap_duplicates_ref($deplibs); Trace::debug {"finaldeplibs = @$finaldeplibs\n"}; $lainfo->set('dependency_libs', "@$finaldeplibs"); if (@RPopts) { if (@RPopts > 1) { Trace::debug {"more than 1 -rpath option given, taking the first: ", $RPopts[0], "\n"}; } $lainfo->{'libdir'} = $RPopts[0]; } $lainfo->write($outfile, $ofile); unlink("$odir/$ltdir/$ofile"); symlink("../$ofile", "$odir/$ltdir/$ofile"); if ($shared) { my $lai = "$odir/$ltdir/$ofile".'i'; my $pdeplibs = process_deplibs($finaldeplibs); if (defined $pdeplibs) { $lainfo->set('dependency_libs', "@$pdeplibs"); } $lainfo->{'installed'} = 'yes'; # write .lai file (.la file that will be installed) $lainfo->write($lai, $ofile); } } } elsif ($mode eq 'finish' || $mode eq 'clean' || $mode eq 'uninstall') { # don't do anything exit 0; } elsif ($mode eq 'execute') { # XXX check whether this is right Exec->command($ltprog, @ARGV); } else { die "MODE=$mode not implemented yet.\n"; } if (Exec->performed == 0) { die "no commands to execute.\n" } ########################################################################### sub help { print <', $program) or die "cannot write $program: $!\n"; print $pw <&2 exit 1 fi EOF ; } sub is_prog_wrapper { my $program = shift; open(my $pw, '<', $program) or die "cannot open $program: $!\n"; return eval(grep { m/wrapper\sfor/ } <$pw>); } sub internal_resolve_la { my ($level, $result, $rdeplibs, $args) = @_; Trace::debug {"resolve level: $level\n"}; my $seen_pthread = 0; foreach my $a (@$args) { if ($a eq '-pthread') { $seen_pthread++; next; } push(@$result, $a); next if $a !~ m/\.la$/; my $lainfo = LaFile->parse($a); if (!exists $lainfo->{'cached_deplibs'}) { $lainfo->{'cached_deplibs'} = []; $lainfo->{'cached_result'} = []; $lainfo->{'cached_pthread'} = internal_resolve_la($level+1, $lainfo->{'cached_result'}, $lainfo->{'cached_deplibs'}, $lainfo->deplib_list); push(@{$lainfo->{'cached_deplibs'}}, @{$lainfo->deplib_list}); if (@{$lainfo->{'cached_deplibs'}} > 50) { $lainfo->{'cached_deplibs'} = reverse_zap_duplicates_ref($lainfo->{'cached_deplibs'}); } if (@{$lainfo->{'cached_result'}} > 50) { $lainfo->{'cached_result'} = reverse_zap_duplicates_ref($lainfo->{'cached_result'}); } } $seen_pthread += $lainfo->{'cached_pthread'}; push(@$result, @{$lainfo->{'cached_result'}}); push(@$rdeplibs, @{$lainfo->{'cached_deplibs'}}); } $calls++; return $seen_pthread; } END { Trace::print { "Calls to resolve_la: $calls\n" } if $calls; } # resolve .la files until a level with empty dependency_libs is reached. sub resolve_la_list { my $args = shift; my $result = []; if (internal_resolve_la(0, $result, $deplibs, $args)) { unshift(@$result, '-pthread'); unshift(@$deplibs, '-pthread'); } return $result; } # parse link flags and arguments # eliminate all -L and -l flags in the argument string and add the # corresponding directories and library names to the dirs/libs hashes. # fill deplibs, to be taken up as dependencies in the resulting .la file... # set up a hash for library files which haven't been found yet. # deplibs are formed by collecting the original -L/-l flags, plus # any .la files passed on the command line, EXCEPT when the .la file # does not point to a shared library. # pass 1 (la == 1) # -Lfoo, -lfoo, foo.a, foo.la # recursively find .la files corresponding to -l flags; if there is no .la # file, just inspect the library file itself for any dependencies. # pass 2 (la == 0) # -Lfoo, -lfoo, foo.a # no recursion in pass 2 # fill orderedlibs array, which is the sequence after resolving all .la sub internal_parse_linkargs { state $seen_pthread = 0; my ($result, $deplibs, $Rresolved, $libsearchdirs, $orderedlibs, $dirs, $libs, $libstofind, $args, $la, $level) = @_; Trace::debug {"parse_linkargs pass: ", ($la == 1) ? 1 : 2, ", level: $level\n"}; Trace::debug {" args: @$args\n"}; foreach my $a (@$args) { Trace::debug {" processing $a\n"}; if ($a eq '' || $a =~ m/^\s+$/) { # skip empty arguments } elsif ($a eq '-lc') { # don't link explicitly with libc (just remove -lc) } elsif ($a eq '-pthread' && !$seen_pthread) { # XXX special treatment since it's not a -l flag push @$deplibs, $a; $seen_pthread = 1; push(@$result, $a); } elsif ($a && $a =~ m/^-L(.*)/) { if (!exists $dirs->{$1}) { $dirs->{$1} = 1; push @$deplibs, $a; } } elsif ($a && $a =~ m/^-R(.*)/) { # -R options originating from .la resolution # those from @ARGV are in @Ropts push @$Rresolved, $1; } elsif ($a && $a =~ m/^-l(.*)/) { my @largs = (); my $key = $1; if (!exists $libstofind->{$key}) { $libstofind->{$key} = 1; if ($la) { my $lafile = find_la($key); if ($lafile) { push @$deplibs, $lafile; push(@$result, $lafile); next; } else { my $libpath = find_lib($key, @$libsearchdirs); if (!$libpath) { die "library $key could not be found.\n"; } # avoid searching again later $libs->{$key} = $libpath; my @deps = inspect_lib($libpath); # push @$rdeplibs, @deps; foreach my $d (@deps) { my $k = basename $d; $k =~ s/^(\S+)\.so.*$/$1/; $k =~ s/^lib//; push(@largs, "-l$k"); } push @$deplibs, $a; } } } if ($la) { push(@$result, $a); internal_parse_linkargs($result, $deplibs, $Rresolved, $libsearchdirs, $orderedlibs, $dirs, $libs, $libstofind, \@largs, $la, $level+1) if @largs; } else { push @$orderedlibs, $key; } } elsif ($a && $a =~ m/(\S+\/)*(\S+)\.a$/) { my $key = $2; $key =~ s/^lib//; $libs->{$key} = $a; if ($la) { push(@$result, $a); } else { push @$orderedlibs, $key; } } elsif ($a && $a =~ m/(\S+\/)*(\S+)\.la$/) { my $key = $2; $key =~ s/^lib//; my $d = abs_path(dirname($a)); $dirs->{$d} = 1; my $fulla = abs_path($a); my $lainfo = LaFile->parse($fulla); my $dlname = $lainfo->{'dlname'}; my $oldlib = $lainfo->{'old_library'}; my $libdir = $lainfo->{'libdir'}; if ($d !~ m/\Q$ltdir\E$/ && $lainfo->{'installed'} eq 'no') { $d .= "/$ltdir"; } if ($libdir ne '' && $la) { push @$deplibs, $fulla; } # the following should happen only in pass 2 if ($la) { push(@$result, $a); next; } push @$orderedlibs, $key; # get the name we need (this may include a -release) if (!$dlname && !$oldlib) { die "neither static nor shared library found in $a\n"; } # XXX in some cases there are multiple libs with the same name # so probably need to use a different key if ($dlname eq '') { # static $libs->{$key} = "$d/$oldlib"; } else { # shared $libs->{$key} = "$d/$dlname"; } Trace::debug {"\$libs{$key} = ", $libs->{$key}, "\n"}; } else { push(@$result, $a); } } Trace::debug {"end parse_linkargs\n"}; } sub parse_linkargs_list { my ($args, $la) = @_; my $result = []; internal_parse_linkargs($result, $deplibs, \@Rresolved, \@libsearchdirs, $orderedlibs, $dirs, $libs, $libstofind, $args, $la, 0); return $result; } # find .la file associated with a -llib flag # XXX pick the right one if multiple are found! sub find_la { my $l = shift; # sort dir search order by priority # XXX not fully correct yet my @sdirs = sort { $dirs->{$b} <=> $dirs->{$a} } keys %$dirs; Trace::debug {"searching .la for $l\n"}; Trace::debug {"search path= ", join(':', @sdirs), "\n"}; foreach my $d (@sdirs) { foreach my $la_candidate ("$d/lib$l.la", "$d/$l.a") { if (-f $la_candidate) { Trace::debug {"found $la_candidate\n"}; return $la_candidate; } } } Trace::debug {".la for $l not found!\n"}; return 0; } # find actual library filename # XXX pick the right one if multiple are found! sub find_lib { my $libtofind = shift; my @ldconfigdirs = @_; # search there last my $libfile = 0; my @globbedlib; # sort dir search order by priority # XXX not fully correct yet my @sdirs = sort { $dirs->{$b} <=> $dirs->{$a} } keys %$dirs; # search in .libs when priority is high map { $_ = "$_/$ltdir" if (exists $dirs->{$_} && $dirs->{$_} > 3) } @sdirs; push @sdirs, @ldconfigdirs; Trace::debug {"searching for $libtofind\n"}; Trace::debug {"search path= ", join(':', @sdirs), "\n"}; foreach my $sd (@sdirs) { # select correct library by sorting by version number only @globbedlib = sort { my ($x,$y) = map { /\.so\.(\d+\.\d+)$/; $1 } ($a,$b); $y <=> $x } glob "$sd/lib$libtofind.so.*.*"; if ($globbedlib[0]) { Trace::debug {"found $libtofind in $sd\n"}; $libfile = $globbedlib[0]; last; } else { # XXX find static library instead? if (-f "$sd/lib$libtofind.a") { Trace::debug {"found static $libtofind in $sd\n"}; $libfile = "$sd/lib$libtofind.a"; last; } } } say "$libtofind not found!" if !$libfile; return $libfile; } # give a list of library dependencies found in the actual shared library sub inspect_lib { my $filename = shift; my @deps; Trace::debug {"inspecting $filename for library dependencies...\n"}; open(my $fh, '-|', "objdump -p $filename"); while (<$fh>) { if (m/\s+NEEDED\s+(\S+)\s*$/) { push @deps, $1; } } Trace::debug {"found ", (@deps == 0) ? 'no ' : '', "deps for $filename\n@deps\n"}; return @deps; } # prepare dependency_libs information for the .la file which is installed # i.e. remove any .libs directories and use the final libdir for all the # .la files sub process_deplibs { my $linkflags = shift; my $result; foreach my $lf (@$linkflags) { if ($lf =~ m/-L\S+\Q$ltdir\E$/) { } elsif ($lf =~ m/\/\S+\/(\S+\.la)/) { my $lafile = $1; $lf = LaFile->parse($lf)->{'libdir'}.'/'.$lafile; push @$result, $lf; } else { push @$result, $lf; } } return $result; } # perform linker commands for either libraries or programs sub do_link { my $la = shift; my $fname = shift; my $odir = shift; my $lmode = shift; # LIBRARY or PROGRAM my $shared = shift; my $objs = shift; Trace::debug {"creating link command for ", ($lmode == PROGRAM) ? "program" : "library", " (linked ", ($shared) ? "dynam" : "stat", "ically)\n"}; my @libflags; my @cmd; my $dst = ($odir eq '.') ? "$ltdir/$fname" : "$odir/$ltdir/$fname"; mkdir "$odir/$ltdir" if (! -d "$odir/$ltdir"); Trace::debug {"argvstring (pre resolve_la): @ARGV\n"}; my $argv = resolve_la_list(\@ARGV); Trace::debug {"argvstring (post resolve_la): @$argv\n"}; $orderedlibs = []; $argv = parse_linkargs_list($argv, 0); Trace::debug {"deplibs = @$deplibs\n"}; Trace::debug {"orderedlibs = @$orderedlibs\n"}; my $finalorderedlibs = reverse_zap_duplicates_ref($orderedlibs); Trace::debug {"final orderedlibs = @$finalorderedlibs\n"}; # static linking if (!$shared) { Trace::debug {"dirs:\n", join("\n", (keys %$dirs)), "\n"}; Trace::debug {"libs:\n", join("\n", (keys %$libs)), "\n"}; Trace::debug {"libfiles:\n", join("\n", (values %$libs)), "\n"}; if ($lmode == LIBRARY) { @cmd = ('ar', 'cru', $dst); push @cmd, @$objs if (@$objs); foreach my $k (@$finalorderedlibs) { unless (defined $libs->{$k}) { Trace::debug {"library $k not found in \%libs\n"}; next; } my $a = $libs->{$k}; if ($a =~ m/\.a$/ && $a !~ m/_pic\.a/) { # extract objects from archive my $libfile = basename $a; my $xdir = "$odir/$ltdir/${la}x/$libfile"; extract_archive($xdir, $a); my @kobjs = get_objlist_from_archive($a); map { $_ = "$xdir/$_"; } @kobjs; push @libflags, @kobjs; } } push @cmd, @libflags if (@libflags); Exec->command(@cmd); Exec->command('ranlib', $dst); return; } elsif ($lmode == PROGRAM) { die "static linking of programs not supported yet\n"; } } # dynamic linking my $RPdirs = []; my $symbolsfile; if ($opts{'export-symbols'}) { $symbolsfile = $opts{'export-symbols'}; } elsif ($opts{'export-symbols-regex'}) { $symbolsfile = "$odir/$ltdir/$la"; $symbolsfile =~ s/\.la$/.exp/; get_symbollist($symbolsfile, $opts{'export-symbols-regex'}, $objs); } if ($lmode == PROGRAM) { @$RPdirs = (@Ropts, @RPopts, @Rresolved); $RPdirs = reverse_zap_duplicates_ref($RPdirs); map { $_ = "-Wl,-rpath,$_" } @$RPdirs; } foreach my $l (keys %$libstofind) { my $libpath = find_lib($l); $libs->{$l} = $libpath if ($libpath); } my @libfiles = values %$libs; Trace::debug {"dirs:\n", join("\n", (keys %$dirs)), "\n"}; Trace::debug {"libs:\n", join("\n", (keys %$libs)), "\n"}; Trace::debug {"libfiles:\n", join("\n", @libfiles), "\n"}; create_symlinks($ltdir, \@libfiles); map { $_ = "$ltdir/". basename $_ } @libfiles; Trace::debug {"symlinks to libfiles used for linking:\n", join("\n", @libfiles), "\n"}; my $prev_was_archive = 0; my $libcounter = 0; foreach my $k (@$finalorderedlibs) { my $a = $libs->{$k} || die "ERROR: $k not found in \$libs"; if ($a =~ m/\.a$/) { # don't make a -lfoo out of a static library if ($lmode == LIBRARY) { if (!$prev_was_archive) { push @libflags, '-Wl,-whole-archive'; } } push @libflags, $a; if ($lmode == LIBRARY) { if ($libcounter == @$finalorderedlibs - 1) { push @libflags, '-Wl,-no-whole-archive'; } } $prev_was_archive = 1; } else { if ($lmode == LIBRARY) { if ($prev_was_archive) { push @libflags, '-Wl,-no-whole-archive'; } } $prev_was_archive = 0; my $lib = basename $a; if ($lib =~ m/^lib(.*)\.so(\.\d+){2}/) { $lib = $1; } else { say "warning: cannot derive -l flag from library filename, assuming hash key"; $lib = $k; } push @libflags, "-l$lib"; } $libcounter++; } @cmd = ($ltprog); push @cmd, $sharedflag, @picflags if ($lmode == LIBRARY); push @cmd, '-o', $dst; push @cmd, @$argv; push @cmd, @$objs if (@$objs); push @cmd, "-L$ltdir", @libflags if (@libflags); push @cmd, @$RPdirs if (@$RPdirs); push @cmd, "-Wl,-retain-symbols-file,$symbolsfile" if ($symbolsfile); Exec->command(@cmd); } # populate arrays of non-pic and pic objects and remove these from @ARGV sub generate_objlist { my $objs = shift; my $sobjs = shift; my $objsource = shift; my $allpic = 1; my $result = []; foreach my $a (@$objsource) { if ($a =~ m/\S+\.lo$/) { my $ofile = basename $a; my $odir = dirname $a; my $loinfo = LoFile->parse($a); if ($loinfo->{'non_pic_object'}) { my $o; $o .= "$odir/" if ($odir ne '.'); $o .= $loinfo->{'non_pic_object'}; push @$objs, $o; } if ($loinfo->{'pic_object'}) { my $o; $o .= "$odir/" if ($odir ne '.'); $o .= $loinfo->{'pic_object'}; push @$sobjs, $o; } else { $allpic = 0; } } else { push @$result, $a; } } @$objsource = @$result; return $allpic; } # XXX reuse code from SharedLibs.pm instead sub get_search_dirs { my @libsearchdirs; open(my $fh, '-|', 'ldconfig -r'); if (defined $fh) { while (<$fh>) { if (m/^\s*search directories:\s*(.*?)\s*$/o) { foreach my $d (split(/\:/o, $1)) { push @libsearchdirs, $d; } last; } } close($fh); } else { die "Can't find ldconfig\n"; } return @libsearchdirs; } sub extract_archive { my $dir = shift; my $archive = shift; if (! -d $dir) { Trace::debug {"mkdir -p $dir\n"}; File::Path::mkpath($dir); } Exec->chdir($dir)->command('ar', 'x', $archive); } sub get_objlist_from_archive { my $a = shift; open(my $arh, '-|', "ar t $a"); my @o = <$arh>; close $arh; map { chomp; } @o; return @o; } sub get_symbollist { my $filepath = shift; my $regex = shift; my $objlist = shift; Trace::debug {"generating symbol list in file: $filepath\n"}; my $symbols = []; open(my $sh, '-|', 'nm', @$objlist) or die "error running nm on object list\n"; my $c = 0; while (my $line = <$sh>) { chomp $line; Trace::debug {"$c: $line\n"}; if ($line =~ m/\S+\s+[BCDEGRST]\s+(.*)/) { my $s = $1; if ($s =~ m/$regex/) { push @$symbols, $s; Trace::debug {"matched\n"}; } } $c++; } $symbols = reverse_zap_duplicates_ref($symbols); @$symbols = sort @$symbols; open(my $fh, '>', $filepath) or die "cannot open $filepath\n"; print $fh join("\n", @$symbols), "\n"; } # walk a list from back to front, removing any duplicates # this should make sure a library's dependencies are behind the library itself sub reverse_zap_duplicates_ref { my $arglist = shift; my $h = {}; my $r = []; for my $el (reverse @$arglist) { next if defined $h->{$el}; unshift @$r, $el; $h->{$el} = 1; } return $r; } # try to guess libtool mode when it is not specified sub guess_implicit_mode { my $m = 0; if ($ltprog =~ m/(install([.-]sh)?|cp)$/) { $m = 'install'; } elsif ($ltprog =~ m/cc|c\+\+/) { # XXX improve test if (grep { $_ eq '-c' } @ARGV) { $m = 'compile'; } else { $m = 'link'; } } return $m; }