From 672ba1882cfdcdf0740fa6cfcf3e02005edec1b6 Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Wed, 29 Oct 2008 01:09:49 +0000 Subject: commit the auto backup feature git-svn-id: svn://tug.org/texlive/trunk@11102 c570f23f-e606-0410-a88d-b1316a301751 --- Master/texmf/scripts/texlive/tlmgr.pl | 332 ++++++++++++++++++++++++++++++---- 1 file changed, 292 insertions(+), 40 deletions(-) (limited to 'Master/texmf/scripts') diff --git a/Master/texmf/scripts/texlive/tlmgr.pl b/Master/texmf/scripts/texlive/tlmgr.pl index 9063e9defe3..ef523703e61 100755 --- a/Master/texmf/scripts/texlive/tlmgr.pl +++ b/Master/texmf/scripts/texlive/tlmgr.pl @@ -22,18 +22,6 @@ # copy of the remote tlpdb # -> if they are equal continue with that # -> if they are unequal try to download the new one -# - backup extensions (email from Manuel) -# tlmgr option backupdir /some/fix/location -# with default TLROOT/backups as default -# In the longer term, I've heard demands for an auto-backup feature. The -# obvious question would be hard disk space. On should probably set -# options such as: -# - never auto-backup (probably the default) -# - keep only N backups per package (typically, one) -# - only keep backups younger than M months (or weeks or) -# - always do backups, let the user clean them up manually -# Possibly, an operation like 'tlmgr clean' for cleaning old backup could -# be great. # - ordering or collections removal (see below for details) # - (?) removal does not remove created format files from TEXMFSYSVAR # - after install/update show the number of bytes transfered @@ -112,7 +100,7 @@ GetOptions("location=s" => \$opt_location, "gui-lang=s" => \$opt_gui_lang, "package-logfile=s" => \$opt_packagelogfile, "version" => \$opt_version, - "pause" => \$opt_pause, + "pause" => \$opt_pause, "h|help|?" => \$opt_help) or pod2usage(2); my $action = shift; @@ -657,9 +645,32 @@ sub action_restore { GetOptions("backupdir=s" => \$opt_backupdir, "n|dry-run" => \$opt_dry, "force" => \$opt_force) or pod2usage(2); - if (!defined($opt_backupdir)) { - die "restore needs --backupdir\n"; + # check the backup dir argument + if ($opt_backupdir) { + my $ob = abs_path($opt_backupdir); + $ob && ($opt_backupdir = $ob); + if (! -d $opt_backupdir) { + tlwarn ("backupdir argument $opt_backupdir is not a directory.\n"); + tlwarn ("Don't know from where to restore backups, terminating.\n"); + exit 1; + } + } else { + # no argument, check for presence in TLPDB + $opt_backupdir = $localtlpdb->option("backupdir"); + if (!$opt_backupdir) { + tlwarn ("Don't know from where to restore backups, terminating.\n"); + exit 1; + } + # we are stil here, there is something set in tlpdb + my $ob = abs_path($opt_backupdir); + $ob && ($opt_backupdir = $ob); + if (! -d $opt_backupdir) { + tlwarn ("backupdir as set in tlpdb $opt_backupdir is not a directory.\n"); + tlwarn ("Don't know from where to restore backups, terminating.\n"); + exit 1; + } } + info("restore: dry run, no changes will be made\n") if $opt_dry; # initialize the hash(packages) of hash(revisions) @@ -731,30 +742,109 @@ sub action_backup { my $opt_dry = 0; my $opt_all = 0; my $opt_backupdir; + # --clean argument + # can be either -1 ... don't clean + # 0 ... remove all backups + # N ... keep only N backups + # that parallels the value of autoclean in the configuration + # we have to be careful, because if simply --clean is given, we should + # check for the value saved in the tlpdb, and if that is not present + # do nothing. But Getopt::Long with clean:i leaves 0 in $opt_clean if + # it is present. So + # !defined($opt_clean) -> no --clean given + # $opt_clean = "" -> --clean without argument given, check tlpdb + # $opt_clean = -1, 0, N -> --clean=N given, check argument + # + my $opt_clean; Getopt::Long::Configure(@getopt_configure_subopts); GetOptions("all" => \$opt_all, "backupdir=s" => \$opt_backupdir, + "clean:s" => \$opt_clean, + "n|dry-run" => \$opt_dry, ) or pod2usage(2); + my $clean_mode = 0; + $clean_mode = 1 if defined($opt_clean); + if ($clean_mode) { + if ($opt_clean eq "") { + # we need to check the tlpdb + $opt_clean = $localtlpdb->option("autobackup"); + if (!$opt_clean) { + tlwarn ("--clean given without an argument, but no default clean\n"); + tlwarn ("mode specified in the tlpdb, terminating.\n"); + exit 1; + } + } + # now $opt_clean is something, but maybe not a number, check for + # validity + if ($opt_clean =~ m/^(-1|[0-9]+)$/) { + # get rid of leading zeros etc etc + $opt_clean = $opt_clean + 0; + } else { + tlwarn ("clean mode as specified on the command line or as given by default\n"); + tlwarn ("must be an integer larger or equal than -1, terminating.\n"); + exit 1; + } + } + # check the backup dir argument + if ($opt_backupdir) { + my $ob = abs_path($opt_backupdir); + $ob && ($opt_backupdir = $ob); + if (! -d $opt_backupdir) { + tlwarn ("backupdir argument $opt_backupdir is not a directory.\n"); + if ($clean_mode) { + tlwarn ("Cannot clean a non existing directory, terminating.\n"); + } else { + tlwarn ("Don't know where to save backups, terminating.\n"); + } + exit 1; + } + } else { + # no argument, check for presence in TLPDB + $opt_backupdir = $localtlpdb->option("backupdir"); + if (!$opt_backupdir) { + if ($clean_mode) { + tlwarn ("Cannot clean an unknown directory, terminating.\n"); + } else { + tlwarn ("Don't know where to save backups, terminating.\n"); + } + exit 1; + } + # we are stil here, there is something set in tlpdb + my $ob = abs_path($opt_backupdir); + $ob && ($opt_backupdir = $ob); + if (! -d $opt_backupdir) { + tlwarn ("backupdir as set in tlpdb $opt_backupdir is not a directory.\n"); + if ($clean_mode) { + tlwarn ("Cannot clean a non existing directory, terminating.\n"); + } else { + tlwarn ("Don't know where to save backups, terminating.\n"); + } + exit 1; + } + } + my %ret; my @todo; - die ("tlmgr backup needs an obligatory argument --backupdir") - unless (defined($opt_backupdir)); if ($opt_all) { @todo = $localtlpdb->list_packages; } else { @todo = @ARGV; + @todo = $localtlpdb->expand_dependencies("-only-arch", $localtlpdb, @todo); } if (!@todo) { printf "tlmgr backup takes either a list of packages or --all\n"; } foreach my $pkg (@todo) { - $opt_backupdir = abs_path($opt_backupdir); - if (! -d $opt_backupdir) { - printf STDERR "backupdir argument must be an existing directory!\n"; + if ($clean_mode) { + clear_old_backups ($pkg, $opt_backupdir, $opt_clean, $opt_dry); } else { my $tlp = $localtlpdb->get_package($pkg); - $tlp->make_container("lzma", $localtlpdb->root, - $opt_backupdir, "${pkg}.r" . $tlp->revision); + info("saving current status of $pkg to $opt_backupdir${pkg}.r" . + $tlp->revision . ".\n"); + if (!$opt_dry) { + $tlp->make_container("lzma", $localtlpdb->root, + $opt_backupdir, "${pkg}.r" . $tlp->revision); + } } } return(\%ret); @@ -928,6 +1018,7 @@ sub action_update { my $opt_list = 0; my $opt_noremove = 0; my $opt_backupdir; + my $opt_backup = 0; Getopt::Long::Configure(@getopt_configure_subopts); GetOptions("no-depends" => \$opt_nodepends, "no-depends-at-all" => \$opt_reallynodepends, @@ -935,6 +1026,7 @@ sub action_update { "list" => \$opt_list, "no-remove" => \$opt_noremove, "backupdir=s" => \$opt_backupdir, + "backup" => \$opt_backup, "n|dry-run" => \$opt_dry) or pod2usage(2); $opt_nodepends = 1 if $opt_reallynodepends; my $nrupdated = 0; @@ -944,6 +1036,70 @@ sub action_update { my $mediatlpdb = $tlmediasrc->tlpdb; info("update: dry run, no changes will be made\n") if $opt_dry; + # do backup dir checking now so that we don't run into troubles + # later, and exit if that doesn't work + if ($opt_backupdir) { + $opt_backupdir = abs_path($opt_backupdir); + if (! -d $opt_backupdir) { + tlwarn("Argument for --backupdir must be an existing directory. Terminating.\n"); + exit 1; + } + } + + my $autobackup = 0; + # check for the tlpdb option autobackup, and if present and true (!= 0) + # assume we are doing backups + if (!$opt_backup) { + $autobackup = $localtlpdb->option("autobackup"); + if ($autobackup) { + # check the format, we currently allow only natural numbers, and -1 + if ($autobackup eq "-1") { + debug ("Automatic backups activated, keeping \\infty backups.\n"); + $opt_backup = 1; + } elsif ($autobackup eq "0") { + debug ("Automatic backups disabled.\n"); + } elsif ($autobackup =~ m/^[0-9]+$/) { + debug ("Automatic backups activated, keeping $autobackup backups.\n"); + $opt_backup = 1; + } else { + tlwarn ("Option autobackup can only be an integer >= -1.\n"); + tlwarn ("Disabling auto backups.\n"); + $localtlpdb->option("autobackup", 0); + $autobackup = 0; + } + } + } + + # cmd line --backup, we check for --backupdir, and if that is not given + # we try to get the default from the tlpdb. If that doesn't work, exit. + if ($opt_backup) { + my $diebackupdir = 0; + if (!$opt_backupdir) { + $opt_backupdir = $localtlpdb->option("backupdir"); + if ($opt_backupdir) { + # check again: + $opt_backupdir = abs_path($opt_backupdir); + $diebackupdir = 1 if (! -d $opt_backupdir); + } else { + # not set in the tlpdb, and not set on cmd line, but asked for + # --backup + $diebackupdir = 1; + } + } + # no else branch necessary, we already checked that --backupdir if + # given is ok, see above + if ($diebackupdir) { + tlwarn("You have asked for backups, but the backup directory as specified\n"); + tlwarn("in the local TLPDB or the cmd line does not exists, exiting.\n"); + exit 1; + } + } + + # finally, if we have --backupdir, but no --backup, just enable it + $opt_backup = 1 if $opt_backupdir; + + debug("Doing backups to $opt_backupdir\n") if $opt_backup; + # these two variables are used throughout this function my $root = $localtlpdb->root; my $temp = "$root/temp"; @@ -1122,19 +1278,18 @@ sub action_update { if ($opt_list) { info("$pkg: local: $rev, source: $mediarev\n"); } else { - # first remove the package, then reinstall it - # this way we get rid of useless files - # force the deinstallation since we will reinstall it - if ($opt_backupdir && !$opt_dry) { - $opt_backupdir = abs_path($opt_backupdir); - if (! -d $opt_backupdir) { - tlwarn("backupdir argument must be an existing directory!\n"); - } else { - $tlp->make_container("lzma", $root, - $opt_backupdir, "${pkg}.r" . $tlp->revision); - $unwind_package = "$opt_backupdir/${pkg}.r" . $tlp->revision . ".tar.lzma"; + if ($opt_backup && !$opt_dry) { + $tlp->make_container("lzma", $root, + $opt_backupdir, "${pkg}.r" . $tlp->revision); + $unwind_package = + "$opt_backupdir/${pkg}.r" . $tlp->revision . ".tar.lzma"; + + if ($autobackup) { + # in case we do auto backups we remove older backups + clear_old_backups($pkg, $opt_backupdir, $autobackup); } } + if (win32() && ($pkg =~ m/$WinSpecialUpdatePackagesRegexp/)) { add_w32_updater($mediatlp, $opt_dry); } else { @@ -1161,6 +1316,10 @@ sub action_update { $remove_unwind_container = 1; $unwind_package = "$fullname"; } + # first remove the package, then reinstall it + # this way we get rid of useless files + # force the deinstallation since we will reinstall it + # # 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)); @@ -1176,7 +1335,7 @@ sub action_update { # dirs from the new package before re-installing the old one. # TODO logpackage("failed update: $pkg ($rev -> $mediarev)"); - tlwarn("\n\nInstallation of new version of $pkg did fail, trying to unwind!\n"); + tlwarn("\n\nInstallation of new version of $pkg did fail, trying to unwind.\n"); if (win32()) { # w32 is notorious for not releasing a file immediately # we experienced permission denied errors @@ -1402,7 +1561,15 @@ sub action_option { print "Install documentation files: ", ($localtlpdb->option_install_docfiles ? "yes": "no"), "\n"; print "Install source files: ", ($localtlpdb->option_install_srcfiles ? "yes": "no"), "\n"; } else { - warn "Setting other options currently not supported, please edit texlive.tlpdb!"; + my $val = shift @ARGV; + if (defined($val)) { + print "Setting option $what to $val.\n"; + $localtlpdb->option($what,$val); + $localtlpdb->save; + } else { + print "Option $what = ", $localtlpdb->option($what), "\n";; + } + #warn "Setting other options currently not supported, please edit texlive.tlpdb!"; } return; } @@ -1961,6 +2128,37 @@ sub finish { } +# clear the backup dir for $pkg and keep only $autobackup packages +# mind that with $autobackup == 0 all packages are cleared +sub clear_old_backups +{ + my ($pkg, $opt_backupdir, $autobackup, $opt_dry) = @_; + + my $dryrun = 0; + $dryrun = 1 if ($opt_dry); + # keep arbitrary many backups + return if ($autobackup == -1); + + opendir (DIR, $opt_backupdir) || die "opendir($opt_backupdir) failed: $!"; + my @dirents = readdir (DIR); + closedir (DIR) || warn "closedir($opt_backupdir) failed: $!"; + my @backups; + for my $dirent (@dirents) { + next if (-d $dirent); + next if ($dirent !~ m/^$pkg\.r([0-9]+)\.tar\.lzma$/); + push @backups, $1; + } + my $i = 1; + for my $e (reverse sort {$a <=> $b} @backups) { + if ($i > $autobackup) { + info ("Removing backup $opt_backupdir/$pkg.r$e.tar.lzma\n"); + unlink("$opt_backupdir/$pkg.r$e.tar.lzma") unless $dryrun; + } + $i++; + } +} + + # # return all the directories from which all content will be removed # @@ -2194,7 +2392,21 @@ Under normal circumstances tlmgr tries to remove packages which have disappeared on the server when called with C<--all>, as described above. This prevents any such removals. -=item B<--backupdir> I +=item B<--backup> and B<--backupdir> I + +These options control the creation of backups of packages before +an update is started. If none of the two are given, no backup package +will be saved. If B<--backupdir> is given specifying a (writable) +directory then a back up will be made in that location. If only +B<--backup> is given then the location for the backups has to be +set in the tlpdb via the B