diff options
Diffstat (limited to 'Master/tlpkg/TeXLive/TLUtils.pm')
-rw-r--r-- | Master/tlpkg/TeXLive/TLUtils.pm | 80 |
1 files changed, 47 insertions, 33 deletions
diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm index 0f6712e5775..9f1f6b5ed30 100644 --- a/Master/tlpkg/TeXLive/TLUtils.pm +++ b/Master/tlpkg/TeXLive/TLUtils.pm @@ -912,7 +912,7 @@ sub install_package { my $lzmadec = $::progs{'lzmadec'}; my $tar = $::progs{'tar'}; if (!defined($wget) || !defined($lzmadec) || !defined($tar)) { - die "Programs have not been set up properly, strange!"; + die "install_package: programs not set up properly, strange"; } if (ref $what) { # we are getting a ref to a list of files, so install from DVD @@ -1007,15 +1007,15 @@ sub install_package { copy($what, "$target/temp"); } } - debug("Un-lzmaing $lzmafile to $tarfile\n"); + debug("un-lzmaing $lzmafile to $tarfile\n"); system("$lzmadec < $lzmafile_quote > $tarfile_quote"); if (! -f $tarfile) { - die "Unpacking $lzmafile did not succeed, please retry!"; + die "Unpacking $lzmafile did not succeed, please retry"; } - debug("Unpacking $tarfile\n"); + debug("unpacking $tarfile\n"); system($tar,"-x","-C",$target,"-f",$tarfile); unlink($tarfile); - debug("Keeping $lzmafile for restarting ...\n"); + debug("keeping $lzmafile for restarting ...\n"); # unlink($lzmafile); } else { die "Don't know how to install $what!\n"; @@ -1103,18 +1103,19 @@ Try to download the file given in C<$relpath> from C<$TeXLiveURL> into C<$destination>, which can be either a filename of simply C<|>. In the latter case a file handle is returned. -The optional argument C<$progs> is a reference to a hash giving full pathes -to the respective programs, at least C<wget>. In case that C<$progs> is not -given the C<%::progs> is consulted, and if this also does not exist we -try "wget". +The optional argument C<$progs> is a reference to a hash giving full +paths to the respective programs, at least C<wget>. If C<$progs> is not +given the C<%::progs> hash is consulted, and if this also does not exist +we try a literal C<wget>. -Downloading honors two environment variables C<TL_DOWNLOAD_PROGRAM> and -C<TL_DOWNLOAD_ARGS>. The former overrides C<wget> (or what is given in the -C<$progs> argument, the latter overrides the default wget arguments -given in C<$TeXLive::TLConfig::DefaultWgetArgs>. +Downloading honors two environment variables: C<TL_DOWNLOAD_PROGRAM> and +C<TL_DOWNLOAD_ARGS>. The former overrides the above specification +devolving to C<wget>, and the latter overrides the default wget +arguments, which are: C<--tries=8 --timeout=60 -q -O>. -C<TL_DOWNLOAD_ARGS> must be set up in a way that the place the output should -go to is the first argument after the C<TL_DOWNLOAD_ARGS>. Use with care. +C<TL_DOWNLOAD_ARGS> must be defined so that the file the output goes to +is the first argument after the C<TL_DOWNLOAD_ARGS>. Thus, typically it +would end in C<-O>. Use with care. =cut @@ -1126,7 +1127,7 @@ sub download_file { } elsif (defined($::progs{'wget'})) { $wget = $::progs{'wget'}; } else { - tlwarn ("Programs have not been set up, trying simply wget"); + tlwarn ("download_file: Programs not set up, trying literal wget\n"); $wget = "wget"; } my $url; @@ -1163,27 +1164,25 @@ sub _download_file { } my $wget = $ENV{"TL_DOWNLOAD_PROGRAM"} || $wgetdefault; - # we set now the args in installer/wgetrc - my $wgetargs = $ENV{"TL_DOWNLOAD_ARGS"} || "-q -O"; + my $wgetargs = $ENV{"TL_DOWNLOAD_ARGS"} + || "--tries=8 --timeout=60 -q -O"; - - debug("Trying to download $url\n"); + debug("downloading $url using $wget $wgetargs\n"); my $ret; if ($dest eq "|") { - open(RETFH, "$wget $wgetargs - $url|") or - die("Cannot open $url via wget for reading"); + open(RETFH, "$wget $wgetargs - $url|") + || die "open($url) via $wget $wgetargs failed: $!"; # opening to a pipe always succeeds, so we return immediately return \*RETFH; } else { - my @wgetargs = split ' ', $wgetargs; - $ret = system $wget, @wgetargs, $dest, $url; - # we have to reverse the meaning of ret because systems returns - # the inverse + my @wgetargs = split (" ", $wgetargs); + $ret = system ($wget, @wgetargs, $dest, $url); + # we have to reverse the meaning of ret because system has 0=success. $ret = ($ret ? 0 : 1); } # return false/undef in case the download did not succeed. return ($ret) unless $ret; - debug("Download $url did succeed\n"); + debug("download of $url succeeded\n"); if ($dest eq "|") { return \*RETFH; } else { @@ -1716,28 +1715,43 @@ sub conv_to_w32_path { return($p); } +=pod + +=item C<give_ctan_mirror()> + +Return the specific mirror chosen from the generic CTAN auto-redirecting +default (specified in L<$TLConfig::TexLiveServerURL>) if possible, else +the default url again. + +Neither C<TL_DOWNLOAD_PROGRAM> nor <TL_DOWNLOAD_ARGS> is honored (see +L<download_file>), since certain options have to be set to do the job +and the program has to be C<wget> since we parse the output. + +=cut sub give_ctan_mirror { my $wget = $::progs{'wget'}; if (!defined ($wget)) { - tlwarn ("programs not set up, trying wget\n"); + tlwarn ("give_ctan_mirror: Programs not set up, trying wget\n"); $wget = "wget"; } - - my $cmd = "$wget $TeXLiveServerURL -O " + + # we need the verbose output, so no -q. + # do not reduce retries here, but timeout still seems desirable. + my $cmd = "$wget $TeXLiveServerURL --timeout=60 -O " . (win32() ? "nul" : "/dev/null") . " 2>&1"; my @out = `$cmd`; - # now analyze the output + # analyze the output for the mirror actually selected. my $mirror = $TeXLiveURL; foreach (@out) { if (m/^Location: (\S*)\s*.*$/) { - (my $mhost = $1) =~ s,/*$,,; # remove trailing slashes since we add it: + (my $mhost = $1) =~ s,/*$,,; # remove trailing slashes since we add it $mirror = "$mhost/$TeXLiveServerPath"; last; } } - # if we cannot find a mirror, return the default (mirror.ctan.org) itself + # if we cannot find a mirror, return the default again. return $mirror; } |