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