rework installation

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

3 files changed, 216 insertions, 115 deletions

diff --git a/Master/tlpkg/TeXLive/TLMedia.pm b/Master/tlpkg/TeXLive/TLMedia.pm
index 061e369b6a8..1d04b2233db 100644
--- a/Master/tlpkg/TeXLive/TLMedia.pm
+++ b/Master/tlpkg/TeXLive/TLMedia.pm
@@ -280,36 +280,21 @@ sub install_package {
 }
 
 sub _install_package {
-  sub mysystem {
-    my $cmd = shift;
-    # print "DEBUG: $cmd\n";
-    system("$cmd");
-  }
   my ($self, $what, $filelistref, $totlpdb) = @_;
-  my $buffer;
-  my $offset;
-  my $blocksize=2048;
+
   my $media = $self->media;
   my $target = $totlpdb->root;
 
-  $blocksize=4096 if ($media eq 'NET');
-
   my @filelist = @$filelistref;
 
-  my $bindir  = "$target/tlpkg/installer";
-  my $platform = $totlpdb->option_platform;
-  # unix defaults
-  my $wget    = "wget";
-  my $lzmadec = "$bindir/lzmadec.$platform";
-  my $tar     = "tar";
-  if (win32()) {
-    $wget    = conv_to_win_path("$bindir/wget.exe");
-    #$tar     = conv_to_win_path("$bindir/bsdtar.exe");
-    # try Akira's tar.exe
-    $tar     = conv_to_win_path("$bindir/tar.exe");
-    $lzmadec = conv_to_win_path("$lzmadec");
-    $target =~ s!/!\\!g;
+  # we assume that $::progs has been set up!
+  my $wget = $::progs{'wget'};
+  my $lzmadec = $::progs{'lzmadec'};
+  my $tar = $::progs{'tar'};
+  if (!defined($wget) || !defined($lzmadec) || !defined($tar)) {
+    die "Programs have not been set up properly, strange!";
   }
+
   if (ref $what) {
     # we are getting a ref to a list of files, so install from DVD
     my $location = $self->location;
@@ -320,43 +305,46 @@ sub _install_package {
       mkdirhier("$target/$dn");
       copy "$location/$file", "$target/$dn";
     }
-  } elsif ($what =~ m,http://|ftp://,) {
-    # we are installing from the NET
-    # currently the list of file @filelist is NOT EVALUATED!!!
-    if (win32()) {
-      # we need temporary files here
-      # tmpdir is $target/temp
-      my $fn = basename($what);
-      my $tarfile = $fn;
-      $tarfile =~ s/\.lzma$//;
-      mkdirhier("$target/temp");
-      tllog($::LOG_DEBUG, "Downloading $what to $target\\temp\\$fn\n");
-      tllog($::LOG_DEBUG, `$wget --tries=2 --timeout=60 -q -O \"$target\\temp\\$fn\" \"$what\" 2>\&1`);
-      tllog($::LOG_DEBUG, "Un-lzmaing $target\\temp\\$fn to $target\\temp\\$tarfile\n");
-      #tllog($::LOG_DEBUG, `type \"$target\\temp\\$fn\" | $lzmadec > \"$target\\temp\\$tarfile\" 2>&1`);
-      tllog($::LOG_DEBUG, `$lzmadec < \"$target\\temp\\$fn\" > \"$target\\temp\\$tarfile\" 2>&1`);
-      tllog($::LOG_DEBUG, "Unpacking temp\\$tarfile\n");
-      tllog($::LOG_DEBUG, `pushd \"$target\" & $tar -xf \"temp\\$tarfile\" 2>&1`);
-      unlink("$target/temp/$tarfile", "$target/temp/$fn");
-    } else {
-      tllog($::LOG_DEBUG, "downloading/unlzma-ing/unpacking $what\n");
-      tllog($::LOG_NORMAL, `$wget --tries=2 --timeout=60 -q -O- \"$what\"|\"$lzmadec\"|$tar -xf - -C \"$target\"`);
-    }
   } elsif ($what =~ m,\.tar.lzma$,) {
+    # this is the case when we install from CD or the NET
+    #
+    # in all other cases we create temp files .tar.lzma (or use the present
+    # one), lzmadec them, and then call tar
+
+    my $fn = basename($what);
+    mkdirhier("$target/temp");
+    my $lzmafile = "$target/temp/$fn";
+    my $tarfile  = "$target/temp/$fn"; $tarfile =~ s/\.lzma$//;
+    my $lzmafile_quote = $lzmafile;
+    my $tarfile_quote = $tarfile;
+    my $target_quote = $target;
     if (win32()) {
-      my $fn = basename($what);
-      my $tarfile = $fn;
-      $tarfile =~ s/\.lzma$//;
-      mkdirhier("$target/temp");
-      tllog($::LOG_DEBUG, "Un-lzmaing $what to $target\\temp\\$tarfile\n");
-      tllog($::LOG_DEBUG, `$lzmadec < \"$what\" > \"$target\\temp\\$tarfile\" 2>&1`);
-      tllog($::LOG_DEBUG, "Unpacking temp\\$tarfile\n");
-      tllog($::LOG_DEBUG, `pushd \"$target\" & $tar -xf \"temp\\$tarfile\" 2>&1`);
-      unlink("$target/temp/$tarfile");
+      $lzmafile =~ s!/!\\!g;
+      $lzmafile_quote = "\"$lzmafile\"";
+      $tarfile =~ s!/!\\!g;
+      $tarfile_quote = "\"$tarfile\"";
+      $target =~ s!/!\\!g;
+      $target_quote = "\"$target\"";
+    }
+    if ($what =~ m,http://|ftp://,) {
+      # we are installing from the NET
+      # download the file and put it into temp
+      if (!download_file($what, $lzmafile) || (! -r $lzmafile)) {
+        die "Downloading $what did not succeed, please retry!";
+      }
     } else {
-      tllog($::LOG_DEBUG, "downloading/unlzma-ing/unpacking $what\n");
-      tllog($::LOG_DEBUG, `cat \"$what\"|\"$lzmadec\"|$tar -xf - -C \"$target\" 2>&1`);
+      # we are installing from CD
+      # copy it to temp
+      copy($what, "$target/temp");
+    }
+    tllog($::LOG_DEBUG, "Un-lzmaing $lzmafile to $tarfile\n");
+    system("$lzmadec < $lzmafile_quote > $tarfile_quote");
+    if (! -f $tarfile) {
+      die "Unpacking $lzmafile did not succeed, please retry!";
     }
+    tllog($::LOG_DEBUG, "Unpacking $tarfile\n");
+    system($tar,"-x","-C",$target,"-f",$tarfile);
+    unlink($tarfile, $lzmafile);
   } else {
     die "Don't know how to install $what!\n";
   }
diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index 135e5856104..fc8d7b1ac58 100644
--- a/Master/tlpkg/TeXLive/TLPDB.pm
+++ b/Master/tlpkg/TeXLive/TLPDB.pm
@@ -181,18 +181,24 @@ sub from_file {
   } else {
     $self->root($root_from_path);
   }
+  my $retfh;
   if ($path =~ /^(http|ftp):\/\//) {
     tllog($::LOG_DDDEBUG, "TLPDB.pm: trying to initialize from $path\n");
-    open(TMP, "wget -q --output-document=- $path|") 
-        || die("Cannot open tlpdb file: $path"); 
+    $retfh = TeXLive::TLUtils::download_file($path, "|");
+    #open(TMP, "wget -q --output-document=- $path|") 
+    #   || die("Cannot open tlpdb file: $path"); 
+    if (!$retfh) {
+      die("Cannot open tlpdb file: $path");
+    }
   } else {
     open(TMP,"<$path") || die("Cannot open tlpdb file: $path");
+    $retfh = \*TMP;
   }
   my $found = 0;
   do {
     my $tlp = TeXLive::TLPOBJ->new;
     tllog($::LOG_DDDEBUG, "creating tlp from $path...\n");
-    $found = $tlp->from_fh(\*TMP,1);
+    $found = $tlp->from_fh($retfh,1);
     if ($found) {
       $self->add_tlpobj($tlp);
     }
diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index ccc464bfde9..a1d455295fe 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -39,6 +39,8 @@ C<TeXLive::TLUtils> -- utilities used in the TeX Live infrastructure
   TeXLive::TLUtils::dirname_and_basename($path);
   TeXLive::TLUtils::mkdirhier($path);
   TeXLive::TLUtils::copy($file, $target_dir);
+  TeXLive::TLUtils::download_file( $path, $destination [, $progs ] );
+  TeXLive::TLUtils::setup_programs( $bindir, $platform);
 
 =head2 Installer Functions
 
@@ -105,8 +107,10 @@ BEGIN {
     &kpsewhich
     &quotewords
     &conv_to_win_path
+    &setup_programs
+    &download_file
   );
-  @EXPORT = qw(tllog);
+  @EXPORT = qw(tllog setup_programs download_file);
 }
 
 
@@ -633,32 +637,16 @@ is not taken into account (should be fixed!).
 =cut
 
 sub install_package {
-  sub mysystem {
-    my $cmd = shift;
-    # print "DEBUG: $cmd\n";
-    system("$cmd");
-  }
   my ($what, $filelistref, $target, $platform) = @_;
-  my $buffer;
-  my $offset;
-  my $blocksize=2048;
-
-  $blocksize=4096 if ($::_media_ eq 'NET');
 
   my @filelist = @$filelistref;
 
-  my $bindir  = "$::installerdir/tlpkg/installer";
-  # unix defaults
-  my $wget    = "wget";
-  my $lzmadec = "$bindir/lzmadec.$::_platform_";
-  my $tar     = "tar";
-  if (win32()) {
-    $wget    = conv_to_win_path("$bindir/wget.exe");
-    #$tar     = conv_to_win_path("$bindir/bsdtar.exe");
-    # try Akira's tar.exe
-    $tar     = conv_to_win_path("$bindir/tar.exe");
-    $lzmadec = conv_to_win_path("$lzmadec");
-    $target =~ s!/!\\!g;
+  # we assume that $::progs has been set up!
+  my $wget = $::progs{'wget'};
+  my $lzmadec = $::progs{'lzmadec'};
+  my $tar = $::progs{'tar'};
+  if (!defined($wget) || !defined($lzmadec) || !defined($tar)) {
+    die "Programs have not been set up properly, strange!";
   }
   if (ref $what) {
     # we are getting a ref to a list of files, so install from DVD
@@ -669,48 +657,167 @@ sub install_package {
       mkdirhier("$target/$dn");
       copy "$file", "$target/$dn";
     }
-  } elsif ($what =~ m,http://|ftp://,) {
-    # we are installing from the NET
-    # currently the list of file @filelist is NOT EVALUATED!!!
-    if (win32()) {
-      # we need temporary files here
-      # tmpdir is $target/temp
-      my $fn = basename($what);
-      my $tarfile = $fn;
-      $tarfile =~ s/\.lzma$//;
-      mkdirhier("$target/temp");
-      tllog($::LOG_DEBUG, "Downloading $what to $target\\temp\\$fn\n");
-      tllog($::LOG_DEBUG, `$wget -q -O \"$target\\temp\\$fn\" \"$what\" 2>\&1`);
-      tllog($::LOG_DEBUG, "Un-lzmaing $target\\temp\\$fn to $target\\temp\\$tarfile\n");
-      #tllog($::LOG_DEBUG, `type \"$target\\temp\\$fn\" | $lzmadec > \"$target\\temp\\$tarfile\" 2>&1`);
-      tllog($::LOG_DEBUG, `$lzmadec < \"$target\\temp\\$fn\" > \"$target\\temp\\$tarfile\" 2>&1`);
-      tllog($::LOG_DEBUG, "Unpacking temp\\$tarfile\n");
-      tllog($::LOG_DEBUG, `pushd \"$target\" & $tar -xf \"temp\\$tarfile\" 2>&1`);
-      unlink("$target/temp/$tarfile", "$target/temp/$fn");
-    } else {
-      tllog($::LOG_DEBUG, "downloading/unlzma-ing/unpacking $what\n");
-      tllog($::LOG_NORMAL, `$wget -q -O- \"$what\"|\"$lzmadec\"|$tar -xf - -C \"$target\"`);
-    }
   } elsif ($what =~ m,\.tar.lzma$,) {
+    # this is the case when we install from CD or the NET
+    #
+    # in all other cases we create temp files .tar.lzma (or use the present
+    # one), lzmadec them, and then call tar
+    
+    my $fn = basename($what);
+    mkdirhier("$target/temp");
+    my $lzmafile = "$target/temp/$fn";
+    my $tarfile  = "$target/temp/$fn"; $tarfile =~ s/\.lzma$//;
+    my $lzmafile_quote = $lzmafile;
+    my $tarfile_quote = $tarfile;
+    my $target_quote = $target;
     if (win32()) {
-      my $fn = basename($what);
-      my $tarfile = $fn;
-      $tarfile =~ s/\.lzma$//;
-      mkdirhier("$target/temp");
-      tllog($::LOG_DEBUG, "Un-lzmaing $what to $target\\temp\\$tarfile\n");
-      tllog($::LOG_DEBUG, `$lzmadec < \"$what\" > \"$target\\temp\\$tarfile\" 2>&1`);
-      tllog($::LOG_DEBUG, "Unpacking temp\\$tarfile\n");
-      tllog($::LOG_DEBUG, `pushd \"$target\" & $tar -xf \"temp\\$tarfile\" 2>&1`);
-      unlink("$target/temp/$tarfile");
+      $lzmafile =~ s!/!\\!g;
+      $lzmafile_quote = "\"$lzmafile\"";
+      $tarfile =~ s!/!\\!g;
+      $tarfile_quote = "\"$tarfile\"";
+      $target =~ s!/!\\!g;
+      $target_quote = "\"$target\"";
+    }
+    if ($what =~ m,http://|ftp://,) {
+      # we are installing from the NET
+      # download the file and put it into temp
+      if (!download_file($what, $lzmafile) || (! -r $lzmafile)) {
+        die "Downloading $what did not succeed, please retry!";
+      }
     } else {
-      tllog($::LOG_DEBUG, "downloading/unlzma-ing/unpacking $what\n");
-      tllog($::LOG_DEBUG, `cat \"$what\"|\"$lzmadec\"|$tar -xf - -C \"$target\" 2>&1`);
+      # we are installing from CD
+      # copy it to temp
+      copy($what, "$target/temp");
+    }
+    tllog($::LOG_DEBUG, "Un-lzmaing $lzmafile to $tarfile\n");
+    system("$lzmadec < $lzmafile_quote > $tarfile_quote");
+    if (! -f $tarfile) {
+      die "Unpacking $lzmafile did not succeed, please retry!";
     }
+    tllog($::LOG_DEBUG, "Unpacking $tarfile\n");
+    system($tar,"-x","-C",$target,"-f",$tarfile);
+    unlink($tarfile, $lzmafile);
   } else {
     die "Don't know how to install $what!\n";
   }
 }
 
+=pod
+
+=item C<setup_programs( $bindir, $platform )>
+
+Sets up the global $::progs hash containing the pathes to the 
+programs C<wget>, C<tar>, C<lzmadec>. The C<$bindir> argument specifies
+the path to the location of the C<lzmadec> binaries, the C<$platform>
+gives the extension for the C<lzmadec> binary.
+
+=cut
+
+sub setup_programs {
+  my ($bindir, $platform) = @_;
+  $::progs{'wget'} = "wget";
+  $::progs{'lzmadec'} = "$bindir/lzmadec.$platform";
+  $::progs{'tar'} = "tar";
+  if (win32()) {
+    $::progs{'wget'}    = conv_to_win_path("$bindir/wget.exe");
+    $::progs{'tar'}     = conv_to_win_path("$bindir/tar.exe");
+    $::progs{'lzmadec'} = conv_to_win_path($::progs{'lzmadec'});
+  }
+}
+
+=pod
+
+=item C<download_file( $path, $destination [, $progs ] )>
+
+Try to download the file given in C<$relpath> from either C<$TeXLiveURL>
+or C<TeXLiveAlternativeURL> into C<$destination> (a filename!). 
+
+The optional argument C<$progs> is 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".
+
+=cut
+
+sub download_file {
+  my ($relpath, $dest, $progs) = @_;
+  my $wget;
+  if (defined($progs) && defined($progs->{'wget'})) {
+    $wget = $progs->{'wget'};
+  } elsif (defined($::progs{'wget'})) {
+    $wget = $::progs{'wget'};
+  } else {
+    warn ("Programs have not been set up, trying simply wget");
+    $wget = "wget";
+  }
+  if (win32()) {
+    $dest =~ s!/!\\!g;
+  }
+  my $url;
+  if ($relpath =~ /^(http|ftp):\/\//) {
+    $url = $relpath;
+  } else {
+    $url = "$TeXLiveURL/$relpath";
+  }
+
+  tllog($::LOG_DEBUG, "Trying to download $url\n");
+  my $ret;
+  if ($dest eq "|") {
+    open(RETFH, "$wget --tries=2 --timeout=60 -q --output-document=- $url|") or 
+      die("Cannot open $url via wget for reading");
+    # opening to a pipe always succeeds, so we return immediately
+    return \*RETFH;
+  } else {
+    $ret = system $wget, "-q", "--tries=2", "--timeout=60", "-O", $dest, $url;
+    # we have to reverse the meaning of ret because systems returns
+    # the inverse
+    $ret = ($ret ? 0 : 1);
+  }
+  if (!$ret) {
+    tllog($::LOG_DEBUG, "Download/Opening $url did not succeed\n");
+    if ($relpath =~ /^(http|ftp):\/\//) {
+      # we did get a full url, give up immediately
+      return undef;
+    }
+
+    # First we try the alternative URL
+    if ($TeXLiveAlternativeURL) {
+      $url = "$TeXLiveAlternativeURL/$relpath";
+      tllog($::LOG_DEBUG, "Trying to download $url\n");
+      if ($dest eq "|") {
+        open(RETFH, "$wget --tries=2 --timeout=60 -q --output-document=- $url|") or
+          die("Cannot open $url via wget for reading");
+        # opening to a pipe always succeeds, so we return immediately
+        return \*RETFH;
+      } else {
+        $ret = system $wget, "-q", "--tries=2", "--timeout=60", "-O", $dest, $url;
+        if ($ret) {
+          $ret = 0;
+        }
+      }
+      if ($ret) {
+        # ok, we give up
+        tllog($::LOG_DEBUG, "Download/Open $url did not succeed, giving up\n");
+        return;
+      } else {
+        tllog($::LOG_DEBUG, "Download/Open $url did succeed\n");
+        if ($dest eq "|") {
+          return \*RETFH;
+        } else {
+          return 1;
+        }
+      }
+    }
+    # could we try something else?
+    return undef;
+  }
+  tllog($::LOG_DEBUG, "Download $url did succeed\n");
+  if ($dest eq "|") {
+    return \*RETFH;
+  } else {
+    return 1;
+  }
+}
+
 sub install_package_old {
 # either a list of files or a name of one .zip or .tar.lzma file.
   my @what=@_;