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