summaryrefslogtreecommitdiff
path: root/systems/texlive/tlnet/tlpkg/TeXLive/TLUtils.pm
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2020-04-11 03:09:12 +0000
committerNorbert Preining <norbert@preining.info>2020-04-11 03:09:12 +0000
commitc2697fc286a1e2c94fd9968b76be6f4a6d2114cd (patch)
tree1dc2cfb07cb032740483dd8be7c74aff66b70352 /systems/texlive/tlnet/tlpkg/TeXLive/TLUtils.pm
parent25111608e6aa05042b0c6f83009262e1973d7a45 (diff)
CTAN sync 202004110309
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/TeXLive/TLUtils.pm')
-rw-r--r--systems/texlive/tlnet/tlpkg/TeXLive/TLUtils.pm108
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 {