X-Git-Url: http://git.rot13.org/?p=BackupPC.git;a=blobdiff_plain;f=lib%2FBackupPC%2FLib.pm;h=ecc455dbcfe873df57d39ad9fa6c1a2bb5d19f14;hp=8cc1e83a054b899d2fe9893e750f64655ceff3a1;hb=f6257f558390295c581f4e5af8f084341db05d34;hpb=0697368bbcef14908cd4684cf07744dc840464de

diff --git a/lib/BackupPC/Lib.pm b/lib/BackupPC/Lib.pm
index 8cc1e83..ecc455d 100644
--- a/lib/BackupPC/Lib.pm
+++ b/lib/BackupPC/Lib.pm
@@ -29,7 +29,7 @@
 #
 #========================================================================
 #
-# Version 2.0.0_CVS, released 18 Jan 2003.
+# Version 2.0.0beta2, released 13 Apr 2003.
 #
 # See http://backuppc.sourceforge.net.
 #
@@ -52,13 +52,13 @@ use Digest::MD5;
 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.0.0beta2',
         BackupFields => [qw(
                     num type startTime endTime
                     nFiles size nFilesExist sizeExist nFilesNew sizeNew
@@ -83,6 +83,16 @@ sub new
         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("Wrong user: my userid is $>, instead of $uid"
+	    . " ($bpc->{Conf}{BackupPCUser})\n");
+	return;
+    }
     return $bpc;
 }
 
@@ -126,6 +136,21 @@ sub trashJob
     return " trashClean ";
 }
 
+sub ConfValue
+{
+    my($bpc, $param) = @_;
+
+    return $bpc->{Conf}{$param};
+}
+
+sub verbose
+{
+    my($bpc, $param) = @_;
+
+    $bpc->{verbose} = $param if ( defined($param) );
+    return $bpc->{verbose};
+}
+
 sub timeStamp
 {
     my($bpc, $t, $noPad) = @_;
@@ -314,7 +339,7 @@ sub HostInfoRead
         s/[\n\r]+//;
         s/#.*//;
         s/\s+$//;
-        next if ( /^\s*$/ || !/^([\w\.-\\]+\s+.*)/ );
+        next if ( /^\s*$/ || !/^([\w\.\\-]+\s+.*)/ );
         #
         # Split on white space, except if preceded by \
         # using zero-width negative look-behind assertion
@@ -425,7 +450,8 @@ sub RmTreeDefer
 }
 
 #
-# 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
 {
@@ -435,13 +461,15 @@ 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;
 }
@@ -691,7 +719,16 @@ sub MakeFileLink
 sub CheckHostAlive
 {
     my($bpc, $host) = @_;
-    my($s, $pingCmd);
+    my($s, $pingCmd, $ret);
+
+    #
+    # Return success if the ping cmd is undefined or empty.
+    #
+    if ( $bpc->{Conf}{PingCmd} eq "" ) {
+	print("CheckHostAlive: return ok because \$Conf{PingCmd} is empty\n")
+			if ( $bpc->{verbose} );
+	return 0;
+    }
 
     my $args = {
 	pingPath => $bpc->{Conf}{PingPath},
@@ -703,16 +740,32 @@ sub CheckHostAlive
     # Do a first ping in case the PC needs to wakeup
     #
     $s = $bpc->cmdSystemOrEval($pingCmd, undef, $args);
-    return -1 if ( $? );
+    if ( $? ) {
+	print("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("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("CheckHostAlive: can't extract round-trip time (not fatal)\n")
+				if ( $bpc->{verbose} );
+	$ret = 0;
+    }
+    print("CheckHostAlive: returning $ret\n") if ( $bpc->{verbose} );
+    return $ret;
 }
 
 sub CheckFileSystemUsage
@@ -721,6 +774,7 @@ sub CheckFileSystemUsage
     my($topDir) = $bpc->{TopDir};
     my($s, $dfCmd);
 
+    return 0 if ( $bpc->{Conf}{DfCmd} eq "" );
     my $args = {
 	dfPath   => $bpc->{Conf}{DfPath},
 	topDir   => $bpc->{TopDir},
@@ -741,6 +795,16 @@ sub NetBiosInfoGet
     my($netBiosHostName, $netBiosUserName);
     my($s, $nmbCmd);
 
+    #
+    # Skip NetBios check if NmbLookupCmd is emtpy
+    #
+    if ( $bpc->{Conf}{NmbLookupCmd} eq "" ) {
+	print("NetBiosInfoGet: return $host because \$Conf{NmbLookupCmd}"
+	    . " is empty\n")
+		if ( $bpc->{verbose} );
+	return ($host, undef);
+    }
+
     my $args = {
 	nmbLookupPath => $bpc->{Conf}{NmbLookupPath},
 	host	      => $host,
@@ -751,29 +815,67 @@ sub NetBiosInfoGet
         $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("NetBiosInfoGet: failed: can't parse return string\n")
+			if ( $bpc->{verbose} );
+	return;
+    }
+    $netBiosHostName = lc($netBiosHostName);
+    $netBiosUserName = lc($netBiosUserName);
+    print("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
+    #
+    if ( $bpc->{Conf}{NmbLookupFindHostCmd} eq "" ) {
+	print("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("NetBiosHostIPFind: found IP address $ipAddr for host $host\n")
+			if ( $bpc->{verbose} );
+	return $ipAddr;
     } else {
-        return;
+	print("NetBiosHostIPFind: couldn't find IP address for host $host\n")
+			if ( $bpc->{verbose} );
+	return;
     }
 }
 
@@ -936,10 +1038,19 @@ sub cmdExecOrEval
     
     if ( (ref($cmd) eq "ARRAY" ? $cmd->[0] : $cmd) =~ /^\&/ ) {
         $cmd = join(" ", $cmd) if ( ref($cmd) eq "ARRAY" );
-        eval($cmd)
+	print("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" );
+	print("cmdExecOrEval: about to exec ",
+	      $bpc->execCmd2ShellCmd(@$cmd), "\n")
+			if ( $bpc->{verbose} );
         exec(@$cmd);
+        print(STDERR "Exec failed for @$cmd\n");
+        exit(1);
     }
 }
 
@@ -958,18 +1069,25 @@ sub cmdExecOrEval
 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("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("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("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;
@@ -985,6 +1103,8 @@ sub cmdSystemOrEval
             close(STDERR);
 	    open(STDERR, ">&STDOUT");
 	    exec(@$cmd);
+            print("Exec of @$cmd failed\n");
+            exit(1);
 	}
 	#
 	# The parent gathers the output from the child
@@ -993,10 +1113,13 @@ sub cmdSystemOrEval
 	    $$stdoutCB .= $_ if ( ref($stdoutCB) eq 'SCALAR' );
 	    &$stdoutCB($_)   if ( ref($stdoutCB) eq 'CODE' );
 	    $out .= $_ 	     if ( !defined($stdoutCB) );
+	    $allOut .= $_    if ( $bpc->{verbose} );
 	}
 	$? = 0;
 	close(CHILD);
     }
+    print("cmdSystemOrEval: finished: got output $allOut\n")
+			if ( $bpc->{verbose} );
     return $out;
 }