support saved texlive.tlpdb

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

1 files changed, 66 insertions, 2 deletions

diff --git a/Master/texmf/scripts/texlive/tlmgr.pl b/Master/texmf/scripts/texlive/tlmgr.pl
index 3f32bb63543..f97c0bbf4c4 100755
--- a/Master/texmf/scripts/texlive/tlmgr.pl
+++ b/Master/texmf/scripts/texlive/tlmgr.pl
@@ -62,6 +62,8 @@ use Pod::Usage;
 use Getopt::Long qw(:config no_autoabbrev permute);
 use strict;
 
+use Digest::MD5;
+
 use TeXLive::TLConfig;
 use TeXLive::TLMedia;
 use TeXLive::TLPDB;
@@ -2677,10 +2679,72 @@ sub init_tlmedia {
     print "location-url\t$location\n" if $::machinereadable;
     info("tlmgr: installation location $location\n");
 
-    # $tlmediasrc is a global variable
-    $tlmediasrc = TeXLive::TLMedia->new($location);
+    #
+    # if we talk about a net location try to download the hash of the tlpdb
+    # - if that is possible, check for the locally saved file and if the hash
+    #   agrees load the local copy if present instead of the remote one,
+    #   if the hashes disagree, load the remote tlpdb
+    # - if that does not work assume we are offline or target not reachable,
+    #   so warn the user and use saved, but note that installation will 
+    #   not work
+
+    my $local_copy_tlpdb_used = 0;
+    if ($location =~ m;^(http|ftp)://;) {
+      # first check that the saved tlpdb is present at all
+      my $loc_digest = Digest::MD5::md5_hex($location);
+      my $loc_copy_of_remote_tlpdb = 
+        "$Master/$InfraLocation/texlive.tlpdb.$loc_digest";
+      ddebug("loc_digest = $loc_digest\n");
+      ddebug("loc_copy = $loc_copy_of_remote_tlpdb\n");
+      if (-r $loc_copy_of_remote_tlpdb) {
+        ddebug("loc copy found!\n");
+        # we found the tlpdb matching the current location
+        # check for the remote hash
+        my $path = "$location/$InfraLocation/$DatabaseName.md5";
+        ddebug("remote path of digest = $path\n");
+        my $fh = TeXLive::TLUtils::download_file($path, "|");
+        my $rem_digest;
+        if (read ($fh, $rem_digest, 32) != 32) {
+          info("No internet access detected, but a local copy of the remote\n");
+          info("texlive database has been found. Using this copy.\n");
+          $tlmediasrc = TeXLive::TLMedia->new(-location => $location,
+            -tlpdbfile => $loc_copy_of_remote_tlpdb);
+          $local_copy_tlpdb_used = 1;
+        } else {
+          ddebug("found remote digest: $rem_digest\n");
+          my $rem_copy_digest = TeXLive::TLUtils::tlmd5($loc_copy_of_remote_tlpdb);
+          ddebug("rem_copy_digest = $rem_copy_digest\n");
+          if ($rem_copy_digest eq $rem_digest) {
+            debug("md5 of local copy identical with remote hash\n");
+            $tlmediasrc = TeXLive::TLMedia->new(-location => $location,
+              -tlpdbfile => $loc_copy_of_remote_tlpdb);
+            $local_copy_tlpdb_used = 1;
+          }
+        }
+      }
+    }
+    if (!$local_copy_tlpdb_used) {
+      # $tlmediasrc is a global variable
+      $tlmediasrc = TeXLive::TLMedia->new(-location => $location);
+    }
     die($loadmediasrcerror . $location) unless defined($tlmediasrc);
     $tlmediatlpdb = $tlmediasrc->tlpdb;
+    # save remote database if it is a net location
+    # make sure that the writeout of the tlpdb is done in UNIX mode
+    # since otherwise the sha256 will change.
+    if (!$local_copy_tlpdb_used && $location =~ m;^(http|ftp)://;) {
+      my $loc_digest = Digest::MD5::md5_hex($location);
+      my $loc_copy_of_remote_tlpdb =
+        "$Master/$InfraLocation/texlive.tlpdb.$loc_digest";
+      my $tlfh;
+      if (!open($tlfh, ">:unix", $loc_copy_of_remote_tlpdb)) {
+        tlwarn("Cannot save remote TeX Live database to $loc_copy_of_remote_tlpdb: $!\n");
+      } else {
+        print "DEBUG: writing out tlpdb to $loc_copy_of_remote_tlpdb\n";
+        $tlmediatlpdb->writeout($tlfh);
+        close($tlfh);
+      }
+    }
   }
 }