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