safer update, creating tar file, remove package, install new, unwind if problems

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

1 files changed, 278 insertions, 150 deletions

diff --git a/Master/tlpkg/etc/safer-update.diff b/Master/tlpkg/etc/safer-update.diff
index c93fdc64b72..25e7102bc71 100644
--- a/Master/tlpkg/etc/safer-update.diff
+++ b/Master/tlpkg/etc/safer-update.diff
@@ -1,152 +1,6 @@
-Index: texmf/scripts/texlive/tlmgr.pl
-===================================================================
---- texmf/scripts/texlive/tlmgr.pl	(revision 10623)
-+++ texmf/scripts/texlive/tlmgr.pl	(working copy)
-@@ -550,15 +550,44 @@
-     print "Restoring $pkg, $rev from $opt_backupdir/${pkg}.r${rev}.tar.lzma\n";
-     if (!$opt_dry) {
-       init_local_db(1);
--      # first remove the package, then reinstall it
--      # this way we get rid of useless files
--      # force the deinstallation since we will reinstall it
-+      # get the files of the current package
-+      my $tlp = $localtlpdb->get_package($pkg);
-+      my @oldfiles;
-+      my @newfiles;
-+      if (!defined($tlp)) {
-+        @oldfiles = ();
-+      } else {
-+        @oldfiles = $tlp->all_files;
-+      }
-+      # install the backup package
-       $opt_backupdir = abs_path($opt_backupdir);
--      merge_into(\%ret, &remove_package($pkg, $localtlpdb, 1));
-       TeXLive::TLMedia->_install_package("$opt_backupdir/${pkg}.r${rev}.tar.lzma" , [] ,$localtlpdb);
-       # now we have to read the .tlpobj file and add it to the DB
-       my $tlpobj = TeXLive::TLPOBJ->new;
-       $tlpobj->from_file($localtlpdb->root . "/tlpkg/tlpobj/$pkg.tlpobj");
-+      @newfiles = $tlpobj->all_files;
-+      my %removefiles = ();
-+      # we create an array with key of all the old files, and then
-+      # remove all key/value pairs for files occurring in the new 
-+      # files list. The remaining files should be removed.
-+      for my $f (@oldfiles) {
-+        $removefiles{$f} = 1;
-+      }
-+      for my $f (@newfiles) {
-+        delete $removefiles{$f};
-+      }
-+      # we have to chdir to $localtlpdb->root
-+      my $Master = $localtlpdb->root;
-+      chdir ($Master) || die "chdir($Master) failed: $!";
-+      my @files = keys %removefiles;
-+      my @removals = &removed_dirs (@files);
-+      foreach my $entry (@files) {
-+        unlink $entry;
-+      }
-+      foreach my $entry (@removals) {
-+        rmdir $entry;
-+      }
-+      # add the new tlpobj, overwriting the old one
-       $localtlpdb->add_tlpobj($tlpobj);
-       $ret = $localtlpdb->get_package($pkg)->make_return_hash_from_executes("enable");
-       $localtlpdb->save;
-@@ -664,6 +693,7 @@
-       printf STDERR "$0: cannot find package $pkg\n";
-       next;
-     }
-+    my $unwind_package;
-     my $rev = $tlp->revision;
-     my $mediatlp = $mediatlpdb->get_package($pkg);
-     if (!defined($mediatlp)) {
-@@ -689,6 +719,7 @@
-             my $tlp = $localtlpdb->get_package($pkg);
-             $tlp->make_container("lzma", $localtlpdb->root, 
-                                  $opt_backupdir, "${pkg}.r" . $tlp->revision);
-+            $unwind_package = "$opt_backupdir/${pkg}.r" . $tlp->revision " . ".tar.lzma";
-           }
-         }
-         if (win32() && ($pkg =~ m/$WinSpecialUpdatePackagesRegexp/)) {
-@@ -744,10 +775,45 @@
-             }
-           }
-         } else {
--          print "update: $pkg (first remove old, then install new)\n";
--          merge_into(\%ret, &remove_package($pkg, $localtlpdb, 1));
-+          print "update: $pkg (install new ... ";
-+          # we have to be careful here. If we remove the package and
-+          # later the install_package call which downloads fails, then
-+          # we are in a rather bad shape ...
-+          #
-+          # We will create a list of currently contained files, and a
-+          # list of files in the newer version, and do first install
-+          # the new version, and if that succeeded, we will remove the
-+          # files that are not present anymore in the package
-+          my @oldfiles = $tlp->all_files;
-+          my @newfiles = $mediatlp->all_files;
-+          my %removefiles = ();
-+          # we create an array with key of all the old files, and then
-+          # remove all key/value pairs for files occurring in the new 
-+          # files list. The remaining files should be removed.
-+          for my $f (@oldfiles) {
-+            $removefiles{$f} = 1;
-+          }
-+          for my $f (@newfiles) {
-+            delete $removefiles{$f};
-+          }
-           merge_into(\%ret, $tlmediasrc->install_package($pkg, $localtlpdb, $opt_nodepends, 0));
--          print "update: $pkg done\n";
-+          # If we are still here, then that means that the installation
-+          # has succeeded, because $tlmediasrc->_install_package dies
-+          # in case of download/un-lzma/untar problems
-+          #
-+          print "remove old files ... ";
-+          # we have to chdir to $localtlpdb->root
-+          my $Master = $localtlpdb->root;
-+          chdir ($Master) || die "chdir($Master) failed: $!";
-+          my @files = keys %removefiles;
-+          my @removals = &removed_dirs (@files);
-+          foreach my $entry (@files) {
-+            unlink $entry;
-+          }
-+          foreach my $entry (@removals) {
-+            rmdir $entry;
-+          }
-+          print "done)\n";
-         }
-       }
-     } elsif ($rev > $mediarev) {
-@@ -800,6 +866,7 @@
-       print "install: $pkg\n";
-     } else {
-       # install the packages and run postinstall actions (that is the 0)
-+      info("install: $pkg\n");
-       merge_into(\%ret, $tlmediasrc->install_package($pkg, $localtlpdb, $opt_nodepends, 0));
-     }
-   }
-@@ -963,6 +1030,7 @@
-             if ($opt_dry) {
-               print "Installing $pkg.$a\n";
-             } else {
-+              info("install: $pkg.$a\n");
-               merge_into(\%ret, $tlmediasrc->install_package("$pkg.$a", $localtlpdb, 0, 0));
-             }
-           }
-@@ -971,8 +1039,11 @@
-     }
-     if (TeXLive::TLUtils::member('win32', @todoarchs)) {
-       # install the necessary win32 stuff
-+      info("install: bin-tlperl.win32\n");
-       merge_into (\%ret, $tlmediasrc->install_package("bin-tlperl.win32", $localtlpdb, 1, 0));
-+      info("install: bin-tlgs.win32\n");
-       merge_into (\%ret, $tlmediasrc->install_package("bin-tlgs.win32", $localtlpdb, 1, 0));
-+      info("install: bin-tlpsv.win32\n");
-       merge_into (\%ret, $tlmediasrc->install_package("bin-tlpsv.win32", $localtlpdb, 1, 0));
-     }
-     # update the option_archs list of installed archs
 Index: tlpkg/TeXLive/TLPOBJ.pm
 ===================================================================
