summaryrefslogtreecommitdiff
path: root/Master/tlpkg/TeXLive/TLUtils.pm
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2018-05-23 02:33:23 +0000
committerNorbert Preining <preining@logic.at>2018-05-23 02:33:23 +0000
commit133247fba2e655af3d1907ca806032a129d95fdf (patch)
tree240108cf1133c6e1c7354b3a31e23fb9781f116b /Master/tlpkg/TeXLive/TLUtils.pm
parent17966dc786dc997f3e2f15a579ae6b2478d57442 (diff)
partially working version with full compressor/downloader support
git-svn-id: svn://tug.org/texlive/trunk@47807 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/TeXLive/TLUtils.pm')
-rw-r--r--Master/tlpkg/TeXLive/TLUtils.pm167
1 files changed, 74 insertions, 93 deletions
diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index d24d3ecf9e7..76497b26050 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -56,7 +56,6 @@ C<TeXLive::TLUtils> -- utilities used in TeX Live infrastructure
TeXLive::TLUtils::removed_dirs(@files);
TeXLive::TLUtils::download_file($path, $destination);
TeXLive::TLUtils::setup_programs($bindir, $platform);
- TeXLive::TLUtils::setup_compressor();
TeXLive::TLUtils::tlcmp($file, $file);
TeXLive::TLUtils::nulldev();
TeXLive::TLUtils::get_full_line($fh);
@@ -200,7 +199,7 @@ BEGIN {
&True
&False
);
- @EXPORT = qw(setup_programs setup_compressor download_file process_logging_options
+ @EXPORT = qw(setup_programs download_file process_logging_options
tldie tlwarn info log debug ddebug dddebug debug_hash
win32 xchdir xsystem run_cmd sort_archs);
}
@@ -2146,10 +2145,11 @@ sub unpack {
if (!$type) {
return(0, "don't know how to unpack");
}
+ # make sure that the found uncompressor type is also available
+ if (!member($type, @{$::progs{'working_compressors'}})) {
+ return(0, "unsupported container format $type");
+ }
- # we assume that $::progs has been set up!
- # wget is again checked by download file
- # my $wget = $::progs{'wget'};
# only check the necessary compressor program
my $decompressor = TeXLive::TLUtils::quotify_path_with_spaces($::progs{$DecompressorProgram{$type}});
my @decompressorArgs = @{$DecompressorArgs{$type}};
@@ -2328,49 +2328,17 @@ sub setup_programs {
my ($bindir, $platform) = @_;
my $ok = 1;
- $::progs{'wget'} = "wget";
- $::progs{'xz'} = "xz";
- $::progs{'tar'} = "tar";
- $::progs{'lz4'} = "lz4";
- $::progs{'gzip'} = "gzip";
- $::progs{'downloader'} = $::progs{$DefaultFallbackDownloader};
- $::progs{'downloader-args'} = @{$FallbackDownloaderArgs{$DefaultFallbackDownloader}};
if ($^O =~ /^MSWin/i) {
$::progs{'wget'} = conv_to_w32_path("$bindir/wget/wget.exe");
$::progs{'tar'} = conv_to_w32_path("$bindir/tar.exe");
$::progs{'xz'} = conv_to_w32_path("$bindir/xz/xz.exe");
$::progs{'lz4'} = conv_to_w32_path("$bindir/lz4/lz4.exe");
- # we leave gzip as is, needs to be provided by the PATH
- # for windows we don't expect to have curl available, use our own
- # shipped wget in all cases
- my $dltype = 'wget';
- $::progs{'downloader'} = $FallbackDownloaderProgram{$dltype};
- $::progs{'downloader-args'} = $FallbackDownloaderArgs{$dltype};
- # allow for hit-her-to override env vars
- if ($ENV{"TL_DOWNLOAD_PROGRAM"}) {
- $::progs{'downloader'} = $ENV{"TL_DOWNLOAD_PROGRAM"};
- }
- if ($ENV{"TL_DOWNLOAD_ARGS"}) {
- $::progs{'downloader-args'} = [ split (" ", $ENV{"TL_DOWNLOAD_ARGS"}) ];
- }
- my $comptype = setup_program_with_env('TEXLIVE_COMPRESSOR', $DefaultCompressorFormat, @AcceptedCompressors);
- $::progs{'compressor'} = $CompressorProgram{$comptype}:
- $::progs{'compressor-args'} = $CompressorArgs{$comptype}:
- $::progs{'decompressor'} = $DecompressorProgram{$comptype}:
- $::progs{'compressor-args'} = $DecompressorArgs{$comptype}:
-
- for my $prog ("downloader", "compressor") {
- my $ret = system("$::progs{$prog} --version >nul 2>&1"); # on windows
- if ($ret != 0) {
- warn "TeXLive::TLUtils::setup_programs (w32) failed"; # no nl for perl
- warn "$::progs{$prog} --version failed (status $ret): $!\n";
- warn "Output is:\n";
- system ("$::progs{$prog} $opt");
- warn "\n";
- $ok = 0;
- }
- }
+ $::progs{'working_downloaders'} = [ qw/wget/ ];
+ $::progs{'working_compressors'} = [ qw/xz lz4/ ];
} else {
+ # tar needs to be provided by the system!
+ $::progs{'tar'} = "tar";
+
if (!defined($platform) || ($platform eq "")) {
# we assume that we run from uncompressed media, so we can call platform() and
# thus also the config.guess script
@@ -2380,43 +2348,58 @@ sub setup_programs {
$platform = platform();
}
# setup of the fallback downloaders
+ my @working_downloaders;
for my $dltype (@AcceptedFallbackDownloaders) {
- my $defprog = $FallbackDownloadProgram{$dltype};
+ my $defprog = $FallbackDownloaderProgram{$dltype};
# do not warn on errors
- setup_unix_one($defprog, "$bindir/$dltype/$defprog.$platform", "--version", 1);
+ push @working_downloaders, $dltype if
+ setup_unix_one($defprog, "$bindir/$dltype/$defprog.$platform", "--version", 1);
}
+ $::progs{'working_downloaders'} = [ @working_downloaders ];
+ my @working_compressors;
for my $comptype (@AcceptedCompressors) {
my $defprog = $CompressorProgram{$comptype};
# do not warn on errors
- setup_unix_one($defprog, "$bindir/$comptype/$defprog.$platform", "--version", 1);
+ push @working_compressors, $comptype if
+ setup_unix_one($defprog, "$bindir/$comptype/$defprog.$platform", "--version", 1);
}
- # in the case of downloaders keys and prog names agree
- my $dltype = setup_program_with_env('TEXLIVE_DOWNLOADER',
- $DefaultFallbackDownloader,
- @AcceptedFallbackDownloaders);
- $::progs{'downloader'} = $FallbackDownloaderProgram{$dltype};
- $::progs{'downloader-args'} = $FallbackDownloaderArgs{$dltype};
- if ($ENV{"TL_DOWNLOAD_PROGRAM"}) {
- $::progs{'downloader'} = $ENV{"TL_DOWNLOAD_PROGRAM"};
+ $::progs{'working_compressors'} = [ @working_compressors ];
+ }
+
+ # setup downloaders based on env var and available programs
+ $::progs{'downloader'} =
+ setup_program_with_env('TEXLIVE_DOWNLOADER',
+ $DefaultFallbackDownloader,
+ @{$::progs{'working_downloaders'}});
+ $::progs{'compressor'} =
+ setup_program_with_env('TEXLIVE_COMPRESSOR',
+ $DefaultCompressorFormat,,
+ @{$::progs{'working_compressors'}});
+
+ # now check that compressor, decompressor, and downloader actually work
+ my %tested_progs;
+ my $nd = nulldev();
+ for my $selector ("downloader", "compressor") {
+ my $progtype = $::progs{$selector};
+ my $prog = $selector eq "downloader" ? $FallbackDownloaderProgram{$progtype} :
+ $CompressorProgram{$progtype};
+ my $ret = system("$::progs{$prog} --version >$nd 2>&1");
+ if ($ret != 0) {
+ tlwarn("TeXLive::TLUtils::setup_programs failed\n");
+ tlwarn(" program $::progs{$prog} --version (for $prog) (ret status: $ret): $!\n");
+ tlwarn("Output is:\n");
+ system ("$::progs{$prog} --version");
+ tlwarn ("\n");
+ $ok = 0;
}
- if ($ENV{"TL_DOWNLOAD_ARGS"}) {
- $::progs{'downloader-args'} = [ split (" ", $ENV{"TL_DOWNLOAD_ARGS"}) ];
- }
-
- # TODO TODO TODO
- die("NNED TO UPDATE MORE STUFF HERE IN setup_programs!");
- my $comptype = setup_program_with_env('TEXLIVE_COMPRESSOR', $DefaultCompressorFormat, @AcceptedCompressors);
-
-
-
-
- $s += setup_unix_one('wget', "$bindir/wget/wget.$platform", "--version");
- $s += setup_unix_one('xz', "$bindir/xz/xz.$platform", "notest");
- $ok = ($s == 2); # failure return unless all are present.
- # also try to set up lz4, but don't fail/warn
- setup_unix_one('lz4', "$bindir/lz4/lz4.$platform", "--version", 1);
}
-
+ if ($::opt_verbosity >= 1) {
+ require Data::Dumper;
+ $Data::Dumper::Indent = 1;
+ $Data::Dumper::Sortkeys = 1; # stable output
+ $Data::Dumper::Purity = 1; # recursive structures must be safe
+ print STDERR Data::Dumper->Dump([\%::progs], [qw(::progs)]);
+ }
return $ok;
}
@@ -2568,14 +2551,6 @@ would end in C<-O>. Use with care.
sub download_file {
my ($relpath, $dest) = @_;
- my $wget;
- if (defined($::progs{'wget'})) {
- $wget = $::progs{'wget'};
- } else {
- tlwarn ("download_file: Programs not set up, trying literal wget\n");
- $wget = "wget";
- }
- #
# create output dir if necessary
my $par;
if ($dest ne "|") {
@@ -2605,7 +2580,7 @@ sub download_file {
$url = "$TeXLiveURL/$relpath";
}
- my $wget_retry = 0;
+ my $fallback_retry = 0;
if (defined($::tldownload_server) && $::tldownload_server->enabled) {
debug("persistent connection set up, trying to get $url (for $dest)\n");
$ret = $::tldownload_server->get_file($url, $dest);
@@ -2616,7 +2591,7 @@ sub download_file {
debug("TLUtils::download_file: persistent connection ok,"
. " but download failed: $url\n");
debug("TLUtils::download_file: retrying with wget.\n");
- $wget_retry = 1; # just so we can give another msg.
+ $fallback_retry = 1; # just so we can give another msg.
}
} else {
if (!defined($::tldownload_server)) {
@@ -2628,10 +2603,10 @@ sub download_file {
}
# try again.
- my $ret = _download_file($url, $dest, $wget);
+ my $ret = _download_file($url, $dest);
- if ($wget_retry) {
- debug("TLUtils::download_file: retry with wget "
+ if ($fallback_retry) {
+ debug("TLUtils::download_file: retry "
. ($ret ? "succeeded" : "failed") . ": $url\n");
}
@@ -2639,25 +2614,31 @@ sub download_file {
}
sub _download_file {
- my ($url, $dest, $wgetdefault) = @_;
+ my ($url, $dest) = @_;
if (win32()) {
$dest =~ s!/!\\!g;
}
+
+ my $downloader = $ENV{"TL_DOWNLOAD_PROGRAM"} || $FallbackDownloaderProgram{$::progs{'downloader'}};
+ my $downloaderargs;
+ my @downloaderargs;
+ if ($ENV{"TL_DOWNLOAD_ARGS"}) {
+ $downloaderargs = $ENV{"TL_DOWNLOAD_ARGS"};
+ @downloaderargs = split(' ', $downloaderargs);
+ } else {
+ @downloaderargs = @{$FallbackDownloaderArgs{$::progs{'downloader'}}};
+ $downloaderargs = join(' ',@downloaderargs);
+ }
- my $wget = $ENV{"TL_DOWNLOAD_PROGRAM"} || $wgetdefault;
- my $wgetargs = $ENV{"TL_DOWNLOAD_ARGS"}
- || "--user-agent=texlive/wget --tries=10 --timeout=$NetworkTimeout -q -O";
-
- debug("downloading $url using $wget $wgetargs\n");
+ debug("downloading $url using $downloader $downloaderargs\n");
my $ret;
if ($dest eq "|") {
- open(RETFH, "$wget $wgetargs - $url|")
- || die "open($url) via $wget $wgetargs failed: $!";
+ open(RETFH, "$downloader $downloaderargs - $url|")
+ || die "open($url) via $downloader $downloaderargs failed: $!";
# opening to a pipe always succeeds, so we return immediately
return \*RETFH;
} else {
- my @wgetargs = split (" ", $wgetargs);
- $ret = system ($wget, @wgetargs, $dest, $url);
+ $ret = system ($downloader, @downloaderargs, $dest, $url);
# we have to reverse the meaning of ret because system has 0=success.
$ret = ($ret ? 0 : 1);
}