File: [local] / src / usr.bin / libtool / libtool (download)
Revision 1.44, Thu Jan 3 21:50:26 2019 UTC (5 years, 4 months ago) by jca
Branch: MAIN
CVS Tags: OPENBSD_7_5_BASE, OPENBSD_7_5, OPENBSD_7_4_BASE, OPENBSD_7_4, OPENBSD_7_3_BASE, OPENBSD_7_3, OPENBSD_7_2_BASE, OPENBSD_7_2, OPENBSD_7_1_BASE, OPENBSD_7_1, OPENBSD_7_0_BASE, OPENBSD_7_0, OPENBSD_6_9_BASE, OPENBSD_6_9, OPENBSD_6_8_BASE, OPENBSD_6_8, OPENBSD_6_7_BASE, OPENBSD_6_7, OPENBSD_6_6_BASE, OPENBSD_6_6, OPENBSD_6_5_BASE, OPENBSD_6_5, HEAD Changes since 1.43: +2 -4 lines
Drop two unused settings.
|
#!/usr/bin/perl
# $OpenBSD: libtool,v 1.44 2019/01/03 21:50:26 jca Exp $
# Copyright (c) 2007-2010 Steven Mestdagh <steven@openbsd.org>
# Copyright (c) 2012 Marc Espie <espie@openbsd.org>
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
use strict;
use warnings;
use feature qw(say switch state);
use Cwd qw(getcwd);
use File::Glob ':glob';
use LT::Trace;
use LT::Exec;
use LT::Util;
use LT::Getopt;
$SIG{__DIE__} = sub {
require Carp;
my $message = pop @_;
$message =~ s/(.*)( at .*? line .*?\n$)/$1/s;
push @_, $message;
die &Carp::longmess;
};
package LT::OSConfig;
use Config;
use LT::Util;
my @picflags =qw(-fPIC -DPIC);
sub new
{
my $class = shift;
# XXX: incomplete
my $self = bless {
machine_arch => $Config{ARCH},
ltdir => $ltdir,
version => $version,
objdir => $ltdir,
pic_flags => join(' ', @picflags),
elf => 1,
noshared => 0,
}, $class;
($self->{gnu_arch} = $self->{machine_arch}) =~ s/amd64/x86_64/;
return $self;
}
sub noshared
{
my $self = shift;
return $self->{noshared};
}
sub host
{
my $self = shift;
if (!defined $self->{osversion}) {
chomp($self->{osversion} = `uname -r`);
}
return "$self->{gnu_arch}-unknown-openbsd$self->{osversion}";
}
# XXX
sub picflags
{
my $self = shift;
return \@picflags;
}
sub sharedflag
{
return '-shared';
}
sub version
{
my $self = shift;
return $self->{version};
}
sub dump
{
my $self = shift;
for my $key (sort keys %$self) {
say "$key=$self->{$key}";
}
}
package LT::Mode;
use LT::Util;
sub new
{
my ($class, $origin) = @_;
bless {origin => $origin }, $class;
}
sub load_subclass
{
my ($self, $class) = @_;
local $SIG{__DIE__} = 'DEFAULT';
eval "require $class;";
if ($@) {
unless ($@ =~ m/^Can't locate .* in \@INC/) {
say STDERR $@;
exit 1;
}
}
}
my $mode_maker = { compile => 'LT::Mode::Compile',
clean => 'LT::Mode::Clean',
execute => 'LT::Mode::Execute',
finish => 'LT::Mode::Finish',
install => 'LT::Mode::Install',
link => 'LT::Mode::Link',
uninstall => 'LT::Mode::Uninstall' };
sub factory
{
my ($class, $mode, $origin) = @_;
my $s = $mode_maker->{$mode};
if ($s) {
$class->load_subclass($s);
return $s->new($origin);
} else {
shortdie "Mode=$mode not implemented yet.\n";
}
}
sub help
{
}
sub help_all
{
my $class = shift;
for my $s (sort values %$mode_maker) {
$class->load_subclass($s);
$s->help;
}
}
package LT::Mode::Empty;
our @ISA = qw(LT::Mode);
sub run
{
exit 0;
}
package LT::Mode::Clean;
our @ISA = qw(LT::Mode::Empty);
sub help
{
print <<"EOH";
Usage: $0 --mode=clean RM [RM-Option]... FILE...
has not been implemented.
It should remove files from the build directory.
EOH
}
package LT::Mode::Execute;
our @ISA = qw(LT::Mode);
sub run
{
my ($class, $ltprog, $gp, $ltconfig) = @_;
# XXX check whether this is right
LT::Exec->silent_run;
LT::Exec->execute(@$ltprog, @main::ARGV);
}
sub help
{
print <<"EOH";
Usage: $0 --mode=execute COMMAND [ARGS...]
Run a program after setting correct library path.
EOH
}
package LT::Mode::Finish;
our @ISA = qw(LT::Mode::Empty);
sub help
{
print <<"EOH";
Usage: $0 --mode=finish [LIBDIR}...
Complete the installation of libtool libraries.
Not needed for our usage.
EOH
}
package LT::Mode::Uninstall;
our @ISA = qw(LT::Mode::Empty);
sub help
{
print <<"EOH";
Usage: $0 --mode=uninstall RM [RM-OPTION]... FILE...
has not been implemented
It should remove libraries from an installation directory.
EOH
}
package LT::Options;
use LT::Util;
our @ISA = qw(LT::Getopt);
my @valid_modes = qw(compile clean execute finish install link uninstall);
my @known_tags = qw(disable-shared disable-static CC CXX F77 FC GO GCJ RC);
sub new
{
my $class = shift;
my $o = bless {}, $class;
return $o;
}
sub add_tag
{
my ($self, $value) = @_;
if ($value =~ m/[^\-\w,\/]/) {
shortdie "invalid tag name: $value";
exit 1;
}
if (grep {$value eq $_} @known_tags) {
$self->{tags}{$value} = 1;
} else {
say STDERR "ignoring unknown tag: $value";
}
}
sub has_tag
{
my ($self, $tag) = @_;
return defined $self->{tags}{$tag};
}
sub is_abreviated_mode
{
my ($self, $arg) = @_;
return undef if !$arg;
for my $m (@valid_modes) {
next if length $arg > length $m;
if ($arg eq substr($m, 0, length $arg)) {
return LT::Mode->factory($m, $arg);
}
}
return undef;
}
# XXX this should always fail if we are libtool2 !
# try to guess libtool mode when it is not specified
sub guess_implicit_mode
{
my ($self, $ltprog) = @_;
my $m;
for my $a (@$ltprog) {
if ($a =~ m/(install([.-](sh|check))?|cp)$/) {
$m = LT::Mode->factory('install', "implicit $a");
} elsif ($a =~ m/cc|c\+\+/) { # XXX improve test
if (grep { $_ eq '-c' } @ARGV) {
$m = LT::Mode->factory('compile', "implicit");
} else {
$m = LT::Mode->factory('link', "implicit");
}
}
}
return $m;
}
sub valid_modes
{
my $self = shift;
return join(' ', @valid_modes);
}
package main;
my $ltconfig = LT::OSConfig->new;
my $cwd = getcwd();
my $mode;
my $verbose = 1;
my $help = 0;
# XXX compat game to satisfy both libtool 1 and libtool 2
unless ($ARGV[0] eq 'install' && $ARGV[1] =~ m/^-[bcCdpSsBfgmo]/) {
if ($mode = LT::Options->is_abreviated_mode($ARGV[0])) {
shift @ARGV;
}
}
# just to be clear:
# when building a library:
# * -R libdir records libdir in dependency_libs
# * -rpath is the path where the (shared) library will be installed
# when building a program:
# * both -R libdir and -rpath libdir add libdir to the run-time path
# -Wl,-rpath,libdir will bypass libtool.
my $gp = LT::Options->new;
$gp->handle_options(
'-config' => \&config,
'-debug|x' => sub {
LT::Trace->set(1);
LT::Exec->verbose_run;
},
'-dry-run|-dryrun|n' => sub { LT::Exec->dry_run; },
'-features' => sub {
say "host: ", $ltconfig->host;
say "enable shared libraries" unless $ltconfig->noshared;
say "enable static libraries";
exit 0;
},
'-finish' => sub { $mode = LT::Mode->factory('finish', '--finish'); },
'-help|?|h' => sub { $help = 1; },
'-help-all' => sub { basic_help(); LT::Mode->help_all; exit 0; },
'-mode=' => sub {
$mode = LT::Mode->factory($_[2], "--mode=$_[2]");
},
'-quiet|-silent|-no-verbose' => sub { $verbose = 0; },
'-verbose|-no-silent|-no-quiet|v' => sub {$verbose = 1;},
'-tag=' => sub { $gp->add_tag($_[2]); },
'-version' => sub {
say "libtool (not (GNU libtool)) ", $ltconfig->version;
exit 0;
},
'-no-warning|-no-warn' => sub {},
# ignored
'-preserve-dup-deps',
'-dlopen=|dlopen=@',
);
if ($help) {
basic_help();
if ($mode) {
$mode->help;
}
exit 0;
}
if ($verbose) {
LT::Exec->verbose_run;
}
# what are we going to run (cc, c++, ...)
my $ltprog = [];
# deal with multi-arg ltprog
tsay {"ARGV = \"@ARGV\""};
while (@ARGV) {
# just read arguments until the next option...
if ($ARGV[0] =~ m/^\-/) { last; }
# XXX improve checks
if ($ARGV[0] =~ m/^\S+\.la/) { last; }
my $arg = shift @ARGV;
push @$ltprog, $arg;
tsay {"arg = \"$arg\""};
# if the current argument is an install program, stop immediately
if ($arg =~ /cp$/) { last; }
if ($arg =~ /install([-.](sh|check))?$/) { last; }
}
tsay {"ltprog = \"@$ltprog\""};
# XXX compat game to satisfy both libtool 1 and libtool 2
# let libtool install work as both libtool 1 and libtool 2
if (@$ltprog == 0 && defined $mode && $mode->{origin} eq 'install') {
$ltprog = [ 'install' ];
}
if (@$ltprog == 0) { die "No libtool command given.\n" .
"Use `libtool --help' for more information.\n" };
# make ltprog a list of elements without whitespace (prevent exec errors)
my @tmp_ltprog = @$ltprog;
@$ltprog = ();
for my $el (@tmp_ltprog) {
my @parts = split /\s+/, $el;
push @$ltprog, @parts;
}
if (!defined $mode) {
$mode = $gp->guess_implicit_mode($ltprog);
tsay {"implicit mode: ", $mode->{origin}} if $mode;
}
if (!defined $mode) {
shortdie "no explicit mode, couldn't figure out implicit mode\n";
}
if (!$mode->isa("LT::Mode::Execute")) {
if ($gp->dlopen) {
shortdie "Error: -dlopen FILE in generic libtool options is an error in non execute mode";
}
}
# from here, options may be intermixed with arguments
$mode->run($ltprog, $gp, $ltconfig);
if (LT::Exec->performed == 0) {
die "No commands to execute.\n"
}
###########################################################################
sub basic_help
{
print <<EOF
Usage: $0 [options]
--config - print configuration
--debug - turn on debugging output
--dry-run - don't do anything, only show what would be done
--help - this message
--mode=MODE - use operation mode MODE
--quiet - do not print informational messages
--silent - same as `--quiet'
--tag=TAG - specify a configuration variable TAG
--version - print version of libtool
EOF
;
}
sub config
{
$ltconfig->dump;
exit 0;
}