partially working version with full compressor/downloader support

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

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);
   }