diff options
author | Norbert Preining <norbert@preining.info> | 2020-04-11 03:09:12 +0000 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2020-04-11 03:09:12 +0000 |
commit | c2697fc286a1e2c94fd9968b76be6f4a6d2114cd (patch) | |
tree | 1dc2cfb07cb032740483dd8be7c74aff66b70352 /systems/texlive/tlnet/tlpkg/TeXLive/TLUtils.pm | |
parent | 25111608e6aa05042b0c6f83009262e1973d7a45 (diff) |
CTAN sync 202004110309
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/TeXLive/TLUtils.pm')
-rw-r--r-- | systems/texlive/tlnet/tlpkg/TeXLive/TLUtils.pm | 108 |
1 files changed, 71 insertions, 37 deletions
diff --git a/systems/texlive/tlnet/tlpkg/TeXLive/TLUtils.pm b/systems/texlive/tlnet/tlpkg/TeXLive/TLUtils.pm index 34862cd6cc..11c481bfe1 100644 --- a/systems/texlive/tlnet/tlpkg/TeXLive/TLUtils.pm +++ b/systems/texlive/tlnet/tlpkg/TeXLive/TLUtils.pm @@ -1,4 +1,4 @@ -# $Id: TLUtils.pm 53977 2020-02-29 23:16:52Z karl $ +# $Id: TLUtils.pm 54629 2020-04-06 10:40:48Z preining $ # TeXLive::TLUtils.pm - the inevitable utilities for TeX Live. # Copyright 2007-2020 Norbert Preining, Reinhard Kotucha # This file is licensed under the GNU General Public License version 2 @@ -6,7 +6,7 @@ package TeXLive::TLUtils; -my $svnrev = '$Revision: 53977 $'; +my $svnrev = '$Revision: 54629 $'; my $_modulerevision = ($svnrev =~ m/: ([0-9]+) /) ? $1 : "unknown"; sub module_revision { return $_modulerevision; } @@ -274,16 +274,16 @@ sub platform { =item C<platform_name($canonical_host)> -Convert a canonical host names as returned by C<config.guess> into -TeX Live platform names. +Convert ORIG_PLATFORM, a canonical host name as returned by +C<config.guess>, into a TeX Live platform name. CPU type is determined by a regexp, and any C</^i.86/> name is replaced by C<i386>. -For OS we need a list because what's returned is not likely to match our -historical names, e.g., C<config.guess> returns C<linux-gnu> but we need -C<linux>. This list might/should contain OSs which are not currently -supported. +For the OS value we need a list because what's returned is not likely to +match our historical names, e.g., C<config.guess> returns C<linux-gnu> +but we need C<linux>. This list contains old OSs which are not currently +supported, just in case. If a particular platform is not found in this list we use the regexp C</.*-(.*$)/> as a last resort and hope it provides something useful. @@ -291,12 +291,15 @@ C</.*-(.*$)/> as a last resort and hope it provides something useful. =cut sub platform_name { - my ($guessed_platform) = @_; + my ($orig_platform) = @_; + my $guessed_platform = $orig_platform; + # try to parse out some bsd variants that use amd64. $guessed_platform =~ s/^x86_64-(.*-k?)(free|net)bsd/amd64-$1$2bsd/; my $CPU; # CPU type as reported by config.guess. my $OS; # O/S type as reported by config.guess. ($CPU = $guessed_platform) =~ s/(.*?)-.*/$1/; + $CPU =~ s/^alpha(.*)/alpha/; # alphaev whatever $CPU =~ s/mips64el/mipsel/; # don't distinguish mips64 and 32 el $CPU =~ s/powerpc64/powerpc/; # don't distinguish ppc64 @@ -308,7 +311,7 @@ sub platform_name { $CPU = $guessed_platform =~ /hf$/ ? "armhf" : "armel"; } - my @OSs = qw(aix cygwin darwin freebsd hpux irix + my @OSs = qw(aix cygwin darwin dragonfly freebsd hpux irix kfreebsd linux netbsd openbsd solaris); for my $os (@OSs) { # Match word boundary at the beginning of the os name so that @@ -317,7 +320,12 @@ sub platform_name { # solaris2 is matched. $OS = $os if $guessed_platform =~ /\b$os/; } - + + if (! $OS) { + warn "$0: could not guess OS from config.guess string: $orig_platform"; + $OS = "unknownOS"; + } + if ($OS eq "linux") { # deal with the special case of musl based distributions # config.guess returns @@ -337,7 +345,7 @@ sub platform_name { # We don't use uname numbers here.) # # this changes each year, per above: - my $mactex_darwin = 12; # lowest minor rev supported by x86_64-darwin. + my $mactex_darwin = 13; # lowest minor rev supported by x86_64-darwin. # # Most robust approach is apparently to check sw_vers (os version, # returns "10.x" values), and sysctl (processor hardware). @@ -346,7 +354,7 @@ sub platform_name { if ($os_major != 10) { warn "$0: only MacOSX is supported, not $OS $os_major.$os_minor " . " (from sw_vers -productVersion: $sw_vers)\n"; - return "unknown-unknown"; + return "unknownmac-unknownmac"; } if ($os_minor >= $mactex_darwin) { ; # current version, default is ok (x86_64-darwin). @@ -413,8 +421,9 @@ sub platform_desc { 'universal-darwin' => 'MacOSX universal binaries', 'win32' => 'Windows', 'x86_64-cygwin' => 'Cygwin on x86_64', - 'x86_64-darwin' => 'MacOSX current (10.12-) on x86_64', + 'x86_64-darwin' => 'MacOSX current (10.13-) on x86_64', 'x86_64-darwinlegacy' => 'MacOSX legacy (10.6-) on x86_64', + 'x86_64-dragonfly' => 'DragonFlyBSD on x86_64', 'x86_64-linux' => 'GNU/Linux on x86_64', 'x86_64-linuxmusl' => 'GNU/Linux on x86_64 with musl', 'x86_64-solaris' => 'Solaris on x86_64', @@ -536,7 +545,7 @@ and thus honors various env variables like C<TMPDIR>, C<TMP>, and C<TEMP>. sub initialize_global_tmpdir { $::tl_tmpdir = File::Temp::tempdir(CLEANUP => 1); - ddebug("tl_tempdir: creating global tempdir $::tl_tmpdir\n"); + ddebug("initialize_global_tmpdir: creating global tempdir $::tl_tmpdir\n"); return ($::tl_tmpdir); } @@ -550,7 +559,7 @@ is terminated. sub tl_tmpdir { initialize_global_tmpdir() if (!defined($::tl_tmpdir)); my $tmp = File::Temp::tempdir(DIR => $::tl_tmpdir, CLEANUP => 1); - ddebug("tl_tempdir: creating tempdir $tmp\n"); + ddebug("tl_tmpdir: creating tempdir $tmp\n"); return ($tmp); } @@ -2205,7 +2214,10 @@ sub check_file_and_remove { if ($tlchecksum ne $checksum) { tlwarn("TLUtils::check_file: checksums differ for $xzfile:\n"); tlwarn("TLUtils::check_file: tlchecksum=$tlchecksum, arg=$checksum\n"); - $check_file_tmpdir = File::Temp::tempdir("tlcheckfileXXXXXXXX"); + # on Windows passing a pattern creates the tmpdir in PWD + # which means that it will be tried to be created on the DVD + # $check_file_tmpdir = File::Temp::tempdir("tlcheckfileXXXXXXXX"); + $check_file_tmpdir = File::Temp::tempdir(); tlwarn("TLUtils::check_file: removing $xzfile, " . "but saving copy in $check_file_tmpdir\n"); copy($xzfile, $check_file_tmpdir); @@ -2790,31 +2802,42 @@ sub download_file { } } + sub _download_file_lwp { my ($url, $dest) = @_; - if (defined($::tldownload_server) && $::tldownload_server->enabled) { - debug("persistent connection set up, trying to get $url (for $dest)\n"); - my $ret = $::tldownload_server->get_file($url, $dest); - if ($ret) { - ddebug("downloading file via persistent connection succeeded\n"); - return $ret; - } else { - debug("TLUtils::download_file: persistent connection ok," - . " but download failed: $url\n"); - debug("TLUtils::download_file: retrying with wget.\n"); + if (!defined($::tldownload_server)) { + ddebug("::tldownload_server not defined\n"); + return(0); + } + if (!$::tldownload_server->enabled) { + # try to reinitialize a disabled connection + # disabling happens after 6 failed download trials + # we just re-initialize the connection + if (!setup_persistent_downloads()) { + # setup failed, give up + debug("reinitialization of LWP download failed\n"); + return(0); } + # we don't need to check for ->enabled, because + # setup_persistent_downloads calls TLDownload->new() + # which, if it succeeds, automatically set enabled to 1 + } + # we are still here, so try to download + debug("persistent connection set up, trying to get $url (for $dest)\n"); + my $ret = $::tldownload_server->get_file($url, $dest); + if ($ret) { + ddebug("downloading file via persistent connection succeeded\n"); + return $ret; } else { - if (!defined($::tldownload_server)) { - ddebug("::tldownload_server not defined\n"); - } else { - ddebug("::tldownload_server->enabled is not set\n"); - } - debug("persistent connection not set up\n"); + debug("TLUtils::download_file: persistent connection ok," + . " but download failed: $url\n"); + debug("TLUtils::download_file: retrying with other downloaders.\n"); } # if we are still here, download with LWP didn't succeed. return(0); } + sub _download_file_program { my ($url, $dest, $type) = @_; if (win32()) { @@ -3419,9 +3442,11 @@ strings. The message will be omitted unless C<-v -v -v> was specified. If the log file (see L<process_logging_options>) is defined, it also writes there. -This third level debugging message reports messages about processing -each line of any tlpdb files read, in addition to the first and second -levels. +In addition to the first and second levels, this third level debugging +message reports messages about processing each line of any tlpdb files +read, and messages about files tested or matched against tlpsrc +patterns. This output is extremely voluminous, so unless you're +debugging those parts of the code, it just gets in the way. =cut @@ -3840,7 +3865,16 @@ false. sub setup_persistent_downloads { if ($TeXLive::TLDownload::net_lib_avail) { ddebug("setup_persistent_downloads has net_lib_avail set\n"); - $::tldownload_server = TeXLive::TLDownload->new; + if ($::tldownload_server) { + if ($::tldownload_server->initcount() > $TeXLive::TLConfig::MaxLWPReinitCount) { + debug("stop retrying to initialize LWP after 10 failures\n"); + return 0; + } else { + $::tldownload_server->reinit(); + } + } else { + $::tldownload_server = TeXLive::TLDownload->new; + } if (!defined($::tldownload_server)) { ddebug("TLUtils:setup_persistent_downloads: failed to get ::tldownload_server\n"); } else { |