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