* Changed BackupPC::Lib so that user check is optional in new()
[BackupPC.git] / lib / BackupPC / Lib.pm
index f0590bc..ecc455d 100644 (file)
@@ -29,7 +29,7 @@
 #
 #========================================================================
 #
-# Version 1.6.0_CVS, released 10 Dec 2002.
+# 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 => '1.6.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,8 +339,19 @@ sub HostInfoRead
         s/[\n\r]+//;
         s/#.*//;
         s/\s+$//;
-        next if ( /^\s*$/ || !/^([\w\.-]+\s+.*)/ );
-        @fld = split(/\s+/, $1);
+        next if ( /^\s*$/ || !/^([\w\.\\-]+\s+.*)/ );
+        #
+        # Split on white space, except if preceded by \
+        # using zero-width negative look-behind assertion
+       # (always wanted to use one of those).
+        #
+        @fld = split(/(?<!\\)\s+/, $1);
+        #
+        # Remove any \
+        #
+        foreach ( @fld ) {
+            s{\\(\s)}{$1}g;
+        }
         if ( @hdr ) {
             if ( defined($host) ) {
                 next if ( lc($fld[0]) ne $host );
@@ -414,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
 {
@@ -424,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;
 }
@@ -680,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},
@@ -692,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
@@ -710,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},
@@ -720,12 +785,26 @@ sub CheckFileSystemUsage
     return $1;
 }
 
+#
+# Given an IP address, return the host name and user name via
+# NetBios.
+#
 sub NetBiosInfoGet
 {
     my($bpc, $host) = @_;
     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,
@@ -736,8 +815,68 @@ 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, $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);
+    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 {
+       print("NetBiosHostIPFind: couldn't find IP address for host $host\n")
+                       if ( $bpc->{verbose} );
+       return;
+    }
 }
 
 sub fileNameEltMangle
@@ -791,6 +930,43 @@ sub shellEscape
     return $cmd;
 }
 
+#
+# For printing exec commands (which don't use a shell) so they look like
+# a valid shell command this function should be called with the exec
+# args.  The shell command string is returned.
+#
+sub execCmd2ShellCmd
+{
+    my($bpc, @args) = @_;
+    my $str;
+
+    foreach my $a ( @args ) {
+       $str .= " " if ( $str ne "" );
+       $str .= $bpc->shellEscape($a);
+    }
+    return $str;
+}
+
+#
+# Do a URI-style escape to protect/encode special characters
+#
+sub uriEsc
+{
+    my($bpc, $s) = @_;
+    $s =~ s{([^\w.\/-])}{sprintf("%%%02X", ord($1));}eg;
+    return $s;
+}
+
+#
+# Do a URI-style unescape to restore special characters
+#
+sub uriUnesc
+{
+    my($bpc, $s) = @_;
+    $s =~ s{%(..)}{chr(hex($1))}eg;
+    return $s;
+}
+
 #
 # Do variable substitution prior to execution of a command.
 #
@@ -806,7 +982,18 @@ sub cmdVarSubstitute
     if ( (ref($template) eq "ARRAY" ? $template->[0] : $template) =~ /^\&/ ) {
         return $template;
     }
-    $template = [split(/\s+/, $template)] if ( ref($template) ne "ARRAY" );
+    if ( ref($template) ne "ARRAY" ) {
+       #
+       # Split at white space, except if escaped by \
+       #
+       $template = [split(/(?<!\\)\s+/, $template)];
+       #
+       # Remove the \ that escaped white space.
+       #
+        foreach ( @$template ) {
+            s{\\(\s)}{$1}g;
+        }
+    }
     #
     # Merge variables into @tarClientCmd
     #
@@ -815,7 +1002,7 @@ sub cmdVarSubstitute
         # Replace scalar variables first
         #
         $arg =~ s{\$(\w+)(\+?)}{
-            defined($vars->{$1}) && ref($vars->{$1}) ne "ARRAY"
+            exists($vars->{$1}) && ref($vars->{$1}) ne "ARRAY"
                 ? ($2 eq "+" ? $bpc->shellEscape($vars->{$1}) : $vars->{$1})
                 : "\$$1"
         }eg;
@@ -851,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);
     }
 }
 
@@ -873,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;
@@ -900,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
@@ -908,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;
 }