versioned .tar.xz containers for the tlnet repository

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

1 files changed, 78 insertions, 7 deletions

diff --git a/Master/tlpkg/bin/tl-update-containers b/Master/tlpkg/bin/tl-update-containers
index b42ff669e41..4cb41812038 100755
--- a/Master/tlpkg/bin/tl-update-containers
+++ b/Master/tlpkg/bin/tl-update-containers
@@ -241,12 +241,18 @@ sub main {
   # get list of packages.
   PACKS: for my $pkg (sort @todopacks) {
     next if $pkg =~ /00texlive/;
+    # we make links from unversioned to versioned containers; this
+    # variable is an override for debugging:
+    my $copy_instead_of_link = 0;
+    #
     foreach my $manualpkgre (@TeXLive::TLConfig::CriticalPackagesList) {
       # we match the initial string of the package name, so that all the
       # .arch packages are skipped, too
       if ($pkg =~ m/^$manualpkgre/) {
         if ($opt_all || $opt_recreate) {
           tlwarn("$0: Updating critical $pkg due to -all\n");
+          # in general, we want links for everything, but for testing maybe:
+          #$copy_instead_of_link = 1;
           last; # of the manualpkgre checks
 
         } else {
@@ -299,7 +305,11 @@ sub main {
         $objcopy->clear_srcfiles;
         if ($objsrc) {
           my ($s,$m) = $objsrc->make_container($type, $Master,
-                               $opt_containerdir, "$pkg.source", $do_relative);
+                                               destdir => $opt_containerdir,
+                                               containername => "$pkg.source", 
+                                               relative => $do_relative,
+                                               user => 0,
+                                copy_instead_of_link => $copy_instead_of_link);
           if ($s > 0) {
             # something was created 
             # important, we have to add it to the original $obj
@@ -323,7 +333,11 @@ sub main {
         $objcopy->clear_docfiles;
         if ($objdoc) {
           my ($s,$m) = $objdoc->make_container($type, $Master,
-                                 $opt_containerdir, "$pkg.doc", $do_relative);
+                                               destdir => $opt_containerdir,
+                                               containername => "$pkg.doc", 
+                                               relative => $do_relative,
+                                               user => 0,
+                                copy_instead_of_link => $copy_instead_of_link);
           if ($s > 0) {
             # something was created
             $obj->doccontainersize($s);
@@ -341,8 +355,12 @@ sub main {
       push @removecontainers, "$pkg.doc";
     }
     if (!$opt_dry) {
-      my ($s,$m) = $objcopy->make_container($type, $Master, $opt_containerdir,
-                                            $pkg, $do_relative);
+      my ($s,$m) = $objcopy->make_container($type, $Master,
+                                            destdir => $opt_containerdir,
+                                            containername => $pkg, 
+                                            relative => $do_relative,
+                                            user => 0,
+                                copy_instead_of_link => $copy_instead_of_link);
       if ($s > 0) {
         $obj->containersize($s);
       }
@@ -357,9 +375,9 @@ sub main {
     # add the updated (or new) TLPOBJ to NET TLPDB
     # that way the other container sizes are not destroyed
     $nettlpdb->add_tlpobj($obj) unless $opt_dry;
-  }
+  } # end of big loop on all todopacks
 
-  # remove old containers
+  # remove source/doc containers that have become obsolete.
   for my $op (@removecontainers) {
     if (-r "$opt_containerdir/$op.tar.xz") {
       info("$0: $op container is old, removing it\n");
@@ -392,6 +410,9 @@ sub main {
     $count{"removed"}++;
   }
 
+  # remove non-symlinked .rNNN files.
+  &rcheck_containerdir ($opt_containerdir);
+  
   if ($opt_recreate) {
     info("$0: all packages recreated.\n");
   } else {
@@ -400,7 +421,7 @@ sub main {
       info("$0: $count{new} new, $count{removed} removed, " .
             "$count{updated} updated, $count{unchanged} unchanged.\n");
     } else {
-      info("$0: nothing to be done.\n");
+      info("$0: no containers to be updated.\n");
     }
   }
 
@@ -438,6 +459,56 @@ sub main {
   return 0;
 }
 
+
+# With versioned containers, we have to remove older .rNNN tarballs when
+# a new NNN gets made and symlinked. Otherwise we'd be distributing
+# every version of every package.
+# 
+# That is, if we previously had foo.tar.xz -> foo.r500.tar.xz,
+# but now we've just created foo.r501.tar.xz (and updated the symlink).
+# so we need to delete the .r500.
+# 
+# We do this purely by looking at the contents of DIR: every file
+# whose name has a .rNNN pattern is checked for a corresponding symlink,
+# and if no symlink, it is deleted.
+# 
+# There should be no stray files with other names, so we report them if
+# we find them, but do nothing with them.
+# 
+sub rcheck_containerdir {
+  my ($dir) = @_;
+  
+  opendir (my $dh, $dir) || die "opendir($dir) failed: $!";
+  for my $fname (sort readdir $dh) {
+    if ($fname =~ /(.*)\.r[0-9]+\./) {
+      my $linkname = "$dir/$1.tar.xz";
+      if (-l $linkname) {
+        my $linktarget = readlink ($linkname);
+        if ($linktarget ne $fname) {
+          if ($opt_dry) {
+            print "would unlink($fname) [because have $linktarget]\n";
+          } else {
+            debug("unlinking $dir/$fname [because have $linktarget]\n");
+            unlink("$dir/$fname")
+            || tlwarn("$0: non-symlinked unlink($dir/$fname) failed: $!");
+          }
+        } # (else it's the current version, do nothing.)
+      } else {
+        # this can happen if we accidentally created unlinked containers.
+        tlwarn("$0: have file $fname, but no link $linkname!\n");
+      }
+    } elsif ($fname =~ /^([^.]+(\.[^.]+)*\.tar\.xz|\.\.?)$/) {
+      ; # unversioned name, ok. Either . or .. or
+        # matching PKGNAME[.SUBPKG]*.tar.xz, where .SUBPKG might
+        # be .doc, .source, .x86_64-linux, etc., or
+        # .infra.x86_64-linux (for texlive.infra), win32.doc (for wintools).
+    } else {
+      tlwarn("$0: unexpected file: $fname (in $dir)\n");
+    }
+  }
+  closedir ($dh) || warn "closedir($dir) failed: $!";
+}
+
 __END__
 
 =head1 NAME