From 133247fba2e655af3d1907ca806032a129d95fdf Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Wed, 23 May 2018 02:33:23 +0000 Subject: partially working version with full compressor/downloader support git-svn-id: svn://tug.org/texlive/trunk@47807 c570f23f-e606-0410-a88d-b1316a301751 --- Master/tlpkg/TeXLive/TLUtils.pm | 167 ++++++++++++++++++---------------------- 1 file changed, 74 insertions(+), 93 deletions(-) (limited to 'Master/tlpkg/TeXLive/TLUtils.pm') 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 -- 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); } -- cgit v1.2.3