summaryrefslogtreecommitdiff
path: root/Master/tlpkg/etc
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2008-09-18 11:07:14 +0000
committerNorbert Preining <preining@logic.at>2008-09-18 11:07:14 +0000
commitd694b2b295e61686087c8744f8da6e185dac1568 (patch)
tree9cad786093ed25780f0e8b3b00c54deba806c61c /Master/tlpkg/etc
parent2eed5f340735785e1fd5301e0c229d0e19ecff19 (diff)
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
Diffstat (limited to 'Master/tlpkg/etc')
-rw-r--r--Master/tlpkg/etc/safer-update.diff428
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