summaryrefslogtreecommitdiff
path: root/Master/tlpkg
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2009-01-25 00:31:50 +0000
committerNorbert Preining <preining@logic.at>2009-01-25 00:31:50 +0000
commit089bede91f69e6e87d61515b247ce58b7ad2c0ae (patch)
treeb0eb2ac58b0adf23c2659a3c18ec51b4f7a4d621 /Master/tlpkg
parent969940588403b61d9a1e491c62a696625aae5dcb (diff)
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
Diffstat (limited to 'Master/tlpkg')
-rw-r--r--Master/tlpkg/TeXLive/TLConfig.pm10
-rw-r--r--Master/tlpkg/TeXLive/TLUtils.pm173
2 files changed, 138 insertions, 45 deletions
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<TeXLive::TLUtils> -- 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<lzmadec> 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<download_file( $relpath, $destination [, $progs ] )>
@@ -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