- updated version to BackupPC-2.1.0beta0
[BackupPC.git] / lib / BackupPC / Lib.pm
index ecc455d..49354b6 100644 (file)
@@ -11,7 +11,7 @@
 #   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
@@ -29,7 +29,7 @@
 #
 #========================================================================
 #
-# Version 2.0.0beta2, released 13 Apr 2003.
+# Version 2.1.0beta0, released 20 Mar 2004.
 #
 # See http://backuppc.sourceforge.net.
 #
@@ -48,6 +48,7 @@ use File::Compare;
 use Socket;
 use Cwd;
 use Digest::MD5;
+use Config;
 
 sub new
 {
@@ -58,7 +59,7 @@ sub new
         TopDir  => $topDir || '/data/BackupPC',
         BinDir  => $installDir || '/usr/local/BackupPC',
         LibDir  => $installDir || '/usr/local/BackupPC',
-        Version => '2.0.0beta2',
+        Version => '2.1.0beta0',
         BackupFields => [qw(
                     num type startTime endTime
                     nFiles size nFilesExist sizeExist nFilesNew sizeNew
@@ -70,6 +71,9 @@ sub new
                     num startTime endTime result errorMsg nFiles size
                     tarCreateErrs xferErrs
                 )],
+        ArchiveFields => [qw(
+                    num startTime endTime result errorMsg
+                )],
     }, $class;
     $bpc->{BinDir} .= "/bin";
     $bpc->{LibDir} .= "/lib";
@@ -89,7 +93,7 @@ sub new
     if ( !$noUserCheck
            && $bpc->{Conf}{BackupPCUserVerify}
            && $> != (my $uid = (getpwnam($bpc->{Conf}{BackupPCUser}))[2]) ) {
-       print("Wrong user: my userid is $>, instead of $uid"
+       print(STDERR "Wrong user: my userid is $>, instead of $uid"
            . " ($bpc->{Conf}{BackupPCUser})\n");
        return;
     }
@@ -151,32 +155,33 @@ sub verbose
     return $bpc->{verbose};
 }
 
-sub timeStamp
+sub sigName2num
 {
-    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, $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
@@ -187,9 +192,10 @@ 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/);
         }
@@ -212,6 +218,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}}}));
@@ -229,6 +236,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+.*)/ );
@@ -254,6 +262,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",
@@ -264,6 +273,51 @@ sub RestoreInfoWrite
     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) = @_;
@@ -335,6 +389,7 @@ sub HostInfoRead
                      "Can't open $bpc->{TopDir}/conf/hosts\n");
         return {};
     }
+    binmode(HOST_INFO);
     while ( <HOST_INFO> ) {
         s/[\n\r]+//;
         s/#.*//;
@@ -394,7 +449,7 @@ sub RmTreeQuiet
     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}) {
@@ -407,14 +462,17 @@ sub RmTreeQuiet
        #
        if ( !unlink($root) ) {
             if ( -d $root ) {
-                my $d = DirHandle->new($root)
-                  or print "Can't read $pwd/$root: $!";
-                @files = $d->read;
-                $d->close;
-                @files = grep $_!~/^\.{1,2}$/, @files;
-                $bpc->RmTreeQuiet("$pwd/$root", \@files);
-                chdir($pwd);
-                rmdir($root) || rmdir($root);
+                my $d = DirHandle->new($root);
+               if ( !defined($d) ) {
+                   print(STDERR "Can't read $pwd/$root: $!\n");
+               } else {
+                   @files = $d->read;
+                   $d->close;
+                   @files = grep $_!~/^\.{1,2}$/, @files;
+                   $bpc->RmTreeQuiet("$pwd/$root", \@files);
+                   chdir($pwd);
+                   rmdir($root) || rmdir($root);
+               }
             } else {
                 unlink($root) || unlink($root);
             }
@@ -606,6 +664,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 ) {
@@ -699,7 +758,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;
@@ -725,8 +785,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;
     }
 
@@ -741,7 +801,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;
     }
@@ -751,7 +811,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;
     }
@@ -760,11 +820,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;
 }
 
@@ -799,9 +859,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);
     }
 
@@ -816,15 +875,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);
 }
 
@@ -845,7 +903,7 @@ sub NetBiosHostIPFind
     # Skip NetBios lookup if NmbLookupFindHostCmd is emtpy
     #
     if ( $bpc->{Conf}{NmbLookupFindHostCmd} eq "" ) {
-       print("NetBiosHostIPFind: return $host because"
+       print(STDERR "NetBiosHostIPFind: return $host because"
            . " \$Conf{NmbLookupFindHostCmd} is empty\n")
                if ( $bpc->{verbose} );
        return $host;
@@ -869,12 +927,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;
     }
 }
@@ -1004,7 +1062,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
@@ -1038,17 +1096,22 @@ 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 ",
+       print(STDERR "cmdExecOrEval: about to exec ",
              $bpc->execCmd2ShellCmd(@$cmd), "\n")
                        if ( $bpc->{verbose} );
-        exec(@$cmd);
+       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);
     }
@@ -1074,18 +1137,18 @@ 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 ",
+       print(STDERR "cmdSystemOrEval: about to system ",
              $bpc->execCmd2ShellCmd(@$cmd), "\n")
                        if ( $bpc->{verbose} );
         if ( !defined($pid = open(CHILD, "-|")) ) {
@@ -1096,14 +1159,20 @@ sub cmdSystemOrEval
            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);
        }
        #
@@ -1118,7 +1187,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;
 }