diff options
| -rwxr-xr-x | Master/texmf-dist/scripts/texlive/tlmgr.pl | 11 | ||||
| -rw-r--r-- | Master/tlpkg/TeXLive/TLConfig.pm | 6 | ||||
| -rw-r--r-- | Master/tlpkg/TeXLive/TLPOBJ.pm | 16 | ||||
| -rw-r--r-- | Master/tlpkg/TeXLive/TLUtils.pm | 167 |
4 files changed, 88 insertions, 112 deletions
diff --git a/Master/texmf-dist/scripts/texlive/tlmgr.pl b/Master/texmf-dist/scripts/texlive/tlmgr.pl index e89a3ab30d9..906faff441f 100755 --- a/Master/texmf-dist/scripts/texlive/tlmgr.pl +++ b/Master/texmf-dist/scripts/texlive/tlmgr.pl @@ -1091,8 +1091,7 @@ sub backup_and_remove_package { return($F_WARNING); } if ($opts{"backup"}) { - my ($compressor, $compressorextension) = TeXLive::TLUtils::setup_compressor(); - $tlp->make_container($compressor, $localtlpdb->root, + $tlp->make_container($::progs{'compressor'}, $localtlpdb->root, $opts{"backupdir"}, "${pkg}.r" . $tlp->revision, $tlp->relocated); @@ -2142,12 +2141,12 @@ sub action_backup { clear_old_backups ($pkg, $opts{"backupdir"}, $opts{"clean"}, $opts{"dry-run"}, 1); } else { # for now default to xz and allow overriding with env var - my ($compressor, $compressorextension) = TeXLive::TLUtils::setup_compressor(); + my $compressorextension = $CompressorExtension{$::progs{'compressor'}}; my $tlp = $localtlpdb->get_package($pkg); info("saving current status of $pkg to $opts{'backupdir'}/${pkg}.r" . $tlp->revision . ".tar.$compressorextension\n"); if (!$opts{"dry-run"}) { - $tlp->make_container($compressor, $localtlpdb->root, + $tlp->make_container($::progs{'compressor'}, $localtlpdb->root, $opts{"backupdir"}, "${pkg}.r" . $tlp->revision); } } @@ -3182,8 +3181,8 @@ sub action_update { } if ($opts{"backup"} && !$opts{"dry-run"}) { - my ($compressor, $compressorextension) = TeXLive::TLUtils::setup_compressor(); - $tlp->make_container($compressor, $root, + my $compressorextension = $CompressorExtension{$::progs{'compressor'}}; + $tlp->make_container($::progs{'compressor'}, $root, $opts{"backupdir"}, "${pkg}.r" . $tlp->revision, $tlp->relocated); $unwind_package = diff --git a/Master/tlpkg/TeXLive/TLConfig.pm b/Master/tlpkg/TeXLive/TLConfig.pm index 4588e29dbf8..108e54d003b 100644 --- a/Master/tlpkg/TeXLive/TLConfig.pm +++ b/Master/tlpkg/TeXLive/TLConfig.pm @@ -95,6 +95,9 @@ our $PackageBackupDir = "$InfraLocation/backups"; our $BlockSize = 4096; +# timeout for network connections (wget, LWP) in seconds +our $NetworkTimeout = 30; + our $Archive = "archive"; our $TeXLiveServerURL = "http://mirror.ctan.org"; # from 2009 on we try to put them all into tlnet directly without any @@ -220,9 +223,6 @@ our $WindowsMainMenuName = "TeX Live $ReleaseYear"; # Comma-separated list of engines which do not exist on all platforms. our $PartialEngineSupport = "luajittex,mfluajit"; -# timeout for network connections (wget, LWP) in seconds -our $NetworkTimeout = 30; - # Flags for error handling across the scripts and modules # all fine our $F_OK = 0; diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm index e0e5db16dfe..e93afc42fe3 100644 --- a/Master/tlpkg/TeXLive/TLPOBJ.pm +++ b/Master/tlpkg/TeXLive/TLPOBJ.pm @@ -559,9 +559,12 @@ sub common_texmf_tree { sub make_container { my ($self,$type,$instroot,$destdir,$containername,$relative) = @_; - if (!TeXLive::TLUtils::member($type, @AcceptedCompressors)) { - die "$0: TLPOBJ supports @AcceptedCompressors containers, not $type"; + if (!TeXLive::TLUtils::member($type, @{$::progs{'working_compressors'}})) { + tlwarn "$0: TLPOBJ supports @{$::progs{'working_compressors'}} containers, not $type\n"; + tlwarn "$0: falling back to $DefaultCompressorFormat as container type!\n"; + $type = $DefaultCompressorFormat; } + if (!defined($containername)) { $containername = $self->name; } @@ -631,13 +634,6 @@ sub make_container { $tar = "tar"; } - # determine compressor: - # * first try the one passed in as requested - # * if that one is not available, fall back to xz - if ($type ne "xz" && !defined($::progs{$CompressorProgram{$type}})) { - debug("$0: compressor of type $type not available, falling back to xz\n"); - $type = "xz"; - } my $compressor = $::progs{$CompressorProgram{$type}}; my @compressorargs = @{$CompressorArgs{$type}}; my $compressorextension = $CompressorExtension{$type}; @@ -730,7 +726,7 @@ sub make_container { if (-r "$destdir/$tarname") { system($compressor, @compressorargs, "$destdir/$tarname"); } else { - tlwarn("$0: Couldn't find $destdir/$tarname to run $xz\n"); + tlwarn("$0: Couldn't find $destdir/$tarname to run $compressor\n"); return (0, 0, ""); } 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); } |