From 9ffe8e1a232abda74a701f0ad48a4bb8f33abf2f Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Thu, 12 Jul 2018 11:40:04 +0900 Subject: setup_programs: prefer system versions, simplify code --- Master/tlpkg/TeXLive/TLUtils.pm | 191 +++++++++++++++++----------------------- 1 file changed, 82 insertions(+), 109 deletions(-) diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm index c4d21e26cb9..64ede174800 100644 --- a/Master/tlpkg/TeXLive/TLUtils.pm +++ b/Master/tlpkg/TeXLive/TLUtils.pm @@ -2344,16 +2344,18 @@ Return 0 if failure, nonzero if success. =cut sub setup_programs { - my ($bindir, $platform) = @_; + my ($bindir, $platform, $tlfirst) = @_; my $ok = 1; + debug("setup_programs: preferring " . ($tlfirst ? "TL" : "system") . " versions\n"); + my $isWin = ($^O =~ /^MSWin/i); if ($isWin) { - setup_windows_one('tar', "$bindir/tar.exe", "--version", 1); + setup_one("w32", 'tar', "$bindir/tar.exe", "--version", $tlfirst); $platform = "exe"; } else { - # tar needs to be provided by the system! + # tar needs to be provided by the system, we not even check! $::progs{'tar'} = "tar"; if (!defined($platform) || ($platform eq "")) { @@ -2372,14 +2374,14 @@ sub setup_programs { # do not warn on errors push @working_downloaders, $dltype if setup_one(($isWin ? "w32" : "unix"), $defprog, - "$bindir/$dltype/$defprog.$platform", "--version", 1); + "$bindir/$dltype/$defprog.$platform", "--version", $tlfirst); } $::progs{'working_downloaders'} = [ @working_downloaders ]; my @working_compressors; for my $defprog (sort {$Compressors{$a}{'priority'} <=> $Compressors{$b}{'priority'}} keys %Compressors) { # do not warn on errors if (setup_one(($isWin ? "w32" : "unix"), $defprog, - "$bindir/$defprog/$defprog.$platform", "--version", 1)) { + "$bindir/$defprog/$defprog.$platform", "--version", $tlfirst)) { push @working_compressors, $defprog; # also set up $::{'compressor'} if not already done # this selects the first one, but we might reset this depending on @@ -2422,7 +2424,7 @@ END_COMPRESSOR_BAD $::progs{'compressor'} = $ENV{'TEXLIVE_COMPRESSOR'}; } - if ($::opt_verbosity >= 2) { + if ($::opt_verbosity >= 1) { require Data::Dumper; use vars qw($Data::Dumper::Indent $Data::Dumper::Sortkeys $Data::Dumper::Purity); # -w pain @@ -2436,149 +2438,120 @@ END_COMPRESSOR_BAD } sub setup_one { - my ($what, $p, $def, $arg, $donotwarn) = @_; - if ($what eq "unix") { - return(setup_unix_one($p, $def, $arg, $donotwarn)); + my ($what, $p, $def, $arg, $tlfirst) = @_; + my $setupfunc = ($what eq "unix") ? \&setup_unix_tl_one : \&setup_windows_tl_one ; + if ($tlfirst) { + if (&$setupfunc($p, $def, $arg)) { + return(1); + } else { + return(setup_system_one($p, $arg)); + } + } else { + if (setup_system_one($p, $arg)) { + return(1); + } else { + return(&$setupfunc($p, $def, $arg)); + } + } +} + +sub setup_system_one { + my ($p, $arg) = @_; + my $nulldev = nulldev(); + my $ret = system("$p $arg >$nulldev 2>&1"); + if ($ret == 0) { + debug("program $p found in the path\n"); + $::progs{$p} = $p; + return(1); } else { - return(setup_windows_one($p, $def, $arg, $donotwarn)); + return(0); } } -sub setup_windows_one { - my ($p, $def, $arg, $donotwarn) = @_; +sub setup_windows_tl_one { + my ($p, $def, $arg) = @_; debug("(w32) trying to set up $p, default $def, arg $arg\n"); - my $ready = 0; + if (-r $def) { my $prog = conv_to_w32_path($def); my $ret = system("$prog $arg >nul 2>&1"); # on windows if ($ret == 0) { $::progs{$p} = $prog; - $ready = 1; + return(1); } else { tlwarn("Setting up $p with $def as $prog didn't work\n"); system("$prog $arg"); + return(0); } } else { debug("Default program $def not readable?\n"); + return(0); } - return($ready) if ($ready); - # still here, try plain name without any specification - debug("trying to test for plain prog name $p\n"); - $ret = system("$p $arg >nul 2>&1"); - if ($ret == 0) { - debug("program $p seems to be in the path!\n"); - $::progs{$p} = $p; - return(1); - } - return(0); } - # setup one prog on unix using the following logic: # - if the shipped one is -x and can be executed, use it # - if the shipped one is -x but cannot be executed, copy it. set -x # . if the copy is -x and executable, use it -# . if the copy is not executable, GOTO fallback # - if the shipped one is not -x, copy it, set -x # . if the copy is -x and executable, use it -# . if the copy is not executable, GOTO fallback -# - if nothing shipped, GOTO fallback -# -# fallback: -# if prog is found in PATH and can be executed, use it. -# -# Return 0 if failure, 1 if success. -# -sub setup_unix_one { - my ($p, $def, $arg, $donotwarn) = @_; +sub setup_unix_tl_one { + my ($p, $def, $arg) = @_; our $tmp; - my $test_fallback = 0; - ddebug("trying to set up $p, default $def, arg $arg\n"); + debug("(unix) trying to set up $p, default $def, arg $arg\n"); if (-r $def) { - my $ready = 0; if (-x $def) { ddebug("default $def has executable permissions\n"); # we have to check for actual "executability" since a "noexec" # mount option may interfere, which is not taken into account by -x. - $::progs{$p} = $def; - if ($arg ne "notest") { - my $ret = system("'$def' $arg >/dev/null 2>&1" ); # we are on Unix - if ($ret == 0) { - $ready = 1; - debug("Using shipped $def for $p (tested).\n"); - } else { - ddebug("Shipped $def has -x but cannot be executed, " - . "trying tmp copy.\n"); - } - } else { - # do not test, just return - $ready = 1; - debug("Using shipped $def for $p (not tested).\n"); - } - } - if (!$ready) { - # out of some reasons we couldn't execute the shipped program - # try to copy it to a temp directory and make it executable - # - # create tmp dir only when necessary - $tmp = TeXLive::TLUtils::tl_tmpdir() unless defined($tmp); - # probably we are running from uncompressed media and want to copy it to - # some temporary location - copy($def, $tmp); - my $bn = basename($def); - $::progs{$p} = "$tmp/$bn"; - chmod(0755,$::progs{$p}); - # we do not check the return value of chmod, but check whether - # the -x bit is now set, the only thing that counts - if (! -x $::progs{$p}) { - # hmm, something is going really bad, not even the copy is - # executable. Fall back to normal path element - $test_fallback = 1; - ddebug("Copied $p $::progs{$p} does not have -x bit, strange!\n"); + my $ret = system("'$def' $arg >/dev/null 2>&1" ); # we are on Unix + if ($ret == 0) { + $::progs{$p} = $def; + debug("Using shipped $def for $p (tested).\n"); + return(1); } else { - # check again for executability - if ($arg ne "notest") { - my $ret = system("$::progs{$p} $arg > /dev/null 2>&1"); - if ($ret == 0) { - # ok, the copy works - debug("Using copied $::progs{$p} for $p (tested).\n"); - } else { - # even the copied prog is not executable, strange - $test_fallback = 1; - ddebug("Copied $p $::progs{$p} has x bit but not executable?!\n"); - } - } else { - debug("Using copied $::progs{$p} for $p (not tested).\n"); - } + ddebug("Shipped $def has -x but cannot be executed, " + . "trying tmp copy.\n"); } } - } else { - # hope that we can find in the global PATH - $test_fallback = 1; - } - if ($test_fallback) { - # all our playing around and copying did not succeed, try PATH. - $::progs{$p} = $p; - if ($arg ne "notest") { - my $ret = system("$p $arg >/dev/null 2>&1"); + # we are still here + # out of some reasons we couldn't execute the shipped program + # try to copy it to a temp directory and make it executable + # + # create tmp dir only when necessary + $tmp = TeXLive::TLUtils::tl_tmpdir() unless defined($tmp); + # probably we are running from uncompressed media and want to copy it to + # some temporary location + copy($def, $tmp); + my $bn = basename($def); + my $tmpprog = "$tmp/$bn"; + chmod(0755,$tmpprog); + # we do not check the return value of chmod, but check whether + # the -x bit is now set, the only thing that counts + if (! -x $tmpprog) { + # hmm, something is going really bad, not even the copy is + # executable. Fall back to normal path element + ddebug("Copied $p $tmpprog does not have -x bit, strange!\n"); + return(0); + } else { + # check again for executability + my $ret = system("$tmpprog $arg > /dev/null 2>&1"); if ($ret == 0) { - debug("Using system $p (tested).\n"); + # ok, the copy works + debug("Using copied $tmpprog for $p (tested).\n"); + $::progs{$p} = $tmpprog; + return(1); } else { - if ($donotwarn) { - debug("$0: initialization of $p failed but ignored!\n"); - } else { - tlwarn("$0: Initialization failed (in setup_unix_one):\n"); - tlwarn("$0: could not find a usable $p.\n"); - tlwarn("$0: Please install $p and try again.\n"); - } - return 0; + # even the copied prog is not executable, strange + ddebug("Copied $p $tmpprog has x bit but not executable?!\n"); + return(0); } - } else { - debug ("Using system $p (not tested).\n"); } + } else { + # default program is not readable + return(0); } - return 1; } -- cgit v1.2.3