xref: /openbsd/usr.bin/libtool/libtool (revision 6bbcafb6)
1#!/usr/bin/perl
2# $OpenBSD: libtool,v 1.44 2019/01/03 21:50:26 jca Exp $
3
4# Copyright (c) 2007-2010 Steven Mestdagh <steven@openbsd.org>
5# Copyright (c) 2012 Marc Espie <espie@openbsd.org>
6#
7# Permission to use, copy, modify, and distribute this software for any
8# purpose with or without fee is hereby granted, provided that the above
9# copyright notice and this permission notice appear in all copies.
10#
11# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
12# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
13# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
14# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
15# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
16# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
17# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
18
19use strict;
20use warnings;
21use feature qw(say switch state);
22use Cwd qw(getcwd);
23use File::Glob ':glob';
24
25use LT::Trace;
26use LT::Exec;
27use LT::Util;
28use LT::Getopt;
29
30$SIG{__DIE__} = sub {
31	require Carp;
32
33	my $message = pop @_;
34	$message =~ s/(.*)( at .*? line .*?\n$)/$1/s;
35	push @_, $message;
36	die &Carp::longmess;
37};
38
39package LT::OSConfig;
40
41use Config;
42use LT::Util;
43
44my @picflags =qw(-fPIC -DPIC);
45
46sub new
47{
48	    my $class = shift;
49	    # XXX: incomplete
50	    my $self = bless {
51		machine_arch => $Config{ARCH},
52		ltdir => $ltdir,
53		version => $version,
54		objdir => $ltdir,
55		pic_flags => join(' ', @picflags),
56		elf => 1,
57		noshared => 0,
58	    }, $class;
59	    ($self->{gnu_arch} = $self->{machine_arch}) =~ s/amd64/x86_64/;
60
61	    return $self;
62}
63
64sub noshared
65{
66	my $self = shift;
67	return $self->{noshared};
68}
69
70sub host
71{
72	my $self = shift;
73	if (!defined $self->{osversion}) {
74		chomp($self->{osversion} = `uname -r`);
75	}
76	return "$self->{gnu_arch}-unknown-openbsd$self->{osversion}";
77}
78
79# XXX
80sub picflags
81{
82	my $self = shift;
83	return \@picflags;
84}
85
86sub sharedflag
87{
88	return '-shared';
89}
90
91sub version
92{
93	my $self = shift;
94	return $self->{version};
95}
96
97sub dump
98{
99	my $self = shift;
100	for my $key (sort keys %$self) {
101		say "$key=$self->{$key}";
102	}
103}
104
105package LT::Mode;
106use LT::Util;
107
108sub new
109{
110	my ($class, $origin) = @_;
111	bless {origin => $origin }, $class;
112}
113
114sub load_subclass
115{
116	my ($self, $class) = @_;
117	local $SIG{__DIE__} = 'DEFAULT';
118	eval "require $class;";
119	if ($@) {
120		unless ($@ =~ m/^Can't locate .* in \@INC/) {
121			say STDERR $@;
122			exit 1;
123		}
124	}
125}
126
127my $mode_maker = { compile => 'LT::Mode::Compile',
128	clean => 'LT::Mode::Clean',
129	execute => 'LT::Mode::Execute',
130	finish => 'LT::Mode::Finish',
131	install => 'LT::Mode::Install',
132	link => 'LT::Mode::Link',
133	uninstall => 'LT::Mode::Uninstall' };
134
135sub factory
136{
137	my ($class, $mode, $origin) = @_;
138	my $s = $mode_maker->{$mode};
139	if ($s) {
140		$class->load_subclass($s);
141		return $s->new($origin);
142	} else {
143		shortdie "Mode=$mode not implemented yet.\n";
144	}
145}
146
147sub help
148{
149}
150
151sub help_all
152{
153	my $class = shift;
154	for my $s (sort values %$mode_maker) {
155		$class->load_subclass($s);
156		$s->help;
157	}
158}
159
160package LT::Mode::Empty;
161our @ISA = qw(LT::Mode);
162sub run
163{
164	exit 0;
165}
166
167package LT::Mode::Clean;
168our @ISA = qw(LT::Mode::Empty);
169sub help
170{
171	print <<"EOH";
172
173Usage: $0 --mode=clean RM [RM-Option]... FILE...
174has not been implemented.
175It should remove files from the build directory.
176EOH
177}
178
179package LT::Mode::Execute;
180our @ISA = qw(LT::Mode);
181sub run
182{
183	my ($class, $ltprog, $gp, $ltconfig) = @_;
184	# XXX check whether this is right
185	LT::Exec->silent_run;
186	LT::Exec->execute(@$ltprog, @main::ARGV);
187}
188
189sub help
190{
191	print <<"EOH";
192
193Usage: $0 --mode=execute COMMAND  [ARGS...]
194Run a program after setting correct library path.
195EOH
196}
197
198
199package LT::Mode::Finish;
200our @ISA = qw(LT::Mode::Empty);
201sub help
202{
203	print <<"EOH";
204
205Usage: $0 --mode=finish [LIBDIR}...
206Complete the installation of libtool libraries.
207Not needed for our usage.
208EOH
209}
210
211package LT::Mode::Uninstall;
212our @ISA = qw(LT::Mode::Empty);
213sub help
214{
215	print <<"EOH";
216
217Usage: $0 --mode=uninstall RM [RM-OPTION]... FILE...
218has not been implemented
219It should remove libraries from an installation directory.
220EOH
221}
222
223package LT::Options;
224use LT::Util;
225our @ISA = qw(LT::Getopt);
226
227my @valid_modes = qw(compile clean execute finish install link uninstall);
228
229my @known_tags = qw(disable-shared disable-static CC CXX F77 FC GO GCJ RC);
230
231sub new
232{
233	my $class = shift;
234	my $o = bless {}, $class;
235	return $o;
236}
237
238sub add_tag
239{
240	my ($self, $value) = @_;
241	if ($value =~ m/[^\-\w,\/]/) {
242		shortdie "invalid tag name: $value";
243		exit 1;
244	}
245	if (grep {$value eq $_} @known_tags) {
246		$self->{tags}{$value} = 1;
247	} else {
248		say STDERR "ignoring unknown tag: $value";
249	}
250}
251
252sub has_tag
253{
254	my ($self, $tag) = @_;
255	return defined $self->{tags}{$tag};
256}
257
258sub is_abreviated_mode
259{
260	my ($self, $arg) = @_;
261	return undef if !$arg;
262	for my $m (@valid_modes) {
263		next if length $arg > length $m;
264		if ($arg eq substr($m, 0, length $arg)) {
265			return LT::Mode->factory($m, $arg);
266		}
267	}
268	return undef;
269}
270
271# XXX this should always fail if we are libtool2 !
272# try to guess libtool mode when it is not specified
273sub guess_implicit_mode
274{
275	my ($self, $ltprog) = @_;
276	my $m;
277	for my $a (@$ltprog) {
278	   if ($a =~ m/(install([.-](sh|check))?|cp)$/) {
279		$m = LT::Mode->factory('install', "implicit $a");
280	   } elsif ($a =~ m/cc|c\+\+/) {	# XXX improve test
281		if (grep { $_ eq '-c' } @ARGV) {
282			$m = LT::Mode->factory('compile', "implicit");
283		} else {
284			$m = LT::Mode->factory('link',  "implicit");
285		}
286	   }
287	}
288	return $m;
289}
290
291sub valid_modes
292{
293	my $self = shift;
294	return join(' ', @valid_modes);
295}
296
297package main;
298
299my $ltconfig = LT::OSConfig->new;
300my $cwd = getcwd();
301my $mode;
302my $verbose = 1;
303my $help = 0;
304
305
306# XXX compat game to satisfy both libtool 1 and libtool 2
307unless ($ARGV[0] eq 'install' && $ARGV[1] =~ m/^-[bcCdpSsBfgmo]/) {
308	if ($mode = LT::Options->is_abreviated_mode($ARGV[0])) {
309		shift @ARGV;
310	}
311}
312
313# just to be clear:
314# when building a library:
315# 	* -R libdir records libdir in dependency_libs
316# 	* -rpath is the path where the (shared) library will be installed
317# when building a program:
318# 	* both -R libdir and -rpath libdir add libdir to the run-time path
319# -Wl,-rpath,libdir will bypass libtool.
320
321my $gp = LT::Options->new;
322$gp->handle_options(
323    '-config' => \&config,
324    '-debug|x' => sub {
325		    LT::Trace->set(1);
326		    LT::Exec->verbose_run;
327		},
328    '-dry-run|-dryrun|n' => sub { LT::Exec->dry_run; },
329    '-features' => sub {
330		say "host: ", $ltconfig->host;
331		say "enable shared libraries" unless $ltconfig->noshared;
332		say "enable static libraries";
333		exit 0;
334	    },
335    '-finish' => sub { $mode = LT::Mode->factory('finish', '--finish'); },
336    '-help|?|h' => sub { $help = 1; },
337    '-help-all' => sub { basic_help(); LT::Mode->help_all; exit 0; },
338    '-mode=' => sub {
339		    $mode = LT::Mode->factory($_[2], "--mode=$_[2]");
340		},
341    '-quiet|-silent|-no-verbose' => sub { $verbose = 0; },
342    '-verbose|-no-silent|-no-quiet|v' => sub {$verbose = 1;},
343    '-tag=' => sub { $gp->add_tag($_[2]); },
344    '-version' => sub {
345		    say "libtool (not (GNU libtool)) ", $ltconfig->version;
346		    exit 0;
347		},
348    '-no-warning|-no-warn' => sub {},
349    # ignored
350    '-preserve-dup-deps',
351    '-dlopen=|dlopen=@',
352);
353
354if ($help) {
355	basic_help();
356	if ($mode) {
357		$mode->help;
358	}
359	exit 0;
360}
361if ($verbose) {
362	LT::Exec->verbose_run;
363}
364
365# what are we going to run (cc, c++, ...)
366my $ltprog = [];
367# deal with multi-arg ltprog
368tsay {"ARGV = \"@ARGV\""};
369while (@ARGV) {
370	# just read arguments until the next option...
371	if ($ARGV[0] =~ m/^\-/) { last; }
372	# XXX improve checks
373	if ($ARGV[0] =~ m/^\S+\.la/) { last; }
374	my $arg = shift @ARGV;
375	push @$ltprog, $arg;
376	tsay {"arg = \"$arg\""};
377	# if the current argument is an install program, stop immediately
378	if ($arg =~ /cp$/) { last; }
379	if ($arg =~ /install([-.](sh|check))?$/) { last; }
380}
381tsay {"ltprog = \"@$ltprog\""};
382
383# XXX compat game to satisfy both libtool 1 and libtool 2
384# let libtool install work as both libtool 1 and libtool 2
385if (@$ltprog == 0 && defined $mode && $mode->{origin} eq 'install') {
386	$ltprog = [ 'install' ];
387}
388
389if (@$ltprog == 0) { die "No libtool command given.\n" .
390			 "Use `libtool --help' for more information.\n" };
391# make ltprog a list of elements without whitespace (prevent exec errors)
392my @tmp_ltprog = @$ltprog;
393@$ltprog = ();
394for my $el (@tmp_ltprog) {
395	my @parts = split /\s+/, $el;
396	push @$ltprog, @parts;
397}
398
399if (!defined $mode) {
400	$mode = $gp->guess_implicit_mode($ltprog);
401	tsay {"implicit mode: ", $mode->{origin}} if $mode;
402}
403
404if (!defined $mode) {
405	shortdie "no explicit mode, couldn't figure out implicit mode\n";
406}
407
408if (!$mode->isa("LT::Mode::Execute")) {
409	if ($gp->dlopen)  {
410		shortdie "Error: -dlopen FILE  in generic libtool options is an error in non execute mode";
411	}
412}
413
414# from here, options may be intermixed with arguments
415
416$mode->run($ltprog, $gp, $ltconfig);
417
418if (LT::Exec->performed == 0) {
419	die "No commands to execute.\n"
420}
421
422###########################################################################
423
424sub basic_help
425{
426	print <<EOF
427Usage: $0 [options]
428--config - print configuration
429--debug - turn on debugging output
430--dry-run - don't do anything, only show what would be done
431--help - this message
432--mode=MODE - use operation mode MODE
433--quiet - do not print informational messages
434--silent - same as `--quiet'
435--tag=TAG - specify a configuration variable TAG
436--version - print version of libtool
437EOF
438;
439}
440
441sub config
442{
443	$ltconfig->dump;
444	exit 0;
445}
446
447