* Major changes from Ryan Kucera to add style sheets to the CGI
[BackupPC.git] / lib / BackupPC / Lib.pm
index 1eb848e..cef6d9c 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.0_CVS, released 3 Feb 2003.
+# Version 2.1.0_CVS, released 3 Jul 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.1.0_CVS',
         BackupFields => [qw(
                     num type startTime endTime
                     nFiles size nFilesExist sizeExist nFilesNew sizeNew
@@ -70,6 +70,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";
@@ -83,6 +86,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;
 }
 
@@ -133,32 +146,27 @@ sub ConfValue
     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};
 }
 
 #
-# 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
@@ -169,9 +177,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/);
         }
@@ -194,6 +203,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}}}));
@@ -211,6 +221,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+.*)/ );
@@ -236,6 +247,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",
@@ -246,6 +258,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) = @_;
@@ -317,6 +374,7 @@ sub HostInfoRead
                      "Can't open $bpc->{TopDir}/conf/hosts\n");
         return {};
     }
+    binmode(HOST_INFO);
     while ( <HOST_INFO> ) {
         s/[\n\r]+//;
         s/#.*//;
@@ -432,7 +490,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
 {
@@ -442,13 +501,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;
 }
@@ -585,6 +646,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 ) {
@@ -698,12 +760,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.
     #
-    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},
@@ -715,16 +781,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(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
@@ -757,7 +839,11 @@ sub NetBiosInfoGet
     #
     # 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},
@@ -769,34 +855,66 @@ 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(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;
     }
 }
 
@@ -925,7 +1043,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
@@ -959,12 +1077,17 @@ sub cmdExecOrEval
     
     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} );
+        exec(map { m/(.*)/ } @$cmd);           # untaint
         print(STDERR "Exec failed for @$cmd\n");
         exit(1);
     }
@@ -985,18 +1108,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(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;
@@ -1005,13 +1135,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);
        }
@@ -1022,10 +1153,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(STDERR "cmdSystemOrEval: finished: got output $allOut\n")
+                       if ( $bpc->{verbose} );
     return $out;
 }