1# ex:ts=8 sw=4: 2# $OpenBSD: Link.pm,v 1.32 2016/08/02 16:09:55 jca Exp $ 3# 4# Copyright (c) 2007-2010 Steven Mestdagh <steven@openbsd.org> 5# Copyright (c) 2012 Marc Espie <espie@openbsd.org> 6# 7# Permission to use, copy, modify, and distribute this software for any 8# purpose with or without fee is hereby granted, provided that the above 9# copyright notice and this permission notice appear in all copies. 10# 11# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 12# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 13# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 14# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 15# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 16# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 17# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 18use strict; 19use warnings; 20use feature qw(say); 21 22# supplement OSConfig with stuff needed. 23package LT::OSConfig; 24require LT::UList; 25 26my $search_dir_list = LT::UList->new; 27my $search_dir_obj = tied(@$search_dir_list); 28 29sub fillup_search_dirs 30{ 31 return if @$search_dir_list; 32 open(my $fh, '-|', '/sbin/ldconfig -r'); 33 if (!defined $fh) { 34 die "Can't run ldconfig\n"; 35 } 36 while (<$fh>) { 37 if (m/^\s*search directories:\s*(.*?)\s*$/o) { 38 push @$search_dir_list, split(/\:/o, $1); 39 last; 40 } 41 } 42 close($fh); 43} 44 45sub search_dirs 46{ 47 my $self = shift; 48 $self->fillup_search_dirs; 49 return @$search_dir_list; 50} 51 52sub is_search_dir 53{ 54 my ($self, $dir) = @_; 55 $self->fillup_search_dirs; 56 return $search_dir_obj->exists($dir); 57} 58 59 60# let's add the libsearchdirs and -R options there 61package LT::Options; 62 63sub add_libsearchdir 64{ 65 my $self = shift; 66 push(@{$self->{libsearchdir}}, @_); 67} 68 69sub libsearchdirs 70{ 71 my $self = shift; 72 return @{$self->{libsearchdir}}; 73} 74 75# -R options originating from .la resolution 76sub add_R 77{ 78 my $self = shift; 79 push(@{$self->{Rresolved}}, @_); 80} 81 82sub Rresolved 83{ 84 my $self = shift; 85 $self->{Rresolved} //= []; 86 return @{$self->{Rresolved}}; 87} 88 89package LT::Mode::Link; 90our @ISA = qw(LT::Mode); 91 92use LT::Util; 93use LT::Trace; 94use LT::Library; 95use File::Basename; 96 97use constant { 98 OBJECT => 0, # unused ? 99 LIBRARY => 1, 100 PROGRAM => 2, 101}; 102 103sub help 104{ 105 print <<"EOH"; 106 107Usage: $0 --mode=link LINK-COMMAND ... 108Link object files and libraries into a library or a program 109EOH 110} 111 112my $shared = 0; 113my $static = 1; 114 115sub run 116{ 117 my ($class, $ltprog, $gp, $ltconfig) = @_; 118 119 my $noshared = $ltconfig->noshared; 120 my $cmd; 121 my $libdirs = LT::UList->new; # list of libdirs 122 my $libs = LT::Library::Stash->new; # libraries 123 my $dirs = LT::UList->new('/usr/lib'); # paths to search for libraries, 124 # /usr/lib is always there 125 126 $gp->handle_permuted_options( 127 'all-static', 128 'allow-undefined', # we don't care about THAT one 129 'avoid-version', 130 'bindir:', 131 'dlopen:', 132 'dlpreopen:', 133 'export-dynamic', 134 'export-symbols:', 135 '-export-symbols:', sub { shortdie "the option is -export-symbols.\n--export-symbols will be ignored by gnu libtool"; }, 136 'export-symbols-regex:', 137 'module', 138 'no-fast-install', 139 'no-install', 140 'no-undefined', 141 'o:!@', 142 'objectlist:', 143 'precious-files-regex:', 144 'prefer-pic', 145 'prefer-non-pic', 146 'release:', 147 'rpath:@', 148 'L:!', sub { shortdie "libtool does not allow spaces in -L dir\n"}, 149 'R:@', 150 'shrext:', 151 'static', 152 'thread-safe', # XXX and --thread-safe ? 153 'version-info:', 154 'version-number:'); 155 156 # XXX options ignored: bindir, dlopen, dlpreopen, no-fast-install, 157 # no-install, no-undefined, precious-files-regex, 158 # shrext, thread-safe, prefer-pic, prefer-non-pic 159 160 my @RPopts = $gp->rpath; # -rpath options 161 my @Ropts = $gp->R; # -R options on the command line 162 163 # add the .libs dir as well in case people try to link directly 164 # with the real library instead of the .la library 165 $gp->add_libsearchdir(LT::OSConfig->search_dirs, './.libs'); 166 167 if (!$gp->o) { 168 shortdie "No output file given.\n"; 169 } 170 if ($gp->o > 1) { 171 shortdie "Multiple output files given.\n"; 172 } 173 174 my $outfile = ($gp->o)[0]; 175 tsay {"outfile = $outfile"}; 176 my $odir = dirname($outfile); 177 my $ofile = basename($outfile); 178 179 # what are we linking? 180 my $linkmode = PROGRAM; 181 if ($ofile =~ m/\.l?a$/) { 182 $linkmode = LIBRARY; 183 $gp->handle_permuted_options('x:!'); 184 } 185 tsay {"linkmode: $linkmode"}; 186 187 my @objs; 188 my @sobjs; 189 if ($gp->objectlist) { 190 my $objectlist = $gp->objectlist; 191 open(my $ol, '<', $objectlist) or die "Cannot open $objectlist: $!\n"; 192 my @objlist = <$ol>; 193 for (@objlist) { chomp; } 194 generate_objlist(\@objs, \@sobjs, \@objlist); 195 } else { 196 generate_objlist(\@objs, \@sobjs, \@ARGV); 197 } 198 tsay {"objs = @objs"}; 199 tsay {"sobjs = @sobjs"}; 200 201 my $deplibs = LT::UList->new; # list of dependent libraries (both -L and -l flags) 202 my $parser = LT::Parser->new(\@ARGV); 203 204 if ($linkmode == PROGRAM) { 205 require LT::Mode::Link::Program; 206 my $program = LT::Program->new; 207 $program->{outfilepath} = $outfile; 208 # XXX give higher priority to dirs of not installed libs 209 if ($gp->export_dynamic) { 210 push(@{$parser->{args}}, "-Wl,-E"); 211 } 212 213 $parser->parse_linkargs1($deplibs, $gp, $dirs, $libs); 214 tsay {"end parse_linkargs1"}; 215 tsay {"deplibs = @$deplibs"}; 216 217 $program->{objlist} = \@objs; 218 if (@objs == 0) { 219 if (@sobjs > 0) { 220 tsay {"no non-pic libtool objects found, trying pic objects..."}; 221 $program->{objlist} = \@sobjs; 222 } elsif (@sobjs == 0) { 223 tsay {"no libtool objects of any kind found"}; 224 tsay {"hoping for real objects in ARGV..."}; 225 } 226 } 227 my $RPdirs = LT::UList->new(@Ropts, @RPopts, $gp->Rresolved); 228 $program->{RPdirs} = $RPdirs; 229 230 $program->link($ltprog, $ltconfig, $dirs, $libs, $deplibs, $libdirs, $parser, $gp); 231 } elsif ($linkmode == LIBRARY) { 232 my $convenience = 0; 233 require LT::Mode::Link::Library; 234 my $lainfo = LT::LaFile->new; 235 236 $shared = 1 if ($gp->version_info || 237 $gp->avoid_version || 238 $gp->module); 239 if (!@RPopts) { 240 $convenience = 1; 241 $noshared = 1; 242 $static = 1; 243 $shared = 0; 244 } else { 245 $shared = 1; 246 } 247 if ($ofile =~ m/\.a$/ && !$convenience) { 248 $ofile =~ s/\.a$/.la/; 249 $outfile =~ s/\.a$/.la/; 250 } 251 (my $libname = $ofile) =~ s/\.l?a$//; # remove extension 252 my $staticlib = $libname.'.a'; 253 my $sharedlib = $libname.'.so'; 254 my $sharedlib_symlink; 255 256 if ($gp->static || $gp->all_static) { 257 $shared = 0; 258 $static = 1; 259 } 260 $shared = 0 if $noshared; 261 262 $parser->parse_linkargs1($deplibs, $gp, $dirs, $libs); 263 tsay {"end parse_linkargs1"}; 264 tsay {"deplibs = @$deplibs"}; 265 266 my $sover = '0.0'; 267 my $origver = 'unknown'; 268 # environment overrides -version-info 269 (my $envlibname = $libname) =~ s/[.+-]/_/g; 270 my ($current, $revision, $age) = (0, 0, 0); 271 if ($gp->version_info) { 272 ($current, $revision, $age) = parse_version_info($gp->version_info); 273 $origver = "$current.$revision"; 274 $sover = $origver; 275 } 276 if ($ENV{"${envlibname}_ltversion"}) { 277 # this takes priority over the previous 278 $sover = $ENV{"${envlibname}_ltversion"}; 279 ($current, $revision) = split /\./, $sover; 280 $age = 0; 281 } 282 if (defined $gp->release) { 283 $sharedlib_symlink = $sharedlib; 284 $sharedlib = $libname.'-'.$gp->release.'.so'; 285 } 286 if ($gp->avoid_version || 287 (defined $gp->release && !$gp->version_info)) { 288 # don't add a version in these cases 289 } else { 290 $sharedlib .= ".$sover"; 291 if (defined $gp->release) { 292 $sharedlib_symlink .= ".$sover"; 293 } 294 } 295 296 # XXX add error condition somewhere... 297 $static = 0 if $shared && $gp->has_tag('disable-static'); 298 $shared = 0 if $static && $gp->has_tag('disable-shared'); 299 300 tsay {"SHARED: $shared\nSTATIC: $static"}; 301 302 $lainfo->{libname} = $libname; 303 if ($shared) { 304 $lainfo->{dlname} = $sharedlib; 305 $lainfo->{library_names} = $sharedlib; 306 $lainfo->{library_names} .= " $sharedlib_symlink" 307 if defined $gp->release; 308 $lainfo->link($ltprog, $ltconfig, $ofile, $sharedlib, $odir, 1, \@sobjs, $dirs, $libs, $deplibs, $libdirs, $parser, $gp); 309 tsay {"sharedlib: $sharedlib"}; 310 $lainfo->{current} = $current; 311 $lainfo->{revision} = $revision; 312 $lainfo->{age} = $age; 313 } 314 if ($static) { 315 $lainfo->{old_library} = $staticlib; 316 $lainfo->link($ltprog, $ltconfig, $ofile, $staticlib, $odir, 0, ($convenience && @sobjs > 0) ? \@sobjs : \@objs, $dirs, $libs, $deplibs, $libdirs, $parser, $gp); 317 tsay {($convenience ? "convenience" : "static"), 318 " lib: $staticlib"}; 319 } 320 $lainfo->{installed} = 'no'; 321 $lainfo->{shouldnotlink} = $gp->module ? 'yes' : 'no'; 322 map { $_ = "-R$_" } @Ropts; 323 unshift @$deplibs, @Ropts if @Ropts; 324 tsay {"deplibs = @$deplibs"}; 325 $lainfo->set('dependency_libs', "@$deplibs"); 326 if (@RPopts) { 327 if (@RPopts > 1) { 328 tsay {"more than 1 -rpath option given, ", 329 "taking the first: ", $RPopts[0]}; 330 } 331 $lainfo->{libdir} = $RPopts[0]; 332 } 333 if (!($convenience && $ofile =~ m/\.a$/)) { 334 $lainfo->write($outfile, $ofile); 335 unlink("$odir/$ltdir/$ofile"); 336 symlink("../$ofile", "$odir/$ltdir/$ofile"); 337 } 338 my $lai = "$odir/$ltdir/$ofile".'i'; 339 if ($shared) { 340 my $pdeplibs = process_deplibs($deplibs); 341 if (defined $pdeplibs) { 342 $lainfo->set('dependency_libs', "@$pdeplibs"); 343 } 344 if (! $gp->module) { 345 $lainfo->write_shared_libs_log($origver); 346 } 347 } 348 $lainfo->{'installed'} = 'yes'; 349 # write .lai file (.la file that will be installed) 350 $lainfo->write($lai, $ofile); 351 } 352} 353 354# populate arrays of non-pic and pic objects and remove these from @ARGV 355sub generate_objlist 356{ 357 my $objs = shift; 358 my $sobjs = shift; 359 my $objsource = shift; 360 361 my $result = []; 362 foreach my $a (@$objsource) { 363 if ($a =~ m/\S+\.lo$/) { 364 require LT::LoFile; 365 my $ofile = basename($a); 366 my $odir = dirname($a); 367 my $loinfo = LT::LoFile->parse($a); 368 if ($loinfo->{'non_pic_object'}) { 369 my $o; 370 $o .= "$odir/" if ($odir ne '.'); 371 $o .= $loinfo->{'non_pic_object'}; 372 push @$objs, $o; 373 } 374 if ($loinfo->{'pic_object'}) { 375 my $o; 376 $o .= "$odir/" if ($odir ne '.'); 377 $o .= $loinfo->{'pic_object'}; 378 push @$sobjs, $o; 379 } 380 } elsif ($a =~ m/\S+\.o$/) { 381 push @$objs, $a; 382 } else { 383 push @$result, $a; 384 } 385 } 386 @$objsource = @$result; 387} 388 389# convert 4:5:8 into a list of numbers 390sub parse_version_info 391{ 392 my $vinfo = shift; 393 394 if ($vinfo =~ m/^(\d+):(\d+):(\d+)$/) { 395 return ($1, $2, $3); 396 } elsif ($vinfo =~ m/^(\d+):(\d+)$/) { 397 return ($1, $2, 0); 398 } elsif ($vinfo =~ m/^(\d+)$/) { 399 return ($1, 0, 0); 400 } else { 401 die "Error parsing -version-info $vinfo\n"; 402 } 403} 404 405# prepare dependency_libs information for the .la file which is installed 406# i.e. remove any .libs directories and use the final libdir for all the 407# .la files 408sub process_deplibs 409{ 410 my $linkflags = shift; 411 412 my $result; 413 414 foreach my $lf (@$linkflags) { 415 if ($lf =~ m/-L\S+\Q$ltdir\E$/) { 416 } elsif ($lf =~ m/-L\./) { 417 } elsif ($lf =~ m/\/\S+\/(\S+\.la)/) { 418 my $lafile = $1; 419 require LT::LaFile; 420 my $libdir = LT::LaFile->parse($lf)->{'libdir'}; 421 if ($libdir eq '') { 422 # this drops libraries which will not be 423 # installed 424 # XXX improve checks when adding to deplibs 425 say "warning: $lf dropped from deplibs"; 426 } else { 427 push @$result, $libdir.'/'.$lafile; 428 } 429 } else { 430 push @$result, $lf; 431 } 432 } 433 return $result; 434} 435 436package LT::Parser; 437use File::Basename; 438use Cwd qw(abs_path); 439use LT::UList; 440use LT::Util; 441use LT::Trace; 442 443my $calls = 0; 444 445sub build_cache 446{ 447 my ($self, $lainfo, $level) = @_; 448 my $o = $lainfo->{cached} = { 449 deplibs => LT::UList->new, 450 libdirs => LT::UList->new, 451 result => LT::UList->new 452 }; 453 $self->internal_resolve_la($o, $lainfo->deplib_list, 454 $level+1); 455 push(@{$o->{deplibs}}, @{$lainfo->deplib_list}); 456 if ($lainfo->{libdir} ne '') { 457 push(@{$o->{libdirs}}, $lainfo->{libdir}); 458 } 459} 460 461sub internal_resolve_la 462{ 463 my ($self, $o, $args, $level) = @_; 464 $level //= 0; 465 tsay {"resolve level: $level"}; 466 $o->{pthread} = 0; 467 foreach my $arg (@$args) { 468# XXX still needed? 469 if ($arg eq '-pthread') { 470 $o->{pthread}++; 471 next; 472 } 473 push(@{$o->{result}}, $arg); 474 next unless $arg =~ m/\.la$/; 475 require LT::LaFile; 476 my $lainfo = LT::LaFile->parse($arg); 477 if (!exists $lainfo->{cached}) { 478 $self->build_cache($lainfo, $level+1); 479 } 480 $o->{pthread} += $lainfo->{cached}{pthread}; 481 for my $e (qw(deplibs libdirs result)) { 482LT::Trace::print { "Calls to resolve_la: $calls\n" } if $calls; 483 push(@{$o->{$e}}, @{$lainfo->{cached}{$e}}); 484 } 485 } 486 $calls++; 487} 488 489END 490{ 491 LT::Trace::print { "Calls to resolve_la: $calls\n" } if $calls; 492} 493 494# resolve .la files until a level with empty dependency_libs is reached. 495sub resolve_la 496{ 497 my ($self, $deplibs, $libdirs) = @_; 498 499 tsay {"argvstring (pre resolve_la): @{$self->{args}}"}; 500 my $o = { result => [], deplibs => $deplibs, libdirs => $libdirs}; 501 502 $self->internal_resolve_la($o, $self->{args}); 503 504# XXX still needed? 505 if ($o->{pthread}) { 506 unshift(@{$o->{result}}, '-pthread'); 507 unshift(@{$o->{deplibs}}, '-pthread'); 508 } 509 510 tsay {"argvstring (post resolve_la): @{$self->{args}}"}; 511 $self->{args} = $o->{result}; 512} 513 514# Find first library or .la file for given library name. 515# Returns pair of (type, file path), or empty list on error. 516sub find_first_lib 517{ 518 my ($self, $lib, $dirs, $gp) = @_; 519 520 my $name = $lib->{key}; 521 require LT::LaFile; 522 523 push(@$dirs, $gp->libsearchdirs) if $gp; 524 for my $sd(".", @$dirs) { 525 my $file = LT::LaFile->find($name, $sd); 526 tsay {" LT::LaFile->find($name, $sd) returned \"$file\""} if defined $file; 527 return ('LT::LaFile', $file) if defined $file; 528 529 $file = $lib->findbest($sd, $name); 530 if (defined $file) { 531 tsay {"found $name in $sd"}; 532 return ('LT::Library', $file); 533 } else { 534 # XXX find static library instead? 535 $file = "$sd/lib$name.a"; 536 if (-f $file) { 537 tsay {"found static $name in $sd"}; 538 return ('LT::Library', $file); 539 } 540 } 541 } 542 return (); 543} 544 545# parse link flags and arguments 546# eliminate all -L and -l flags in the argument string and add the 547# corresponding directories and library names to the dirs/libs hashes. 548# fill deplibs, to be taken up as dependencies in the resulting .la file... 549# set up a hash for library files which haven't been found yet. 550# deplibs are formed by collecting the original -L/-l flags, plus 551# any .la files passed on the command line, EXCEPT when the .la file 552# does not point to a shared library. 553# pass 1 554# -Lfoo, -lfoo, foo.a, foo.la 555# recursively find .la files corresponding to -l flags; if there is no .la 556# file, just inspect the library file itself for any dependencies. 557sub internal_parse_linkargs1 558{ 559 my ($self, $deplibs, $gp, $dirs, $libs, $args, $level) = @_; 560 561 $level //= 0; 562 tsay {"parse_linkargs1, level: $level"}; 563 tsay {" args: @$args"}; 564 my $result = $self->{result}; 565 566 # first read all directories where we can search libraries 567 foreach my $arg (@$args) { 568 if ($arg =~ m/^-L(.*)/) { 569 push(@$dirs, $1); 570 # XXX could be not adding actually, this is UList 571 tsay {" adding $_ to deplibs"} 572 if $level == 0; 573 push(@$deplibs, $arg); 574 } 575 } 576 foreach my $arg (@$args) { 577 tsay {" processing $arg"}; 578 if (!$arg || $arg eq '' || $arg =~ m/^\s+$/) { 579 # skip empty arguments 580 } elsif ($arg =~ m/^-Wc,(.*)/) { 581 push(@$result, $1); 582 } elsif ($arg eq '-Xcompiler') { 583 next; 584 } elsif ($arg eq '-pthread') { 585 $self->{pthread} = 1; 586 } elsif ($arg =~ m/^-L(.*)/) { 587 # already read earlier, do nothing 588 } elsif ($arg =~ m/^-R(.*)/) { 589 # -R options originating from .la resolution 590 # those from @ARGV are in @Ropts 591 $gp->add_R($1); 592 } elsif ($arg =~ m/^-l(\S+)/) { 593 my @largs = (); 594 my $key = $1; 595 if (!exists $libs->{$key}) { 596 $libs->create($key); 597 my ($type, $file) = $self->find_first_lib($libs->{$key}, $dirs, $gp); 598 if (!defined $type) { 599 say "warning: could not find a $key library"; 600 next; 601 } elsif ($type eq 'LT::LaFile') { 602 my $absla = abs_path($file); 603 $libs->{$key}->{lafile} = $absla; 604 tsay {" adding $absla to deplibs"} 605 if $level == 0; 606 push(@$deplibs, $absla); 607 push(@$result, $file); 608 next; 609 } elsif ($type eq 'LT::Library') { 610 $libs->{$key}->{fullpath} = $file; 611 my @deps = $libs->{$key}->inspect; 612 # add RPATH dirs to our search_dirs in case the dependent 613 # library is installed under a non-standard path 614 my @rpdirs = $libs->{$key}->findrpaths; 615 foreach my $r (@rpdirs) { 616 if (!LT::OSConfig->is_search_dir($r)) { 617 push @$dirs, $r; 618 $gp->add_R($r); 619 } 620 } 621 foreach my $d (@deps) { 622 my $k = basename($d); 623 # XXX will fail for (_pic)?\.a$ 624 $k =~ s/^(\S+)\.so.*$/$1/; 625 $k =~ s/^lib//; 626 push(@largs, "-l$k"); 627 } 628 } else { 629 die "internal error: unsupported" . 630 " library type \"$type\""; 631 } 632 } 633 tsay {" adding $arg to deplibs"} if $level == 0; 634 push(@$deplibs, $arg); 635 push(@$result, $arg); 636 my $dummy = []; # no need to add deplibs recursively 637 $self->internal_parse_linkargs1($dummy, $gp, $dirs, 638 $libs, \@largs, $level+1) if @largs; 639 } elsif ($arg =~ m/(\S+\/)*(\S+)\.a$/) { 640 (my $key = $2) =~ s/^lib//; 641 push(@$dirs, abs_dir($arg)); 642 $libs->create($key)->{fullpath} = $arg; 643 push(@$result, $arg); 644 } elsif ($arg =~ m/(\S+\/)*(\S+)\.la$/) { 645 (my $key = $2) =~ s/^lib//; 646 push(@$dirs, abs_dir($arg)); 647 my $fulla = abs_path($arg); 648 require LT::LaFile; 649 my $lainfo = LT::LaFile->parse($fulla); 650 my $dlname = $lainfo->{dlname}; 651 my $oldlib = $lainfo->{old_library}; 652 my $libdir = $lainfo->{libdir}; 653 if ($dlname ne '') { 654 if (!exists $libs->{$key}) { 655 $libs->create($key)->{lafile} = $fulla; 656 } 657 } 658 push(@$result, $arg); 659 push(@$deplibs, $fulla) if $libdir ne ''; 660 } elsif ($arg =~ m/(\S+\/)*(\S+)\.so(\.\d+){2}/) { 661 (my $key = $2) =~ s/^lib//; 662 push(@$dirs, abs_dir($arg)); 663 $libs->create($key); 664 # not really normal argument 665 # -lfoo should be used instead, so convert it 666 push(@$result, "-l$key"); 667 } else { 668 push(@$result, $arg); 669 } 670 } 671} 672 673sub parse_linkargs1 674{ 675 my ($self, $deplibs, $gp, $dirs, $libs, $args) = @_; 676 $self->{result} = []; 677 $self->internal_parse_linkargs1($deplibs, $gp, $dirs, $libs, 678 $self->{args}); 679 push(@$deplibs, '-pthread') if $self->{pthread}; 680 $self->{args} = $self->{result}; 681} 682 683# pass 2 684# -Lfoo, -lfoo, foo.a 685# no recursion in pass 2 686# fill orderedlibs array, which is the sequence of shared libraries 687# after resolving all .la 688# (this list may contain duplicates) 689# fill staticlibs array, which is the sequence of static and convenience 690# libraries 691# XXX the variable $parser->{seen_la_shared} will register whether or not 692# a .la file is found which refers to a shared library and which is not 693# yet installed 694# this is used to decide where to link executables and create wrappers 695sub parse_linkargs2 696{ 697 my ($self, $gp, $orderedlibs, $staticlibs, $dirs, $libs) = @_; 698 tsay {"parse_linkargs2"}; 699 tsay {" args: @{$self->{args}}"}; 700 my $result = []; 701 702 foreach my $arg (@{$self->{args}}) { 703 tsay {" processing $arg"}; 704 if (!$arg || $arg eq '' || $arg =~ m/^\s+$/) { 705 # skip empty arguments 706 } elsif ($arg eq '-lc') { 707 # don't link explicitly with libc (just remove -lc) 708 } elsif ($arg eq '-pthread') { 709 $self->{pthread} = 1; 710 } elsif ($arg =~ m/^-L(.*)/) { 711 push(@$dirs, $1); 712 } elsif ($arg =~ m/^-R(.*)/) { 713 # -R options originating from .la resolution 714 # those from @ARGV are in @Ropts 715 $gp->add_R($1); 716 } elsif ($arg =~ m/^-l(.*)/) { 717 my @largs = (); 718 my $key = $1; 719 $libs->create($key); 720 push(@$orderedlibs, $key); 721 } elsif ($arg =~ m/(\S+\/)*(\S+)\.a$/) { 722 (my $key = $2) =~ s/^lib//; 723 $libs->create($key)->{fullpath} = $arg; 724 push(@$staticlibs, $arg); 725 } elsif ($arg =~ m/(\S+\/)*(\S+)\.la$/) { 726 (my $key = $2) =~ s/^lib//; 727 my $d = abs_dir($arg); 728 push(@$dirs, $d); 729 my $fulla = abs_path($arg); 730 require LT::LaFile; 731 my $lainfo = LT::LaFile->parse($fulla); 732 my $dlname = $lainfo->stringize('dlname'); 733 my $oldlib = $lainfo->stringize('old_library'); 734 my $installed = $lainfo->stringize('installed'); 735 if ($dlname ne '' && $installed eq 'no') { 736 tsay {"seen uninstalled la shared in $arg"}; 737 $self->{seen_la_shared} = 1; 738 } 739 if ($dlname eq '' && -f "$d/$ltdir/$oldlib") { 740 push(@$staticlibs, "$d/$ltdir/$oldlib"); 741 } else { 742 if (!exists $libs->{$key}) { 743 $libs->create($key)->{lafile} = $fulla; 744 } 745 push(@$orderedlibs, $key); 746 } 747 } elsif ($arg =~ m/^-Wl,(\S+)$/) { 748 # libtool accepts a list of -Wl options separated 749 # by commas, and possibly with a trailing comma 750 # which is not accepted by the linker 751 my @Wlflags = split(/,/, $1); 752 foreach my $f (@Wlflags) { 753 push(@$result, "-Wl,$f"); 754 } 755 } else { 756 push(@$result, $arg); 757 } 758 } 759 tsay {"end parse_linkargs2"}; 760 return $result; 761} 762 763sub new 764{ 765 my ($class, $args) = @_; 766 bless { args => $args, pthread => 0 }, $class; 767} 768 769package LT::Linker; 770use LT::Trace; 771use LT::Util; 772use File::Basename; 773use Cwd qw(abs_path); 774 775sub new 776{ 777 my $class = shift; 778 bless {}, $class; 779} 780 781sub create_symlinks 782{ 783 my ($self, $dir, $libs) = @_; 784 if (! -d $dir) { 785 mkdir($dir) or die "Cannot mkdir($dir) : $!\n"; 786 } 787 788 foreach my $l (values %$libs) { 789 my $f = $l->{fullpath}; 790 next if !defined $f; 791 next if $f =~ m/\.a$/; 792 my $libnames = LT::UList->new; 793 if (defined $l->{lafile}) { 794 require LT::LaFile; 795 my $lainfo = LT::LaFile->parse($l->{lafile}); 796 my $librarynames = $lainfo->stringize('library_names'); 797 push @$libnames, split(/\s/, $librarynames); 798 } else { 799 push @$libnames, basename($f); 800 } 801 foreach my $libfile (@$libnames) { 802 my $link = "$dir/$libfile"; 803 tsay {"ln -s $f $link"}; 804 next if -f $link; 805 my $p = abs_path($f); 806 if (!symlink($p, $link)) { 807 die "Cannot create symlink($p, $link): $!\n" 808 unless $!{EEXIST}; 809 } 810 } 811 } 812 return $dir; 813} 814 815sub common1 816{ 817 my ($self, $parser, $gp, $deplibs, $libdirs, $dirs, $libs) = @_; 818 819 $parser->resolve_la($deplibs, $libdirs); 820 my $orderedlibs = LT::UList->new; 821 my $staticlibs = []; 822 my $args = $parser->parse_linkargs2($gp, $orderedlibs, $staticlibs, $dirs, 823 $libs); 824 tsay {"staticlibs = \n", join("\n", @$staticlibs)}; 825 tsay {"orderedlibs = @$orderedlibs"}; 826 return ($staticlibs, $orderedlibs, $args); 827} 828 829sub infer_libparameter 830{ 831 my ($self, $a, $k) = @_; 832 my $lib = basename($a); 833 if ($lib =~ m/^lib(.*)\.so(\.\d+){2}$/) { 834 $lib = $1; 835 } elsif ($lib =~ m/^lib(.*)\.so$/) { 836 say "warning: library filename $a has no version number"; 837 $lib = $1; 838 } else { 839 say "warning: cannot derive -l flag from library filename $a, assuming hash key -l$k"; 840 $lib = $k; 841 } 842 return "-l$lib"; 843} 844 845sub export_symbols 846{ 847 my ($self, $ltconfig, $base, $gp, @o) = @_; 848 my $symbolsfile; 849 my $comment; 850 if ($gp->export_symbols) { 851 $symbolsfile = $gp->export_symbols; 852 $comment = "/* version script derived from $symbolsfile */\n\n"; 853 } elsif ($gp->export_symbols_regex) { 854 ($symbolsfile = $base) =~ s/\.la$/.exp/; 855 LT::Archive->get_symbollist($symbolsfile, $gp->export_symbols_regex, \@o); 856 $comment = "/* version script generated from\n * ".join(' ', @o)."\n * using regexp ".$gp->export_symbols_regex. " */\n\n"; 857 } else { 858 return (); 859 } 860 my $scriptfile; 861 ($scriptfile = $base) =~ s/(\.la)?$/.ver/; 862 if ($ltconfig->{elf}) { 863 open my $fh, ">", $scriptfile or die; 864 open my $fh2, '<', $symbolsfile or die; 865 print $fh $comment; 866 print $fh "{\n"; 867 my $first = 1; 868 while (<$fh2>) { 869 chomp; 870 if ($first) { 871 print $fh "\tglobal:\n"; 872 $first = 0; 873 } 874 print $fh "\t\t$_;\n"; 875 } 876 print $fh "\tlocal:\n\t\t\*;\n};\n"; 877 close($fh); 878 close($fh2); 879 return ("--version-script", $scriptfile); 880 } else { 881 return ("-retain-symbols-file", $symbolsfile); 882 } 883} 884 8851; 886 887