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