# Craig Barratt <cbarratt@users.sourceforge.net>
#
# COPYRIGHT
-# Copyright (C) 2001 Craig Barratt
+# Copyright (C) 2001-2003 Craig Barratt
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
#
#========================================================================
#
-# Version 2.0.0_CVS, released 3 Feb 2003.
+# Version 2.1.0_CVS, released 8 Feb 2004.
#
# See http://backuppc.sourceforge.net.
#
use Socket;
use Cwd;
use Digest::MD5;
+use Config;
sub new
{
my $class = shift;
- my($topDir, $installDir) = @_;
+ my($topDir, $installDir, $noUserCheck) = @_;
my $bpc = bless {
TopDir => $topDir || '/data/BackupPC',
BinDir => $installDir || '/usr/local/BackupPC',
LibDir => $installDir || '/usr/local/BackupPC',
- Version => '2.0.0_CVS',
+ Version => '2.1.0_CVS',
BackupFields => [qw(
num type startTime endTime
nFiles size nFilesExist sizeExist nFilesNew sizeNew
num startTime endTime result errorMsg nFiles size
tarCreateErrs xferErrs
)],
+ ArchiveFields => [qw(
+ num startTime endTime result errorMsg
+ )],
}, $class;
$bpc->{BinDir} .= "/bin";
$bpc->{LibDir} .= "/lib";
print(STDERR $error, "\n");
return;
}
+ #
+ # Verify we are running as the correct user
+ #
+ if ( !$noUserCheck
+ && $bpc->{Conf}{BackupPCUserVerify}
+ && $> != (my $uid = (getpwnam($bpc->{Conf}{BackupPCUser}))[2]) ) {
+ print(STDERR "Wrong user: my userid is $>, instead of $uid"
+ . " ($bpc->{Conf}{BackupPCUser})\n");
+ return;
+ }
return $bpc;
}
return $bpc->{Conf}{$param};
}
-sub timeStamp
+sub verbose
{
- my($bpc, $t, $noPad) = @_;
- my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
- = localtime($t || time);
- $year += 1900;
- $mon++;
- return "$year/$mon/$mday " . sprintf("%02d:%02d:%02d", $hour, $min, $sec)
- . ($noPad ? "" : " ");
+ my($bpc, $param) = @_;
+
+ $bpc->{verbose} = $param if ( defined($param) );
+ return $bpc->{verbose};
+}
+
+sub sigName2num
+{
+ my($bpc, $sig) = @_;
+
+ if ( !defined($bpc->{SigName2Num}) ) {
+ my $i = 0;
+ foreach my $name ( split(' ', $Config{sig_name}) ) {
+ $bpc->{SigName2Num}{$name} = $i;
+ $i++;
+ }
+ }
+ return $bpc->{SigName2Num}{$sig};
}
#
-# An ISO 8601-compliant version of timeStamp. Needed by the
-# --newer-mtime argument to GNU tar in BackupPC::Xfer::Tar.
-# Also see http://www.w3.org/TR/NOTE-datetime.
+# Generate an ISO 8601 format timeStamp (but without the "T").
+# See http://www.w3.org/TR/NOTE-datetime and
+# http://www.cl.cam.ac.uk/~mgk25/iso-time.html
#
-sub timeStampISO
+sub timeStamp
{
my($bpc, $t, $noPad) = @_;
my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
= localtime($t || time);
- $year += 1900;
- $mon++;
- return sprintf("%04d-%02d-%02d ", $year, $mon, $mday)
- . sprintf("%02d:%02d:%02d", $hour, $min, $sec)
- . ($noPad ? "" : " ");
+ return sprintf("%04d-%02d-%02d %02d:%02d:%02d",
+ $year + 1900, $mon + 1, $mday, $hour, $min, $sec)
+ . ($noPad ? "" : " ");
}
sub BackupInfoRead
flock(LOCK, LOCK_EX) if open(LOCK, "$bpc->{TopDir}/pc/$host/LOCK");
if ( open(BK_INFO, "$bpc->{TopDir}/pc/$host/backups") ) {
+ binmode(BK_INFO);
while ( <BK_INFO> ) {
s/[\n\r]+//;
- next if ( !/^(\d+\t(incr|full)[\d\t]*$)/ );
+ next if ( !/^(\d+\t(incr|full|partial)[\d\t]*$)/ );
$_ = $1;
@{$Backups[@Backups]}{@{$bpc->{BackupFields}}} = split(/\t/);
}
"$bpc->{TopDir}/pc/$host/backups.old")
if ( -f "$bpc->{TopDir}/pc/$host/backups" );
if ( open(BK_INFO, ">$bpc->{TopDir}/pc/$host/backups") ) {
+ binmode(BK_INFO);
for ( $i = 0 ; $i < @Backups ; $i++ ) {
my %b = %{$Backups[$i]};
printf(BK_INFO "%s\n", join("\t", @b{@{$bpc->{BackupFields}}}));
flock(LOCK, LOCK_EX) if open(LOCK, "$bpc->{TopDir}/pc/$host/LOCK");
if ( open(RESTORE_INFO, "$bpc->{TopDir}/pc/$host/restores") ) {
+ binmode(RESTORE_INFO);
while ( <RESTORE_INFO> ) {
s/[\n\r]+//;
next if ( !/^(\d+.*)/ );
"$bpc->{TopDir}/pc/$host/restores.old")
if ( -f "$bpc->{TopDir}/pc/$host/restores" );
if ( open(RESTORE_INFO, ">$bpc->{TopDir}/pc/$host/restores") ) {
+ binmode(RESTORE_INFO);
for ( $i = 0 ; $i < @Restores ; $i++ ) {
my %b = %{$Restores[$i]};
printf(RESTORE_INFO "%s\n",
close(LOCK);
}
+sub ArchiveInfoRead
+{
+ my($bpc, $host) = @_;
+ local(*ARCHIVE_INFO, *LOCK);
+ my(@Archives);
+
+ flock(LOCK, LOCK_EX) if open(LOCK, "$bpc->{TopDir}/pc/$host/LOCK");
+ if ( open(ARCHIVE_INFO, "$bpc->{TopDir}/pc/$host/archives") ) {
+ binmode(ARCHIVE_INFO);
+ while ( <ARCHIVE_INFO> ) {
+ s/[\n\r]+//;
+ next if ( !/^(\d+.*)/ );
+ $_ = $1;
+ @{$Archives[@Archives]}{@{$bpc->{ArchiveFields}}} = split(/\t/);
+ }
+ close(ARCHIVE_INFO);
+ }
+ close(LOCK);
+ return @Archives;
+}
+
+sub ArchiveInfoWrite
+{
+ my($bpc, $host, @Archives) = @_;
+ local(*ARCHIVE_INFO, *LOCK);
+ my($i);
+
+ flock(LOCK, LOCK_EX) if open(LOCK, "$bpc->{TopDir}/pc/$host/LOCK");
+ unlink("$bpc->{TopDir}/pc/$host/archives.old")
+ if ( -f "$bpc->{TopDir}/pc/$host/archives.old" );
+ rename("$bpc->{TopDir}/pc/$host/archives",
+ "$bpc->{TopDir}/pc/$host/archives.old")
+ if ( -f "$bpc->{TopDir}/pc/$host/archives" );
+ if ( open(ARCHIVE_INFO, ">$bpc->{TopDir}/pc/$host/archives") ) {
+ binmode(ARCHIVE_INFO);
+ for ( $i = 0 ; $i < @Archives ; $i++ ) {
+ my %b = %{$Archives[$i]};
+ printf(ARCHIVE_INFO "%s\n",
+ join("\t", @b{@{$bpc->{ArchiveFields}}}));
+ }
+ close(ARCHIVE_INFO);
+ }
+ close(LOCK);
+}
+
sub ConfigRead
{
my($bpc, $host) = @_;
"Can't open $bpc->{TopDir}/conf/hosts\n");
return {};
}
+ binmode(HOST_INFO);
while ( <HOST_INFO> ) {
s/[\n\r]+//;
s/#.*//;
if ( defined($roots) && length($roots) ) {
$roots = [$roots] unless ref $roots;
} else {
- print "RmTreeQuiet: No root path(s) specified\n";
+ print(STDERR "RmTreeQuiet: No root path(s) specified\n");
}
chdir($pwd);
foreach $root (@{$roots}) {
if ( !unlink($root) ) {
if ( -d $root ) {
my $d = DirHandle->new($root)
- or print "Can't read $pwd/$root: $!";
+ or print(STDERR "Can't read $pwd/$root: $!");
@files = $d->read;
$d->close;
@files = grep $_!~/^\.{1,2}$/, @files;
}
#
-# Empty the trash directory. Returns 0 if it did nothing.
+# Empty the trash directory. Returns 0 if it did nothing, 1 if it
+# did something, -1 if it failed to remove all the files.
#
sub RmTreeTrashEmpty
{
$cwd = $1 if ( $cwd =~ /(.*)/ );
return if ( !-d $trashDir );
- my $d = DirHandle->new($trashDir)
- or carp "Can't read $trashDir: $!";
+ my $d = DirHandle->new($trashDir) or carp "Can't read $trashDir: $!";
@files = $d->read;
$d->close;
@files = grep $_!~/^\.{1,2}$/, @files;
return 0 if ( !@files );
$bpc->RmTreeQuiet($trashDir, \@files);
+ foreach my $f ( @files ) {
+ return -1 if ( -e $f );
+ }
chdir($cwd) if ( $cwd );
return 1;
}
$name = $1 if ( $name =~ /(.*)/ );
return ("", 0) if ( $fileSize == 0 );
return ("", -1) if ( !open(N, $name) );
+ binmode(N);
$md5->reset();
$md5->add($fileSize);
if ( $fileSize > 262144 ) {
return -2 if ( !defined($rawFile = $bpc->MD52Path($d, $compress)) );
$rawFile .= "_$i" if ( $i >= 0 );
if ( -f $rawFile ) {
- if ( !compare($name, $rawFile) ) {
+ if ( (stat(_))[3] < $bpc->{Conf}{HardLinkMax}
+ && !compare($name, $rawFile) ) {
unlink($name);
return -3 if ( !link($rawFile, $name) );
return 1;
sub CheckHostAlive
{
my($bpc, $host) = @_;
- my($s, $pingCmd);
+ my($s, $pingCmd, $ret);
#
# Return success if the ping cmd is undefined or empty.
#
- return 0 if ( $bpc->{Conf}{PingCmd} eq "" );
+ if ( $bpc->{Conf}{PingCmd} eq "" ) {
+ print(STDERR "CheckHostAlive: return ok because \$Conf{PingCmd}"
+ . " is empty\n") if ( $bpc->{verbose} );
+ return 0;
+ }
my $args = {
pingPath => $bpc->{Conf}{PingPath},
# Do a first ping in case the PC needs to wakeup
#
$s = $bpc->cmdSystemOrEval($pingCmd, undef, $args);
- return -1 if ( $? );
+ if ( $? ) {
+ print(STDERR "CheckHostAlive: first ping failed ($?, $!)\n")
+ if ( $bpc->{verbose} );
+ return -1;
+ }
#
# Do a second ping and get the round-trip time in msec
#
$s = $bpc->cmdSystemOrEval($pingCmd, undef, $args);
- return -1 if ( $? );
- return $1 if ( $s =~ /time=([\d\.]+)\s*ms/i );
- return $1/1000 if ( $s =~ /time=([\d\.]+)\s*usec/i );
- return 0;
+ if ( $? ) {
+ print(STDERR "CheckHostAlive: second ping failed ($?, $!)\n")
+ if ( $bpc->{verbose} );
+ return -1;
+ }
+ if ( $s =~ /time=([\d\.]+)\s*ms/i ) {
+ $ret = $1;
+ } elsif ( $s =~ /time=([\d\.]+)\s*usec/i ) {
+ $ret = $1/1000;
+ } else {
+ print(STDERR "CheckHostAlive: can't extract round-trip time"
+ . " (not fatal)\n") if ( $bpc->{verbose} );
+ $ret = 0;
+ }
+ print(STDERR "CheckHostAlive: returning $ret\n") if ( $bpc->{verbose} );
+ return $ret;
}
sub CheckFileSystemUsage
#
# Skip NetBios check if NmbLookupCmd is emtpy
#
- return ($host, undef) if ( $bpc->{Conf}{NmbLookupCmd} eq "" );
+ if ( $bpc->{Conf}{NmbLookupCmd} eq "" ) {
+ print(STDERR "NetBiosInfoGet: return $host because \$Conf{NmbLookupCmd}"
+ . " is empty\n") if ( $bpc->{verbose} );
+ return ($host, undef);
+ }
my $args = {
nmbLookupPath => $bpc->{Conf}{NmbLookupPath},
$netBiosHostName ||= $1 if ( $2 eq "00" ); # host is first 00
$netBiosUserName = $1 if ( $2 eq "03" ); # user is last 03
}
- return if ( !defined($netBiosHostName) );
- return (lc($netBiosHostName), lc($netBiosUserName));
+ if ( !defined($netBiosHostName) ) {
+ print(STDERR "NetBiosInfoGet: failed: can't parse return string\n")
+ if ( $bpc->{verbose} );
+ return;
+ }
+ $netBiosHostName = lc($netBiosHostName);
+ $netBiosUserName = lc($netBiosUserName);
+ print(STDERR "NetBiosInfoGet: success, returning host $netBiosHostName,"
+ . " user $netBiosUserName\n") if ( $bpc->{verbose} );
+ return ($netBiosHostName, $netBiosUserName);
}
#
# Given a NetBios name lookup the IP address via NetBios.
+# In the case of a host returning multiple interfaces we
+# return the first IP address that matches the subnet mask.
+# If none match the subnet mask (or nmblookup doesn't print
+# the subnet mask) then just the first IP address is returned.
#
sub NetBiosHostIPFind
{
my($bpc, $host) = @_;
my($netBiosHostName, $netBiosUserName);
- my($s, $nmbCmd);
+ my($s, $nmbCmd, $subnet, $ipAddr, $firstIpAddr);
#
# Skip NetBios lookup if NmbLookupFindHostCmd is emtpy
#
- return $host if ( $bpc->{Conf}{NmbLookupFindHostCmd} eq "" );
+ if ( $bpc->{Conf}{NmbLookupFindHostCmd} eq "" ) {
+ print(STDERR "NetBiosHostIPFind: return $host because"
+ . " \$Conf{NmbLookupFindHostCmd} is empty\n")
+ if ( $bpc->{verbose} );
+ return $host;
+ }
my $args = {
nmbLookupPath => $bpc->{Conf}{NmbLookupPath},
host => $host,
};
$nmbCmd = $bpc->cmdVarSubstitute($bpc->{Conf}{NmbLookupFindHostCmd}, $args);
- my $resp = $bpc->cmdSystemOrEval($nmbCmd, undef, $args);
- if ( $resp =~ /^\s*(\d+\.\d+\.\d+\.\d+)\s+\Q$host/m ) {
- return $1;
+ foreach my $resp ( split(/[\n\r]+/, $bpc->cmdSystemOrEval($nmbCmd, undef,
+ $args) ) ) {
+ if ( $resp =~ /querying\s+\Q$host\E\s+on\s+(\d+\.\d+\.\d+\.\d+)/i ) {
+ $subnet = $1;
+ $subnet = $1 if ( $subnet =~ /^(.*?)(\.255)+$/ );
+ } elsif ( $resp =~ /^\s*(\d+\.\d+\.\d+\.\d+)\s+\Q$host/ ) {
+ my $ip = $1;
+ $firstIpAddr = $ip if ( !defined($firstIpAddr) );
+ $ipAddr = $ip if ( !defined($ipAddr) && $ip =~ /^\Q$subnet/ );
+ }
+ }
+ $ipAddr = $firstIpAddr if ( !defined($ipAddr) );
+ if ( defined($ipAddr) ) {
+ print(STDERR "NetBiosHostIPFind: found IP address $ipAddr for"
+ . " host $host\n") if ( $bpc->{verbose} );
+ return $ipAddr;
} else {
- return;
+ print(STDERR "NetBiosHostIPFind: couldn't find IP address for"
+ . " host $host\n") if ( $bpc->{verbose} );
+ return;
}
}
$arg =~ s{\$(\w+)(\+?)}{
exists($vars->{$1}) && ref($vars->{$1}) ne "ARRAY"
? ($2 eq "+" ? $bpc->shellEscape($vars->{$1}) : $vars->{$1})
- : "\$$1"
+ : "\$$1$2"
}eg;
#
# Now replicate any array arguments; this just works for just one
if ( (ref($cmd) eq "ARRAY" ? $cmd->[0] : $cmd) =~ /^\&/ ) {
$cmd = join(" ", $cmd) if ( ref($cmd) eq "ARRAY" );
+ print(STDERR "cmdExecOrEval: about to eval perl code $cmd\n")
+ if ( $bpc->{verbose} );
eval($cmd);
print(STDERR "Perl code fragment for exec shouldn't return!!\n");
exit(1);
} else {
$cmd = [split(/\s+/, $cmd)] if ( ref($cmd) ne "ARRAY" );
- exec(@$cmd);
+ print(STDERR "cmdExecOrEval: about to exec ",
+ $bpc->execCmd2ShellCmd(@$cmd), "\n")
+ if ( $bpc->{verbose} );
+ alarm(0);
+ $cmd = [map { m/(.*)/ } @$cmd]; # untaint
+ #
+ # force list-form of exec(), ie: no shell even for 1 arg
+ #
+ exec { $cmd->[0] } @$cmd;
print(STDERR "Exec failed for @$cmd\n");
exit(1);
}
sub cmdSystemOrEval
{
my($bpc, $cmd, $stdoutCB, @args) = @_;
- my($pid, $out);
+ my($pid, $out, $allOut);
local(*CHILD);
if ( (ref($cmd) eq "ARRAY" ? $cmd->[0] : $cmd) =~ /^\&/ ) {
$cmd = join(" ", $cmd) if ( ref($cmd) eq "ARRAY" );
- my $out = eval($cmd);
+ print(STDERR "cmdSystemOrEval: about to eval perl code $cmd\n")
+ if ( $bpc->{verbose} );
+ $out = eval($cmd);
$$stdoutCB .= $out if ( ref($stdoutCB) eq 'SCALAR' );
&$stdoutCB($out) if ( ref($stdoutCB) eq 'CODE' );
+ print(STDERR "cmdSystemOrEval: finished: got output $out\n")
+ if ( $bpc->{verbose} );
return $out if ( !defined($stdoutCB) );
return;
} else {
$cmd = [split(/\s+/, $cmd)] if ( ref($cmd) ne "ARRAY" );
+ print(STDERR "cmdSystemOrEval: about to system ",
+ $bpc->execCmd2ShellCmd(@$cmd), "\n")
+ if ( $bpc->{verbose} );
if ( !defined($pid = open(CHILD, "-|")) ) {
my $err = "Can't fork to run @$cmd\n";
$? = 1;
return $err if ( !defined($stdoutCB) );
return;
}
+ binmode(CHILD);
if ( !$pid ) {
#
# This is the child
#
close(STDERR);
open(STDERR, ">&STDOUT");
- exec(@$cmd);
- print("Exec of @$cmd failed\n");
+ alarm(0);
+ $cmd = [map { m/(.*)/ } @$cmd]; # untaint
+ #
+ # force list-form of exec(), ie: no shell even for 1 arg
+ #
+ exec { $cmd->[0] } @$cmd;
+ print(STDERR "Exec of @$cmd failed\n");
exit(1);
}
#
$$stdoutCB .= $_ if ( ref($stdoutCB) eq 'SCALAR' );
&$stdoutCB($_) if ( ref($stdoutCB) eq 'CODE' );
$out .= $_ if ( !defined($stdoutCB) );
+ $allOut .= $_ if ( $bpc->{verbose} );
}
$? = 0;
close(CHILD);
}
+ print(STDERR "cmdSystemOrEval: finished: got output $allOut\n")
+ if ( $bpc->{verbose} );
return $out;
}