From 089bede91f69e6e87d61515b247ce58b7ad2c0ae Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Sun, 25 Jan 2009 00:31:50 +0000 Subject: implement new setup_programs, and add cleanup stuff to TLUtils, and use it in install-tl and tlmgr git-svn-id: svn://tug.org/texlive/trunk@11961 c570f23f-e606-0410-a88d-b1316a301751 --- Master/install-tl | 2 + Master/texmf/scripts/texlive/tlmgr.pl | 17 ++-- Master/tlpkg/TeXLive/TLConfig.pm | 10 +- Master/tlpkg/TeXLive/TLUtils.pm | 173 +++++++++++++++++++++++++--------- 4 files changed, 146 insertions(+), 56 deletions(-) diff --git a/Master/install-tl b/Master/install-tl index ae8e3e8606c..cf92c7677f1 100755 --- a/Master/install-tl +++ b/Master/install-tl @@ -1371,6 +1371,8 @@ sub do_cleanup } else { print "No logfile\n"; } + + &TeXLive::TLUtils::cleanup(); } diff --git a/Master/texmf/scripts/texlive/tlmgr.pl b/Master/texmf/scripts/texlive/tlmgr.pl index c0b26016eb0..f483509f8a3 100755 --- a/Master/texmf/scripts/texlive/tlmgr.pl +++ b/Master/texmf/scripts/texlive/tlmgr.pl @@ -2431,6 +2431,9 @@ sub check_collections { # # set global $location variable. # if we cannot read tlpdb, die if arg SHOULD_I_DIE is true. +# +# if an argument is given and is true init_local_db will die if +# setting up of programs failed. # sub init_local_db { my ($should_i_die) = @_; @@ -2438,17 +2441,8 @@ sub init_local_db { die("cannot find tlpdb in $Master") unless (defined($localtlpdb)); # setup the programs, for w32 we need the shipped wget/lzma etc, so we # pass the location of these files to setup_programs. - my $ret = setup_programs("$Master/tlpkg/installer", - $localtlpdb->option_platform); - if ($ret == -1) { - tlwarn("no binary of lzmadec for $::_platform_ detected.\n"); - if (defined($should_i_die) && $should_i_die) { - exit 1; - } else { - tlwarn("Continuing anyway ...\n"); - } - } - if (!$ret) { + if (!setup_programs("$Master/tlpkg/installer", + $localtlpdb->option_platform)) { tlwarn("Couldn't set up the necessary programs.\nInstallation of packages is not supported.\nPlease report to texlive\@tug.org.\n"); if (defined($should_i_die) && $should_i_die) { finish(1); @@ -2525,6 +2519,7 @@ sub finish { if ($::gui_mode) { return($ret); } else { + &TeXLive::TLUtils::cleanup(); exit($ret); } } diff --git a/Master/tlpkg/TeXLive/TLConfig.pm b/Master/tlpkg/TeXLive/TLConfig.pm index 1f6de4f500e..97a76759b71 100644 --- a/Master/tlpkg/TeXLive/TLConfig.pm +++ b/Master/tlpkg/TeXLive/TLConfig.pm @@ -28,6 +28,7 @@ BEGIN { $WinSpecialUpdatePackagesRegexp @CriticalPackagesList @AllowedConfigOptions + @PostMortemRemovals ); @EXPORT = @EXPORT_OK; } @@ -81,7 +82,9 @@ our @AllowedConfigOptions = qw/ backupdir autobackup /; - + +our @PostMortemRemovals = (); + 1; @@ -165,6 +168,11 @@ since they are too central, currently bin-texlive and texlive.infra. A list of a config options that can be set in 00texlive-installation.config. +=item C<@TeXLive::TLConfig::PostMortemRemovals> + +A list of files and directories we try to remove after install-tl or +tlmgr has been terminated. + =back =head1 SEE ALSO diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm index 1f051a89dbe..cf3f6b287e8 100644 --- a/Master/tlpkg/TeXLive/TLUtils.pm +++ b/Master/tlpkg/TeXLive/TLUtils.pm @@ -66,6 +66,7 @@ C -- utilities used in the TeX Live infrastructure TeXLive::TLUtils::conv_to_w32_path($path); TeXLive::TLUtils::give_ctan_mirror($path); TeXLive::TLUtils::tlmd5($path); + TeXLive::TLUtils::cleanup(); =head1 DESCRIPTION @@ -111,6 +112,7 @@ BEGIN { &welcome_paths &give_ctan_mirror &tlmd5 + &cleanup &xsystem ); @EXPORT = qw(setup_programs download_file process_logging_options @@ -1324,10 +1326,6 @@ executables. If a program is not present in the TeX Live tree, we also check along PATH (without the platform extension.) -Returns -1 if the architecture is not supported (i.e., there is no -C binary for that arch present), 0 for programs that are -present but don't work, and 1 for success. - =cut sub setup_programs { @@ -1342,7 +1340,17 @@ sub setup_programs { $::progs{'tar'} = conv_to_w32_path("$bindir/tar.exe"); $::progs{'lzmadec'} = conv_to_w32_path("$bindir/lzma/lzmadec.win32.exe"); $::progs{'lzma'} = conv_to_w32_path("$bindir/lzma/lzma.exe"); - + for my $prog ("lzmadec", "wget") { + my $opt = $prog eq "lzmadec" ? "--help" : "--version"; + my $ret = system("$::progs{$prog} $opt > nul 2>&1"); # on windows + if ($ret != 0) { + warn "TeXLive::TLUtils::setup_programs failed"; # no newline + warn "$::progs{$prog} $opt failed (status $ret): $!\n"; + warn "Output is:\n"; + system ("$::progs{$prog} $opt"); + return 0; + } + } } else { if (!defined($platform) || ($platform eq "")) { # we assume that we run from the DVD, so we can call platform() and @@ -1352,50 +1360,115 @@ sub setup_programs { $::installerdir = "$bindir/../.."; $platform = platform(); } - $::progs{'wget'} = "$bindir/wget/wget.$platform" - if -x "$bindir/wget/wget.$platform"; - $::progs{'lzmadec'} = "$bindir/lzma/lzmadec.$platform" - if -x "$bindir/lzma/lzmadec.$platform"; - $::progs{'lzma'} = "$bindir/lzma/lzma.$platform" - if -x "$bindir/lzma/lzma.$platform"; - } - - # Check for existence of lzmadec in our directory; if so, the present - # platform is supported. But if it's not there, the test below for a - # working lzmadec could still succeed if the binary is found in $PATH. - # - # Because conv_to_w32_path possibly added quotes, strip them away for - # the file test. Since all other uses of conv_to_w32_path use the - # result in shell commands, this is the most expedient thing to do. - # - (my $lzmadec = $::progs{'lzmadec'}) =~ s/^"(.*)"/$1/; - my $found_lzmadec = -x $lzmadec; - - # should we do something like this? - #if (-r $lzmadec && ! -x $lzmadec) { - # warn "$lzmadec is not executable. You might want to mount the DVD without the 'noexec' option."; - # return 0; - #} - - # check if the programs are working, but do not test tar, we rely on - # the system having a usable one. The main point is to check the - # binaries we provide. - for my $prog ("lzmadec", "wget") { - my $opt = $prog eq "lzmadec" ? "--help" : "--version"; - my $ret = system("$::progs{$prog} $opt >" - . (win32() ? "nul" : "/dev/null") . " 2>&1"); - if ($ret != 0) { - warn "TeXLive::TLUtils::setup_programs failed"; # no newline - warn "$::progs{$prog} $opt failed (status $ret): $!\n"; - warn "Output is:\n"; - system ("$::progs{$prog} $opt"); - return $found_lzmadec ? 0 : -1; - } + our $tmp; + setup_unix_one('wget', "$bindir/wget/wget.$platform", "--version"); + setup_unix_one('lzmadec', "$bindir/lzma/lzmadec.$platform", "--help"); + setup_unix_one('lzma', "$bindir/lzma/lzma.$platform", "notest"); + push @TeXLive::TLConfig::PostMortemRemovals, $tmp; } return 1; # success } +# +# 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 itself is found and can be executed, use it, otherwise return 0 +# +sub setup_unix_one { + my ($p, $def, $arg) = @_; + our $tmp; + my $test_fallback = 0; + if (-r $def) { + my $ready = 0; + if (-x $def) { + # checking only for the executable bit is not enough, we have + # to check for actualy "executability" since a "noexec" mount + # option may interfere, which is not taken into account by + # perl's -x test. + $::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.\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 + chomp ($tmp = `mktemp -d`) unless defined($tmp); + # probably we are running from DVD and want to copy it to + # some temporary location + copy($def, $tmp); + my $bn = basename($def); + $::progs{$p} = "$tmp/$bn"; + push @TeXLive::TLConfig::PostMortemRemovals, $::progs{$p}; + 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"); + } 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, strange!\n"); + } + } else { + debug("Using copied $::progs{$p} for $p (not tested).\n"); + } + } + } + } else { + # hope that we can find in in the global PATH + $test_fallback = 1; + } + if ($test_fallback) { + # all our playing around and copying did not succeed, try the + # fallback + $::progs{$p} = $p; + if ($arg ne "notest") { + my $ret = system("$p $arg > /dev/null 2>&1"); + if ($ret == 0) { + debug("Using system $p (tested).\n"); + } else { + tlwarn("TeXLive::TLUtils::setup_programs failed.\n"); + tlwarn("Could not find a usable program for $p.\n"); + return 0; + } + } else { + debug ("Using system $p (not tested).\n"); + } + } +} =item C @@ -2126,6 +2199,18 @@ sub tlmd5 { } } +# +# remove the stuff accumulated in @TeXLive::TLConfig::PostMortemRemovals +# +sub cleanup { + for my $e (@TeXLive::TLConfig::PostMortemRemovals) { + unlink($e) unless -d $e; + } + for my $e (@TeXLive::TLConfig::PostMortemRemovals) { + rmdir($e) if -d $e; + } +} + ############################################# # # Taken from Text::ParseWords -- cgit v1.2.3