---- tlpkg/TeXLive/TLPOBJ.pm	(revision 10611)
+--- tlpkg/TeXLive/TLPOBJ.pm	(revision 10633)
 +++ tlpkg/TeXLive/TLPOBJ.pm	(working copy)
 @@ -512,8 +512,8 @@
  
@@ -190,7 +44,7 @@ Index: tlpkg/TeXLive/TLPOBJ.pm
    }
    my @cmdline = ($tar, "--owner", "0", "--group", "0", "-c", "-f", "$destdir/$tarname", "--files-from=-");
    unlink("$destdir/$containername");
-@@ -603,14 +610,16 @@
+@@ -603,20 +610,23 @@
      }
    } @files;
    close ZIP;
@@ -203,6 +57,7 @@ Index: tlpkg/TeXLive/TLPOBJ.pm
 +      system($lzma, "--force", "-z", "$destdir/$tarname");
 +    } else {
 +      tlwarn("Couldn't find $destdir/$tarname\n");
++      return(0,0,"");
 +    }
    }
    # compute the size
@@ -213,11 +68,35 @@ Index: tlpkg/TeXLive/TLPOBJ.pm
    # cleaning up
    unlink("$tlpobjdir/$self->{'name'}.tlpobj");
    rmdir("$tlpobjdir") if $removetlpobjdir;
