TLUtils::unpack - allow for checksum and size argument and removal

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

1 files changed, 59 insertions, 17 deletions

diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index b2c74c3a6ca..ab333f80e21 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -2203,16 +2203,47 @@ sub w32_remove_from_path {
 
 =pod
 
-=item C<unpack($what, $targetdir>
+=item C<unpack($what, $targetdir, @opts>
 
 If necessary, downloads C$what>, and then unpacks it into C<$targetdir>.
+C<@opts> is assigned to a hash and can contain the following 
+options: C<tmpdir> (use this directory for downloaded files), 
+C<checksum> (check downloaded file against this checksum), 
+C<size> (check downloaded file against this size),
+C<remove> (remove temporary files after operation).
 Returns the name of the unpacked package (determined from the name of C<$what>)
 in case of success, otherwise undefined.
 
 =cut
 
+sub check_file {
+  my ($xzfile, $checksum, $size);
+  if ($checksum) {
+    if (tlmd5($xzfile) ne $checksum) {
+      tlwarn("Found $what in $tempdir, but hashsums differ, removing it.\n");
+      unlink($xzfile);
+    }
+  } elsif ($size) {
+    my $filesize = (stat $xzfile)[7];
+    if ($filesize != $size) {
+      tlwarn("Found $what in $tempdir, but sizes differ, removing it.\n");
+      unlink($xzfile);
+    } else {
+      tlwarn("Found $what in $tempdir with equal size, continuing fingers crossed.\n");
+    }
+  } else {
+    tlwarn("Found $what in $tempdir but no size or checksum information, removing it.\n");
+    unlink($xzfile);
+  }
+}
+
 sub unpack {
-  my ($what, $target) = @_;
+  my ($what, $target, %opts) = @_;
+  # remove by default
+  my $remove = (defined($opts{'remove'}) ? $opts{'remove'} : 1);
+  my $tempdir = (defined($opts{'tmpdir'}) ? $opts{'tmpdir'} : tl_tmpdir());
+  my $checksum = (defined($opts{'checksum'}) ? $opts{'checksum'} : 0);
+  my $size = (defined($opts{'size'}) ? $opts{'size'} : 0);
 
   if (!defined($what)) {
     tlwarn("TLUtils::unpack: nothing to unpack!\n");
@@ -2235,20 +2266,20 @@ sub unpack {
     return;
   }
 
-  my $tempdir = tl_tmpdir();
-
-  # we are still here, so something was handed in and we have either .tar or .tar.xz
+  # we are still here, so something was handed in and we have either
+  # .tar or .tar.xz
   my $fn = basename($what);
   my $pkg = $fn;
   $pkg =~ s/\.tar(\.xz)?$//;
   my $tarfile;
   my $remove_tarfile = 1;
+  my $remove_xzfile = $remove;
   if ($type eq "xz") {
     my $xzfile = "$tempdir/$fn";
     $tarfile  = "$tempdir/$fn"; $tarfile =~ s/\.xz$//;
-    my $xzfile_quote = $xzfile;
-    my $tarfile_quote = $tarfile;
-    my $target_quote = $target;
+    my $xzfile_quote;
+    my $tarfile_quote;
+    my $target_quote;
     if (win32()) {
       $xzfile =~ s!/!\\!g;
       $tarfile =~ s!/!\\!g;
@@ -2257,20 +2288,31 @@ sub unpack {
     $xzfile_quote = "\"$xzfile\"";
     $tarfile_quote = "\"$tarfile\"";
     $target_quote = "\"$target\"";
-    if ($what =~ m,http://|ftp://,) {
+    if ($what =~ m,^(http|ftp)://,) {
       # we are installing from the NET
-      # download the file and put it into temp
-      if (!download_file($what, $xzfile) || (! -r $xzfile)) {
-        tlwarn("Downloading \n");
-        tlwarn("   $what\n");
-        tlwarn("did not succeed, please retry.\n");
-        unlink($tarfile, $xzfile);
-        return;
+      # check for the presence of $what in $tempdir
+      if (-r $xzfile) {
+        check_file($xzfile, $checksum, $size);
+      }
+      # if the file is now not present, we can use it
+      if (! -r $xzfile) {
+        # try download the file and put it into temp
+        download_file($what, $xzfile);
+        # remove false downloads
+        check_file($xzfile, $checksum, $size);
+        if ( -r $xzfile ) {
+          tlwarn("Downloading\n");
+          tlwarn("   $what\n");
+          tlwarn("did not succeed, please retry.\n");
+          return;
+        }
       }
     } else {
       # we are installing from local compressed files
       # copy it to temp
       TeXLive::TLUtils::copy($what, $tempdir);
+      # we can remove it afterwards
+      $remove_xzfile = 1;
     }
     debug("un-xzing $xzfile to $tarfile\n");
     system("$xzdec < $xzfile_quote > $tarfile_quote");
@@ -2279,7 +2321,7 @@ sub unpack {
       unlink($tarfile, $xzfile);
       return;
     }
-    unlink($xzfile);
+    unlink($xzfile) if $remove_xzfile;
   } else {
     $tarfile = "$tempdir/$fn";
     if ($what =~ m,http://|ftp://,) {