* Fixed stupid last-minute change in octal size conversion in
[BackupPC.git] / lib / BackupPC / Lib.pm
index d543880..849ee86 100644 (file)
@@ -29,7 +29,7 @@
 #
 #========================================================================
 #
-# Version 2.0.0beta1, released 30 Mar 2003.
+# Version 2.0.2, released 6 Oct 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.0beta1',
+        TopDir  => $topDir || '/data/BackupPC2.0.2',
+        BinDir  => $installDir || '/usr/local/BackupPC2.0.2',
+        LibDir  => $installDir || '/usr/local/BackupPC2.0.2',
+        Version => '2.0.2',
         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;
 }
 
@@ -177,6 +187,7 @@ 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]*$)/ );
@@ -202,6 +213,7 @@ sub BackupInfoWrite
            "$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}}}));
@@ -219,6 +231,7 @@ sub RestoreInfoRead
 
     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+.*)/ );
@@ -244,6 +257,7 @@ sub RestoreInfoWrite
            "$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",
@@ -325,6 +339,7 @@ sub HostInfoRead
                      "Can't open $bpc->{TopDir}/conf/hosts\n");
         return {};
     }
+    binmode(HOST_INFO);
     while ( <HOST_INFO> ) {
         s/[\n\r]+//;
         s/#.*//;
@@ -440,7 +455,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
 {
@@ -450,13 +466,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;
 }
@@ -593,6 +611,7 @@ sub File2MD5
     $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 ) {
@@ -686,7 +705,8 @@ sub MakeFileLink
         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;
@@ -712,8 +732,8 @@ sub CheckHostAlive
     # 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} );
+       print(STDERR "CheckHostAlive: return ok because \$Conf{PingCmd}"
+                  . " is empty\n") if ( $bpc->{verbose} );
        return 0;
     }
 
@@ -728,7 +748,7 @@ sub CheckHostAlive
     #
     $s = $bpc->cmdSystemOrEval($pingCmd, undef, $args);
     if ( $? ) {
-       print("CheckHostAlive: first ping failed ($?, $!)\n")
+       print(STDERR "CheckHostAlive: first ping failed ($?, $!)\n")
                        if ( $bpc->{verbose} );
        return -1;
     }
@@ -738,7 +758,7 @@ sub CheckHostAlive
     #
     $s = $bpc->cmdSystemOrEval($pingCmd, undef, $args);
     if ( $? ) {
-       print("CheckHostAlive: second ping failed ($?, $!)\n")
+       print(STDERR "CheckHostAlive: second ping failed ($?, $!)\n")
                        if ( $bpc->{verbose} );
        return -1;
     }
@@ -747,11 +767,11 @@ sub CheckHostAlive
     } 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} );
+       print(STDERR "CheckHostAlive: can't extract round-trip time"
+                  . " (not fatal)\n") if ( $bpc->{verbose} );
        $ret = 0;
     }
-    print("CheckHostAlive: returning $ret\n") if ( $bpc->{verbose} );
+    print(STDERR "CheckHostAlive: returning $ret\n") if ( $bpc->{verbose} );
     return $ret;
 }
 
@@ -786,9 +806,8 @@ sub NetBiosInfoGet
     # 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} );
+       print(STDERR "NetBiosInfoGet: return $host because \$Conf{NmbLookupCmd}"
+                  . " is empty\n") if ( $bpc->{verbose} );
        return ($host, undef);
     }
 
@@ -803,15 +822,14 @@ sub NetBiosInfoGet
         $netBiosUserName   = $1 if ( $2 eq "03" );  # user is last 03
     }
     if ( !defined($netBiosHostName) ) {
-       print("NetBiosInfoGet: failed: can't parse return string\n")
+       print(STDERR "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} );
+    print(STDERR "NetBiosInfoGet: success, returning host $netBiosHostName,"
+               . " user $netBiosUserName\n") if ( $bpc->{verbose} );
     return ($netBiosHostName, $netBiosUserName);
 }
 
@@ -832,9 +850,9 @@ sub NetBiosHostIPFind
     # 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} );
+       print(STDERR "NetBiosHostIPFind: return $host because"
+                  . " \$Conf{NmbLookupFindHostCmd} is empty\n")
+                       if ( $bpc->{verbose} );
        return $host;
     }
 
@@ -856,12 +874,12 @@ sub NetBiosHostIPFind
     }
     $ipAddr = $firstIpAddr if ( !defined($ipAddr) );
     if ( defined($ipAddr) ) {
-       print("NetBiosHostIPFind: found IP address $ipAddr for host $host\n")
-                       if ( $bpc->{verbose} );
+       print(STDERR "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} );
+       print(STDERR "NetBiosHostIPFind: couldn't find IP address for"
+                  . " host $host\n") if ( $bpc->{verbose} );
        return;
     }
 }
@@ -991,7 +1009,7 @@ sub cmdVarSubstitute
         $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
@@ -1025,17 +1043,17 @@ sub cmdExecOrEval
     
     if ( (ref($cmd) eq "ARRAY" ? $cmd->[0] : $cmd) =~ /^\&/ ) {
         $cmd = join(" ", $cmd) if ( ref($cmd) eq "ARRAY" );
-       print("cmdExecOrEval: about to eval perl code $cmd\n")
+       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" );
-       print("cmdExecOrEval: about to exec ",
-             $bpc->execCmd2ShellCmd(@$cmd), "\n")
-                       if ( $bpc->{verbose} );
-        exec(@$cmd);
+       print(STDERR "cmdExecOrEval: about to exec ",
+                     $bpc->execCmd2ShellCmd(@$cmd), "\n")
+                           if ( $bpc->{verbose} );
+        exec(map { m/(.*)/ } @$cmd);           # untaint
         print(STDERR "Exec failed for @$cmd\n");
         exit(1);
     }
@@ -1061,19 +1079,19 @@ sub cmdSystemOrEval
     
     if ( (ref($cmd) eq "ARRAY" ? $cmd->[0] : $cmd) =~ /^\&/ ) {
         $cmd = join(" ", $cmd) if ( ref($cmd) eq "ARRAY" );
-       print("cmdSystemOrEval: about to eval perl code $cmd\n")
+       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("cmdSystemOrEval: finished: got output $out\n")
+       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("cmdSystemOrEval: about to system ",
-             $bpc->execCmd2ShellCmd(@$cmd), "\n")
+       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";
@@ -1083,13 +1101,14 @@ sub cmdSystemOrEval
            return $err        if ( !defined($stdoutCB) );
            return;
        }
+       binmode(CHILD);
        if ( !$pid ) {
            #
            # This is the child
            #
             close(STDERR);
            open(STDERR, ">&STDOUT");
-           exec(@$cmd);
+           exec(map { m/(.*)/ } @$cmd);                # untaint
             print("Exec of @$cmd failed\n");
             exit(1);
        }
@@ -1105,7 +1124,7 @@ sub cmdSystemOrEval
        $? = 0;
        close(CHILD);
     }
-    print("cmdSystemOrEval: finished: got output $allOut\n")
+    print(STDERR "cmdSystemOrEval: finished: got output $allOut\n")
                        if ( $bpc->{verbose} );
     return $out;
 }