A couple of caveats that I thought of after I hit the "return"...
1. Assuming that the logic of attrib entries (and type=10), hasn't
changed, this should be backward compatible with earlier versions of
BackupPC (I am using 3.1.0)
2. The program does *not* adjust the backupInfo files so if you delete
something then the sizes and numbers of files mentioned in backupInfo
will be wrong. Correcting this is not even fully possible, since it
would be hard if not impossible to recover some of the entries.
3. I left out one important additional option flag and accompanying
line snippets (I mistakenly appended a slightly earlier version).
This is the option to run BackupPC_nightly after delete is
completed if you are not patient enough to wait for the disk space
to clear.
Note: other than running BackupPC_nightly, my script doesn't touch
the pool (which is a GOOD thing) and allows BackupPC_nightly to
come along and actually remove the final inode link that will free
up space -- but you may be impatient for the disk space... or for
results...
Here is the updated version: (sorry for messing up the first time)
----------------------------------------------------------------------------------------
#!/usr/bin/perl
use strict;
use File::Path;
use lib "/usr/share/BackupPC/lib";
use BackupPC::Lib;
use BackupPC::Attrib qw(:all);
use BackupPC::FileZIO;
use Getopt::Std;
use Data::Dumper; #Just used for debugging...
my $DEBUG=''; #Overrides debug option if set to non-empty ''
die("BackupPC::Lib->new failed\n") if ( !(my $bpc = BackupPC::Lib->new) );
my $TopDir = $bpc->TopDir();
(my $root = "$TopDir/pc") =~ s|//*|/|g;
my %Conf = $bpc->Conf();
my $attrib = BackupPC::Attrib->new({ compress => $Conf{CompressLevel} });
my %opts;
if ( !getopts("h:n:s:rmfqtcd:", \%opts) || @ARGV < 1 ) {
print STDERR <<EOF;
usage: $0 [options] files/directories...
Required options:
-h host Host (or - for all) from which path is offset
-n backupNum Full backup number (or - for all) from which path is offset
WARNING: this will also delete the file/directory from all
subsequent incrementals
Optional options:
-s shareName Share name (or - for all) from which path is offset
-r Allow directories to be removed too
-m Paths are unmangled (i.e. apply mangle to paths)
-f Force children to be removed even if changes from file
to directory (or vica-versa)
-q Don\'t show deletions
-t Trial run -- do everything but deletions
-c Clean pool - schedule BackupPC_nightly to run (requires
server running)
-d level Turn on debug level (if undefined in code)
EOF
exit(1);
}
if ( $opts{h} !~ /^([\w\.\s-]+)$/
|| $opts{h} =~ m{(^|/)\.\.(/|$)} ) {
print(STDERR "$0: bad host name '$opts{h}'\n");
exit(1);
}
my $host = my $hostregex = $opts{h};
if ( $opts{n} !~ /^(-|\d+)$/ ) {
print(STDERR "$0: bad dump number '$opts{n}'\n");
exit(1);
}
my $num = my $numregex = $opts{n};
my $share = my $shareregex = $opts{s};
my $mangle = $opts{m};
my $force = $opts{f};
my $rmdir = $opts{r};
my $quiet = $opts{q};
my $dryrun = $opts{t};
my $runnightly = $opts{r};
($DEBUG eq '') && ($DEBUG=$opts{d});
#$DEBUG && ($dryrun=1); #Uncomment if you want DEBUG to imply dry run
$dryrun=1; #JJK: Temporarily set to always dry-run (paranoia)
($hostregex eq '-' ) && ($hostregex = "[^/]+");
($numregex eq '-' ) && ($numregex = "[0-9]+");
if ($shareregex eq '-' || $shareregex eq '') {$shareregex = "f[^/]+";}
(my $findpath = "$hostregex/$numregex/$shareregex") =~ s|//*|/|g;
my @branches = `find $root -maxdepth 3 -regex \"$root/$findpath\"`;
chop(@branches); #Note you could do this in native perl using preprocess but
it is messy
my @Ante = my @Post =();
if ($num ne '-') {
if ($host eq '-') {
die "Error: wildcard for host requires wilcard for backupNum\n";
}
else {
(-d "$root/$host/$num") || die "Error: Backup $num on host
'$host' doesn't exist\n";
find_backup_heirarchy("$root/$host", $num, \@Ante, \@Post);
#These are the backups with lower and higher incremental
numbers (starting at 0).
#@Ante is in descending order from $backupNum
#@Post is in ascending order from $backupNum
$DEBUG > 1 && (print "ANTE[$num]: " . join(" ", @Ante) ."\n");
$DEBUG > 1 && (print "POST[$num]: " . join(" ", @Post) ."\n\n");
}
}
my $filesdeleted = my$attribsdeleted = 0;
my @filelist=();
my $warnflg=0;
while (@branches) {
my @files = @ARGV;
while (@files) { #Start to delete each file/directory (and adjust
antecedants & descendants)
my $delflag=0;
$mangle && ($files[0] = $bpc->fileNameMangle($files[0]));
$DEBUG > 2 && $mangle && print "Mangle: $files[0]\n";
(my $file ="$branches[0]/$files[0]") =~ m|(.+)/(.+)|;
my $dir = $1;
shift @files;
$DEBUG > 2 && print "LOOKING AT: $file\n";
( -d $dir ) || next; #Nothing to do since parent directory
doesn't exist
if (-d $file) {
unless ($rmdir) {
$warnflg || warn "Can't delete directories
unless set -r flag\n";
$warnflg=1;
next;
}
}
else { # If not a dir, we first need look at earlier backups to
see if a file (not dir) exists
#with same name without an intervening same name
directory or deleted file attrib.
#If so instead of deleting the attrib entry for the
current file, we will set the type
#to 10 (delete) and blank the other (no longer
meaningful) entries.
my @ante =@Ante;
while(@ante) { #Note not executed if we set the
wildcard for numBackups since then @ante=()
(my $prevback = $file) =~
s|^($root/$hostregex)/([^/]*)/|$1/$ante[0]/|;
$DEBUG >1 && print "ANTE[$ante[0]] $prevback [" . (-f $prevback ? "F" : (-d
$prevback ? "D":"-")) . "]\n";
if (-f $prevback ) { #File exists in previous
backup so better set delete attrib
$delflag = 1;
last;
}
(-d $prevback) && last; #Directory exists with
same name in prev backup so no need to adjust attrib
( get_attrib($file,"type") == 10) && last;
#Already marked as deleted
shift @ante; # Continue looping at look at
earlier antecdents...
}
}
# Next, delete and/or adjust delete attrib for current file we
are looking at..
$DEBUG >1 && print "CURRENT[$num] $file [" . (-f $file ? "F" : (-d $file ?
"D":"-")) . "][" . ($delflag ? "DELATRIB":"-") ."]\n";
if (-r $file ) { #If file/dir exists, delete and then remove
attrib or mark delete attrib
$DEBUG && print" delete_file_and_attrib($file, $rmdir, $delflag, !$quiet)\n";
delete_file_and_attrib($file, $rmdir, $delflag,
!$quiet);
}
elsif ($delflag ==1) { #If file doesn't exist, mark removal by
setting delete attrib if $delflag
$DEBUG && print" set_delete_attrib($file, !$quiet)\n";
set_delete_attrib($file, !$quiet);
}
#Finally, delete file/directory from later incremental backups
(applies to both files & dirs)
my @post = @Post;
while (@post) { #Again note if wildcard set for numBackups then
@post=() so this is skipped
#and files will be deleted through main loop
(my $nextback = $file) =~
s|^($root/$hostregex)/([^/]*)/|$1/$post[0]/|;
$DEBUG >1 && print "POST[$post[0]] $nextback [" . (-f $nextback ? "F" : (-d
$nextback ? "D":"-")) . "]\n";
#$DEBUG >1 && print "POST:$post[0]: $nextback [" . (-r $nextback ? "R":"-") .
"]\n";
if (-r $nextback ) { #Exists in successor branch
unless ($force || (-f $file) == -f ($nextback))
{
#File subsequently replaced by directory or vica versa - be
cautious
warn "Warning: Not removing '$nextback'
(and its children) since file type changes\n";
last;
}
else {
$DEBUG && print" delete_file_and_attrib($nextback, $rmdir, 0, !$quiet)\n";
delete_file_and_attrib($nextback,
$rmdir, 0, !$quiet);
}
}
shift @post; #Continue looping and looking at further
descedants...
}
}
shift @branches;
}
$DEBUG && print "Files/directories deleted: $filesdeleted Delete attrib
set(with no file deletion): $attribsdeleted\n";
run_nightly() if ($runnightly && !$dryrun && $filesdeleted);
exit;
sub get_attrib
{
my ($fullfilename, $attribname) = @_;
$fullfilename =~ m{(.+)/(.+)};
my $dir=$1;
my $file=$2;
(-f "$dir/attrib" ) || return 0; #This is not necessarily an error
because file may be empty
($attrib->read($dir, "attrib")) || die "Error: Cannot read attrib file
for '$dir'\n";
$attrib->{files}{$file}{type};
}
# Routine to delete file and adjust corresponding attribute file
# $fullfilename is full path name to file or directory
# $rmdirflg if 1, allows for removal of directories too
# $delttrib if 1 then changes attrib to deleted file type rather than
# deleting attribute (only applies to files)
# $listdeletes if 1 then lists deleted files and/or modified attrib entries
sub delete_file_and_attrib
{
my ($fullfilename, $rmdirflg, $delattrib, $listdeletes) = @_;
$fullfilename =~ m|(.*)/f(.*)|;
my $isdir = (-d $fullfilename) ? 1 : 0;
my $dir = $1;
my $file = $2;
($isdir && $rmdirflg ne "1") && die "Error: can't delete directories
unless rmdirflg set\n";
( -w $fullfilename) || die "Error: '$fullfilename' doesn't exist or not
writeable\n";
( -w "$dir/attrib") || die "Error: Cannot write to attrib file for
'$dir'\n";
($attrib->read($dir, "attrib")) || die "Error: Cannot read attrib file
for '$dir'\n";
(defined ($attrib->get($file))) || die "Error: '$file' not found in
attrib file\n";
if (remove($fullfilename, $listdeletes) > 0 ) { # Remove file/directory
$filesdeleted++; # Signal that at least one file deleted...
#Now adjust attrib file entry
if ($delattrib == 1 && !$isdir) {
$attrib->set($file, { # Set file to deleted type
type => 10,
mode => 0,
uid => 0,
gid => 0,
size => 0,
mtime => 0,
});
$DEBUG >1 && print "Setting type=10 (deleted file) attrib for $fullfilename\n";
}
else { # Remove attrib entry for file
$attrib->delete($file);
$DEBUG >1 && print "Removing attrib entry for: f$file\n";
}
$dryrun || ($attrib->write($dir, "attrib")) || die "Error
writing to attribute file for $dir\n";
return 0;
}
return 1;
}
sub remove
{
$_ = $_[0];
my $ret=0;
if (-f ) {
($dryrun ? $ret = 1 : ($ret = unlink));
($ret == 1) && $_[1] && print "unlink $_\n";
}
elsif (-d ) {
if($dryrun) {
print "deleting directory tree starting at: $_ \n";
$ret=1;
}
else {
$ret = rmtree($_, $_[1], 1);
}
}
return $ret;
}
sub set_delete_attrib
{
my ($fullfilename, $listdeletes) = @_;
$fullfilename =~ m|(.*)/f(.*)|;
my $dir = $1;
my $file = $2;
if (-e "$dir/attrib") {
( -w "$dir/attrib") || die "Error: Cannot write to attrib file
for '$dir'\n";
($attrib->read($dir, "attrib")) || die "Error: Cannot read
attrib file for '$dir'\n";
}
else { #Possible it doesn't exist if directory is empty (which occurs
frequently with incrementals)
$attrib = BackupPC::Attrib->new({ compress =>
$Conf{CompressLevel} });
}
$attrib->set($file, { # Set file to deleted type
type => 10,
mode => 0,
uid => 0,
gid => 0,
size => 0,
mtime => 0,
});
$DEBUG > 3 && print Dumper($attrib->get($file));
$dryrun || ($attrib->write($dir, "attrib")) || die "Error writing to
attribute file for $dir\n";
$attribsdeleted++; # Signal that attribute type set to deleted
$listdeletes && print "Setting type=10 (deleted file) attrib for
$fullfilename\n";
return 0;
}
sub find_backup_heirarchy
{
my ($path, $baknum, $antecedants, $descendants) = @_;
my %backupInfo;
$path =~ s|//*|/|g;
my @baks = `find $path -maxdepth 1 -regex \"$path/[0-9]+\" -printf
"%f\n"`;
chop(@baks);
my @before = my @after = ();
while (@baks) {
if ($baks[0] <= $baknum) {
push (@before, $baks[0]);
}
else {
push (@after, $baks[0]);
}
shift @baks;
}
@before = reverse(sort numerically @before);
shift(@before); # remove $baknum from beginning;
@after = sort numerically @after;
my $oldlevel = my $baklevel = get_baklevel("$path/$baknum");
while(@before) {
my $newlevel = get_baklevel("$path/$before[0]");
if ($newlevel < $oldlevel) {
push(@$antecedants, $before[0]);
($newlevel == 0 ) && last;
$oldlevel = $newlevel;
}
shift @before;
}
while(@after) {
my $newlevel = get_baklevel("$path/$after[0]");
($newlevel == $baklevel ) && last;
if ($newlevel > $baklevel) {
push(@$descendants, $after[0]);
}
shift @after;
}
}
sub numerically {$a <=> $b}
sub get_baklevel {
our %backupInfo = ();
my $bakinfo = "$_[0]/backupInfo";
(-f $bakinfo ) || warn "Can't read $bakinfo\n";
unless (my $ret = do $bakinfo) {
warn "couldn't parse $bakinfo: $@" if $@;
warn "couldn't do $bakinfo: $!" unless defined $ret;
print "couldn't run $bakinfo" unless $ret;
}
if ( !keys(%backupInfo) || !defined($backupInfo{num}) ) {
warn "$bakinfo is empty\n";
}
return $backupInfo{level};
}
sub run_nightly
{
my $err = $bpc->ServerConnect($Conf{ServerHost}, $Conf{ServerPort});
if ($err) {
print "Error: BackupPC_nightly: can't connect to server
($err)...\n";
return($err);
}
if ((my $reply = $bpc->ServerMesg("BackupPC_nightly run")) == 0) {
$bpc->ServerMesg("log $0: called for BackupPC_nightly run...");
return 0;
}
else {
print "Error: BackupPC_nightly ($reply)...\n";
return $reply;
}
}
-------------------------------------------------------------------------
This SF.Net email is sponsored by the Moblin Your Move Developer's challenge
Build the coolest Linux based applications with Moblin SDK & win great prizes
Grand prize is a trip for two to an Open Source event anywhere in the world
http://moblin-contest.org/redirect.php?banner_id=100&url=/
_______________________________________________
BackupPC-users mailing list
BackupPC-users AT lists.sourceforge DOT net
List: https://lists.sourceforge.net/lists/listinfo/backuppc-users
Wiki: http://backuppc.wiki.sourceforge.net
Project: http://backuppc.sourceforge.net/
|
