allow for retrial with mutiple downloaders until succeed

git-svn-id: svn://tug.org/texlive/trunk@47833 c570f23f-e606-0410-a88d-b1316a301751

3 files changed, 70 insertions, 72 deletions

diff --git a/Master/texmf-dist/scripts/texlive/tlmgr.pl b/Master/texmf-dist/scripts/texlive/tlmgr.pl
index 8ee5ee58b33..f6ef77c4bad 100755
--- a/Master/texmf-dist/scripts/texlive/tlmgr.pl
+++ b/Master/texmf-dist/scripts/texlive/tlmgr.pl
@@ -6527,7 +6527,7 @@ sub init_local_db {
   if (!setup_programs("$Master/tlpkg/installer", $localtlpdb->platform)) {
     tlwarn("$prg: Couldn't set up the necessary programs.\nInstallation of packages is not supported.\nPlease report to texlive\@tug.org.\n");
     if (defined($should_i_die) && $should_i_die) {
-      return ($F_ERROR);
+      die("$prg: no way to continue!\n");
     } else {
       tlwarn("$prg: Continuing anyway ...\n");
       return ($F_WARNING);
diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index 7c19c9a805e..3c3f4a3dce3 100644
--- a/Master/tlpkg/TeXLive/TLPDB.pm
+++ b/Master/tlpkg/TeXLive/TLPDB.pm
@@ -306,8 +306,7 @@ sub from_file {
   $self->{'media'} = $media;
   #
   # actually load the TLPDB
-  # if ($path =~ m;^((https?|ftp)://|file:\/\/*);) {
-  if ($media eq 'NET' || $path =~ m;^file:\/\/*;) {
+  if ($path =~ m;^((https?|ftp)://|file:\/\/*); || $path =~ m;$TeXLive::TLUtils::SshURIRegex;) {
     debug("TLPDB.pm: trying to initialize from $path\n");
     # now $xzfh filehandle is open, the file created
     # TLUtils::download_file will just overwrite what is there
diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index 8abb9eba30b..508195135d9 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -2331,6 +2331,7 @@ sub setup_programs {
   my $ok = 1;
 
   if ($^O =~ /^MSWin/i) {
+    # we don't do any actual testing on Windows!
     $::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");
@@ -2368,33 +2369,23 @@ sub setup_programs {
     $::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;
-    }
+  # check whether selected downloader/compressor is working
+  # for downloader we allow 'lwp' as setting, too
+  if ($ENV{'TEXLIVE_DOWNLOADER'} && $ENV{'TEXLIVE_DOWNLOADER'} ne 'lwp' &&
+      !TeXLive::TLUtils::member($ENV{'TEXLIVE_DOWNLOADER'}, @{$::progs{'working_downloaders'}})) {
+    tlwarn("Selected download program TEXLIVE_DOWNLOADER=$ENV{'TEXLIVE_DOWNLOADER'} is not working!\n");
+    tlwarn("Please choose a different downloader or don't set TEXLIVE_DOWNLOADER at all.\n");
+    tlwarn("Detected working downloaders @{$::progs{'working_downloaders'}}\n");
+    $ok = 0;
+  }
+  if ($ENV{'TEXLIVE_COMPRESSOR'} &&
+      !TeXLive::TLUtils::member($ENV{'TEXLIVE_COMPRESSOR'}, @{$::progs{'working_compressors'}})) {
+    tlwarn("Selected download program TEXLIVE_COMPRESSOR=$ENV{'TEXLIVE_COMPRESSOR'} is not working!\n");
+    tlwarn("Please choose a different compressor or don't set TEXLIVE_COMPRESSOR at all.\n");
+    tlwarn("Detected working compressors: @{$::progs{'working_compressors'}}\n");
+    $ok = 0;
   }
+
   if ($::opt_verbosity >= 1) {
     require Data::Dumper;
     $Data::Dumper::Indent = 1;
@@ -2513,27 +2504,6 @@ sub setup_unix_one {
 }
 
 
-=item C<setup_program_with_env($envvar, $default, @accepted)>
-
-Setup a program based on configuration in the environment of default.
-
-=cut
-
-sub setup_program_with_env {
-  my ($envvar, $default, @accepted) = @_;
-  my $sel = $default;
-  if ($ENV{$envvar}) {
-    if (TeXLive::TLUtils::member($ENV{$envvar}, @accepted)) {
-      $sel = $ENV{$envvar};
-    } else {
-      tlwarn("$prog: unknown prog in $envvar=$ENV{$envvar}, falling back to $default\n");
-    }
-  }
-  return $sel;
-}
-
-
-
 =item C<download_file( $relpath, $destination )>
 
 Try to download the file given in C<$relpath> from C<$TeXLiveURL>
@@ -2610,10 +2580,44 @@ sub download_file {
     $url = "$TeXLiveURL/$relpath";
   }
 
-  my $fallback_retry = 0;
+  my @downloader_trials;
+  if ($ENV{'TEXLIVE_DOWNLOADER'}) {
+    push @downloader_trials, $ENV{'TEXLIVE_DOWNLOADER'};
+  } elsif ($ENV{"TL_DOWNLOAD_PROGRAM"}) {
+    push @downloader_trials, 'custom';
+  } else {
+    @downloader_trials = qw/lwp curl wget/;
+  }
+
+  my $success = 0;
+  for my $downtype (@downloader_trials) {
+    if ($downtype eq 'lwp') {
+      if (_download_file_lwp($url, $dest)) {
+        $success = $downtype;
+        last;
+      }
+    }
+    if ($downtype eq "custom" || TeXLive::TLUtils::member($downtype, @{$::progs{'working_downloaders'}})) {
+      if (_download_file_program($url, $dest, $downtype)) {
+        $success = $downtype;
+        last;
+      }
+    }
+  }
+  if ($success) {
+    debug("TLUtils::download_file: downloading using $success succeeded\n");
+    return(1);
+  } else {
+    debug("TLUtils::download_file: tried to download using @downloader_trials, none succeeded\n");
+    return(0);
+  }
+}
+
+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");
-    $ret = $::tldownload_server->get_file($url, $dest);
+    my $ret = $::tldownload_server->get_file($url, $dest);
     if ($ret) {
       ddebug("downloading file via persistent connection succeeded\n");
       return $ret;
@@ -2621,7 +2625,6 @@ sub download_file {
       debug("TLUtils::download_file: persistent connection ok,"
              . " but download failed: $url\n");
       debug("TLUtils::download_file: retrying with wget.\n");
-      $fallback_retry = 1; # just so we can give another msg.
     }
   } else {
     if (!defined($::tldownload_server)) {
@@ -2629,35 +2632,31 @@ sub download_file {
     } else {
       ddebug("::tldownload_server->enabled is not set\n");
     }
-    debug("persistent connection not set up, using fallback downloader\n");
-  }
-  
-  # try again.
-  my $ret = _download_file($url, $dest);
-  
-  if ($fallback_retry) {
-    debug("TLUtils::download_file: retry "
-           . ($ret ? "succeeded" : "failed") . ": $url\n");
+    debug("persistent connection not set up\n");
   }
-  
-  return($ret);
+  # if we are still here, download with LWP didn't succeed.
+  return(0);
 }
 
-sub _download_file {
-  my ($url, $dest) = @_;
+sub _download_file_program {
+  my ($url, $dest, $type) = @_;
   if (win32()) {
     $dest =~ s!/!\\!g;
   }
   
-  my $downloadername = $ENV{"TL_DOWNLOAD_PROGRAM"} || $FallbackDownloaderProgram{$::progs{'downloader'}};
-  my $downloader = $::progs{$downloadername};
+  debug("TLUtils::_download_file_program: $type $url $dest\n");
+  my $downloader;
   my $downloaderargs;
   my @downloaderargs;
-  if ($ENV{"TL_DOWNLOAD_ARGS"}) {
-    $downloaderargs = $ENV{"TL_DOWNLOAD_ARGS"};
-    @downloaderargs = split(' ', $downloaderargs);
+  if ($type eq 'custom') {
+    $downloader = $ENV{"TL_DOWNLOAD_PROGRAM"};
+    if ($ENV{"TL_DOWNLOAD_ARGS"}) {
+      $downloaderargs = $ENV{"TL_DOWNLOAD_ARGS"};
+      @downloaderargs = split(' ', $downloaderargs);
+    }
   } else {
-    @downloaderargs = @{$FallbackDownloaderArgs{$::progs{'downloader'}}};
+    $downloader = $::progs{$FallbackDownloaderProgram{$type}};
+    @downloaderargs = @{$FallbackDownloaderArgs{$type}};
     $downloaderargs = join(' ',@downloaderargs);
   }