diff options
author | Norbert Preining <preining@logic.at> | 2008-09-25 06:43:52 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2008-09-25 06:43:52 +0000 |
commit | 4f03af4024357554412cfc7925e668e8365fd5df (patch) | |
tree | b2c65aafede28f7b3c153d3720fea41c0ed2fd62 /Master/texmf | |
parent | 60a7a267a7b1e9179bb3866e4b8e65791ab5b25f (diff) |
safer update for tlmgr (make tar before removing)
git-svn-id: svn://tug.org/texlive/trunk@10720 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/texmf')
-rwxr-xr-x | Master/texmf/scripts/texlive/tlmgr.pl | 96 |
1 files changed, 85 insertions, 11 deletions
diff --git a/Master/texmf/scripts/texlive/tlmgr.pl b/Master/texmf/scripts/texlive/tlmgr.pl index d042b118b9d..def2880ed85 100755 --- a/Master/texmf/scripts/texlive/tlmgr.pl +++ b/Master/texmf/scripts/texlive/tlmgr.pl @@ -259,21 +259,20 @@ sub remove_package { 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: $!"; @@ -302,6 +301,7 @@ sub remove_package { if ($d eq "$pkg.ARCH") { foreach my $a ($localtlpdb->available_architectures) { if (defined($localtlpdb->get_package("$pkg.$a"))) { + debug ("remove $pkg.$a\n"); merge_into(\%ret, &remove_package("$pkg.$a", $localtlpdb, $force)); } @@ -372,6 +372,7 @@ sub action_remove { # 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 +388,7 @@ sub action_remove { 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 +412,7 @@ sub action_remove { 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 @@ -637,6 +640,15 @@ sub action_update { my %ret; init_tlmedia(); my $mediatlpdb = $tlmediasrc->tlpdb; + # these two variables are used throughout this function + my $root = $localtlpdb->root; + my $temp = "$root/temp"; + # + # remove old _BACKUP packages that have piled up in temp + # they can be recognized by their name starting with __BACKUP_ + for my $f (<$temp/__BACKUP_*>) { + unlink($f) unless $opt_dry; + } my @todo; if ($opt_all || $opt_list) { @todo = $localtlpdb->list_packages; @@ -677,6 +689,8 @@ sub action_update { printf STDERR "$0: $pkg not installed locally\n"; next; } + my $unwind_package; + my $remove_unwind_container = 0; my $rev = $tlp->revision; my $mediatlp = $mediatlpdb->get_package($pkg); if (!defined($mediatlp)) { @@ -700,13 +714,14 @@ sub action_update { printf STDERR "backupdir argument must be an existing directory!\n"; } else { my $tlp = $localtlpdb->get_package($pkg); - $tlp->make_container("lzma", $localtlpdb->root, + $tlp->make_container("lzma", $root, $opt_backupdir, "${pkg}.r" . $tlp->revision); + $unwind_package = "$opt_backupdir/${pkg}.r" . $tlp->revision . ".tar.lzma"; } } if (win32() && ($pkg =~ m/$WinSpecialUpdatePackagesRegexp/)) { if (!$updater_started) { - open UPDATER, ">" . $localtlpdb->root . "/tlpkg/installer/updater.bat" + open UPDATER, ">" . $root . "/tlpkg/installer/updater.bat" or die "Cannot create updater.bat: $!"; print UPDATER <<'EOF'; rem update program, can savely removed after it has been done @@ -730,8 +745,6 @@ EOF # so we have to create a update program my $media = $tlmediasrc->media; my $remoteroot = $mediatlpdb->root; - my $root = $localtlpdb->root; - my $temp = "$root/temp"; TeXLive::TLUtils::mkdirhier($temp); if ($media eq 'DVD') { tlwarn ("Creating updater from DVD currently not implemented!\n"); @@ -757,10 +770,63 @@ EOF } } } 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 ($s, $m, $fullname) = $tlp->make_container("tar", $root, $temp, + "__BACKUP_${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 (win32()) { + # win32 is notorious for not releasing a file immediately + # we experienced permission denied errors + my $newname = $unwind_package; + $newname =~ s/__BACKUP/___BACKUP/; + copy ("-f", $unwind_package, $newname); + # try to remove the file if has been created by us + unlink($unwind_package) if $remove_unwind_container; + # and make sure that the temporary file is removed in any case + $remove_unwind_container = 1; + $unwind_package = $newname; + } + my $instret = TeXLive::TLMedia->_install_package("$unwind_package" , [] ,$localtlpdb); + if ($instret) { + # now we have to include the tlpobj + my $tlpobj = TeXLive::TLPOBJ->new; + $tlpobj->from_file($root . "/tlpkg/tlpobj/$pkg.tlpobj"); + $localtlpdb->add_tlpobj($tlpobj); + $localtlpdb->save; + 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"); + } + unlink($unwind_package) if $remove_unwind_container; + } + info("done\n"); } } } elsif ($rev > $mediarev) { @@ -813,6 +879,7 @@ sub action_install { 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 +1043,7 @@ sub action_arch { 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 +1052,11 @@ sub action_arch { } 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 @@ -1072,6 +1143,9 @@ sub init_local_db { if (!defined($location)) { die("No installation source found, nor in the texlive.tlpdb nor on the cmd line.\nPlease specify one!"); } + if ($location =~ m/^ctan$/i) { + $location = "$TeXLive::TLConfig::TeXLiveURL"; + } if ($location !~ m!^(http|ftp)://!i) { # seems to be a local path, try to normalize it my $testloc = abs_path($location); |