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