+   chdir($cwd);
+   ddebug("Done $containername\n");
+-  return($size,$m);
++  return($size,$m,"$destdir/$containername");
+ }
+ 
+ 
+@@ -1288,6 +1298,7 @@
+ This is used to distribute packages which can be installed in any arbitrary
+ texmf tree (of other distributions, too).
+ 
++Return values are the size, the md5sum, and the full name of the container.
+ 
+ =item C<recompute_sizes($tltree)>
+ 
 Index: tlpkg/TeXLive/TLMedia.pm
 ===================================================================
---- tlpkg/TeXLive/TLMedia.pm	(revision 10611)
+--- tlpkg/TeXLive/TLMedia.pm	(revision 10633)
 +++ tlpkg/TeXLive/TLMedia.pm	(working copy)
-@@ -117,7 +117,6 @@
+@@ -86,6 +86,8 @@
+ }
+ 
+ #
++# returns a scalar (0) on error
++# returns a reference to a hash with actions on success
+ sub install_package {
+   my ($self, $pkg, $totlpdb, $nodepends, $nopostinstall, $fallbackmedia) = @_;
+   my $fromtlpdb = $self->tlpdb;
+@@ -117,7 +119,6 @@
        # even if opt_doc is false
        $real_opt_doc = 1;
      }
@@ -225,3 +104,252 @@ Index: tlpkg/TeXLive/TLMedia.pm
      foreach my $h (@::install_packages_hook) {
        &$h("install: $package");
      }
