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