+@@ -160,7 +161,7 @@
+     } elsif (&media eq 'NET') {
+       $container = "$location/$Archive/$pkg.$DefaultContainerExtension";
+     }
+-    $self->_install_package($container,\@installfiles,$totlpdb);
++    $self->_install_package($container,\@installfiles,$totlpdb) || return(0);
+     # if we are installing from CD or NET we have to fetch the respective
+     # source and doc packages $pkg.source and $pkg.doc and install them, too
+     if (($media eq 'NET') || ($media eq 'CD')) {
+@@ -173,13 +174,13 @@
+           ($pkg !~ m/\./) && $tlpobj->srcfiles) {
+         my $srccontainer = $container;
+         $srccontainer =~ s/(\.tar\.lzma|\.zip)$/.source$1/;
+-        $self->_install_package($srccontainer,\@installfiles,$totlpdb);
++        $self->_install_package($srccontainer,\@installfiles,$totlpdb) || return(0);
+       }
+       if ($container_doc_split && $real_opt_doc &&
+           ($pkg !~ m/\./) && $tlpobj->docfiles) {
+         my $doccontainer = $container;
+         $doccontainer =~ s/(\.tar\.lzma|\.zip)$/.doc$1/;
+-        $self->_install_package($doccontainer,\@installfiles,$totlpdb);
++        $self->_install_package($doccontainer,\@installfiles,$totlpdb) || return(0);
+       }
+     }
+     # we don't want to have wrong information in the tlpdb, so remove the
+@@ -245,6 +246,11 @@
+   }
+ }
+ 
++#
++# _install_package
++# actually does the installation work
++# returns 1 on success and 0 on error
++#
+ sub _install_package {
+   my ($self, $what, $filelistref, $totlpdb) = @_;
+ 
+@@ -258,7 +264,8 @@
+   my $lzmadec = $::progs{'lzmadec'};
+   my $tar = $::progs{'tar'};
+   if (!defined($wget) || !defined($lzmadec) || !defined($tar)) {
+-    die "Programs have not been set up properly, strange!";
++    tlwarn("Programs have not been set up properly, strange!\n");
++    return(0);
+   }
+ 
+   if (ref $what) {
+@@ -296,7 +303,9 @@
+       # 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!";
++        tlwarn("Downloading $what did not succeed, please retry!\n");
++        unlink($tarfile, $lzmafile);
++        return(0);
+       }
+     } else {
+       # we are installing from CD
+@@ -306,13 +315,22 @@
+     debug("Un-lzmaing $lzmafile to $tarfile\n");
+     system("$lzmadec < $lzmafile_quote > $tarfile_quote");
+     if (! -f $tarfile) {
+-      die "Unpacking $lzmafile did not succeed, please retry!";
++      tlwarn("Unpacking $lzmafile did not succeed, please retry!\n");
++      unlink($tarfile, $lzmafile);
++      return(0);
+     }
+     debug("Unpacking $tarfile\n");
+-    system($tar,"-x","-C",$target,"-f",$tarfile);
++    if (system($tar,"-x","-C",$target,"-f",$tarfile) != 0) {
++      tlwarn("Untarring $tarfile did not succeed, please retry!\n");
++      unlink($tarfile, $lzmafile);
++      return(0);
++    }
++    # we are still here, so success!
+     unlink($tarfile, $lzmafile);
++    return(1);
+   } else {
+-    die "Don't know how to install $what!\n";
++    tlwarn("Don't know how to install $what!\n");
++    return(0);
+   }
+ }
+ 
+Index: texmf/scripts/texlive/tlmgr.pl
+===================================================================
+--- texmf/scripts/texlive/tlmgr.pl	(revision 10633)
++++ texmf/scripts/texlive/tlmgr.pl	(working copy)
+@@ -259,21 +259,20 @@
+   my $tlp = $localtlpdb->get_package($pkg);
+   my %ret;
+   if (!defined($tlp)) {
+-    print "Package $pkg not present, cannot remove it!\n";
++    tlwarn ("Package $pkg not present, cannot remove it!\n");
+   } else {
+     if (!$force) {
+       # do some checking
+       my @needed = $localtlpdb->needed_by($pkg);
+       if (@needed) {
+-        print "$pkg: not removed, referenced in @needed\n";
++        tlwarn  ("$pkg: not removed, referenced in @needed\n");
+         return;
+       }
+     }
+     if ($pkg =~ m/^texlive\.infra/) {
+-      log("Not removing $pkg, it is essential!\n");
++      log ("Not removing $pkg, it is essential!\n");
+       return;
+     }
+-    print "remove: $pkg\n";
+     # we have to chdir to $localtlpdb->root
+     my $Master = $localtlpdb->root;
+     chdir ($Master) || die "chdir($Master) failed: $!";
+@@ -294,6 +293,7 @@
+     foreach my $entry (@removals) {
+       rmdir $entry;
+     }
++    info ("remove $pkg\n");
+     $localtlpdb->remove_package($pkg);
+     merge_into(\%ret, $tlp->make_return_hash_from_executes("disable"));
+     $ret{'mktexlsr'} = 1;
+@@ -302,6 +302,7 @@
+       if ($d eq "$pkg.ARCH") {
+         foreach my $a ($localtlpdb->available_architectures) {
+           if (defined($localtlpdb->get_package("$pkg.$a"))) {
++            info ("remove $pkg.$a\n");
+             merge_into(\%ret,
+                        &remove_package("$pkg.$a", $localtlpdb, $force));
+           }
+@@ -372,6 +373,7 @@
+           # the rest will not be run in dry_run mode
+           $foo{'mktexlsr'} = 1;
+         } else {
++          info ("remove $pkg\n");
+           merge_into(\%foo, &remove_package($pkg, $localtlpdb, $opt_force));
+         }
+         if (keys %foo) {
+@@ -387,6 +389,7 @@
+                   if ($opt_dry) {
+                     print "remove: $d\n";
+                   } else {
++                    info ("remove $d\n");
+                     merge_into(\%ret, &remove_package($d, $localtlpdb, $opt_force));
+                   }
+                   $already_removed{$d} = 1;
+@@ -410,6 +413,7 @@
+         print "remove: $pkg\n";
+       } else {
+         my %foo;
++        info ("remove $pkg\n");
+         merge_into(\%foo, &remove_package($pkg, $localtlpdb, $opt_force));
+         if (keys %foo) {
+           # removal was successful
+@@ -677,6 +681,8 @@
+       printf STDERR "$0: cannot find package $pkg\n";
+       next;
+     }
++    my $unwind_package;
++    my $remove_unwind_container = 0;
+     my $rev = $tlp->revision;
+     my $mediatlp = $mediatlpdb->get_package($pkg);
+     if (!defined($mediatlp)) {
+@@ -702,6 +708,7 @@
+             my $tlp = $localtlpdb->get_package($pkg);
+             $tlp->make_container("lzma", $localtlpdb->root, 
+                                  $opt_backupdir, "${pkg}.r" . $tlp->revision);
++            $unwind_package = "$opt_backupdir/${pkg}.r" . $tlp->revision . ".tar.lzma";
+           }
+         }
+         if (win32() && ($pkg =~ m/$WinSpecialUpdatePackagesRegexp/)) {
+@@ -757,10 +764,47 @@
+             }
+           }
+         } else {
+-          print "update: $pkg (first remove old, then install new)\n";
++          info("update: $pkg ... ");
++          if (!$unwind_package) {
++            # no backup was made, so let us create a temporary .tar file
++            # of the package
++            my $tlp = $localtlpdb->get_package($pkg);
++            my $root = $localtlpdb->root;
++            my $temp = "$root/temp";
++            my ($s, $m, $fullname) = $tlp->make_container("tar", $root, $temp, 
++                                          "${pkg}.r" . $tlp->revision);
++            if ($s <= 0) {
++              tlwarn("\nCreation of backup container of $pkg didn't succeed\n");
++              tlwarn("I will not continue, either retry or call update --force\n");
++              tlwarn("Exiting!\n");
++              exit(1);
++            }
++            $remove_unwind_container = 1;
++            $unwind_package = "$fullname";
++          }
++          # the remove_package should also remove empty dirs in case
++          # a dir is changed into a file
+           merge_into(\%ret, &remove_package($pkg, $localtlpdb, 1));
+-          merge_into(\%ret, $tlmediasrc->install_package($pkg, $localtlpdb, $opt_nodepends, 0));
+-          print "update: $pkg done\n";
++          my $foo = $tlmediasrc->install_package($pkg, $localtlpdb, $opt_nodepends, 0);
++          if (ref $foo) {
++            # installation succeeded because we got a reference
++            merge_into (\%ret, $foo);
++            unlink($unwind_package) if $remove_unwind_container;
++          } else {
++            # install_package returned a scalare, so error!
++            # now in fact we should do some cleanup, removing files and
++            # dirs from the new package before re-installing the old one!!!
++            # TODO
++            tlwarn("\n\nInstallation of new version of $pkg did fail, trying to unwind!\n");
++            if (TeXLive::TLMedia->_install_package("$unwind_package" , [] ,$localtlpdb)) {
++              tlwarn("Restoring old package state succeeded.\n");
++            } else {
++              tlwarn("Restoring of old package did NOT succeed!\n");
++              tlwarn("Best is to call tlmgr install $pkg and hope to get it right!\n");
++              tlwarn("TODO TODO restoring of the tlpobj???\n");
++            }
++          }
++          info("done\n");
+         }
+       }
+     } elsif ($rev > $mediarev) {
+@@ -813,6 +857,7 @@
+       print "install: $pkg\n";
+     } else {
+       # install the packages and run postinstall actions (that is the 0)
++      info("install: $pkg\n");
+       merge_into(\%ret, $tlmediasrc->install_package($pkg, $localtlpdb, $opt_nodepends, 0));
+     }
+   }
+@@ -976,6 +1021,7 @@
+             if ($opt_dry) {
+               print "Installing $pkg.$a\n";
+             } else {
++              info("install: $pkg.$a\n");
+               merge_into(\%ret, $tlmediasrc->install_package("$pkg.$a", $localtlpdb, 0, 0));
+             }
+           }
+@@ -984,8 +1030,11 @@
+     }
+     if (TeXLive::TLUtils::member('win32', @todoarchs)) {
+       # install the necessary win32 stuff
++      info("install: bin-tlperl.win32\n");
+       merge_into (\%ret, $tlmediasrc->install_package("bin-tlperl.win32", $localtlpdb, 1, 0));
++      info("install: bin-tlgs.win32\n");
+       merge_into (\%ret, $tlmediasrc->install_package("bin-tlgs.win32", $localtlpdb, 1, 0));
++      info("install: bin-tlpsv.win32\n");
+       merge_into (\%ret, $tlmediasrc->install_package("bin-tlpsv.win32", $localtlpdb, 1, 0));
+     }
+     # update the option_archs list of installed archs