additional changes to it.pm (post 3.0.0beta2)
[BackupPC.git] / lib / BackupPC / Storage / Text.pm
index a93fb61..fa46af2 100644 (file)
@@ -30,7 +30,7 @@
 #
 #========================================================================
 #
 #
 #========================================================================
 #
-# Version 2.1.0, released 20 Jun 2004.
+# Version 3.0.0beta2, released 11 Nov 2006.
 #
 # See http://backuppc.sourceforge.net.
 #
 #
 # See http://backuppc.sourceforge.net.
 #
@@ -41,6 +41,7 @@ package BackupPC::Storage::Text;
 use strict;
 use vars qw(%Conf);
 use Data::Dumper;
 use strict;
 use vars qw(%Conf);
 use Data::Dumper;
+use File::Path;
 use Fcntl qw/:flock/;
 
 sub new
 use Fcntl qw/:flock/;
 
 sub new
@@ -55,6 +56,16 @@ sub new
     return $s;
 }
 
     return $s;
 }
 
+sub setPaths
+{
+    my $class = shift;
+    my($paths) = @_;
+
+    foreach my $v ( keys(%$paths) ) {
+        $class->{$v} = $paths->{$v};
+    }
+}
+
 sub BackupInfoRead
 {
     my($s, $host) = @_;
 sub BackupInfoRead
 {
     my($s, $host) = @_;
@@ -66,7 +77,7 @@ sub BackupInfoRead
        binmode(BK_INFO);
         while ( <BK_INFO> ) {
             s/[\n\r]+//;
        binmode(BK_INFO);
         while ( <BK_INFO> ) {
             s/[\n\r]+//;
-            next if ( !/^(\d+\t(incr|full|partial)[\d\t]*$)/ );
+            next if ( !/^(\d+\t(incr|full|partial).*)/ );
             $_ = $1;
             @{$Backups[@Backups]}{@{$s->{BackupFields}}} = split(/\t/);
         }
             $_ = $1;
             @{$Backups[@Backups]}{@{$s->{BackupFields}}} = split(/\t/);
         }
@@ -79,26 +90,20 @@ sub BackupInfoRead
 sub BackupInfoWrite
 {
     my($s, $host, @Backups) = @_;
 sub BackupInfoWrite
 {
     my($s, $host, @Backups) = @_;
-    local(*BK_INFO, *LOCK);
-    my($i);
+    my($i, $contents, $fileOk);
 
 
-    flock(LOCK, LOCK_EX) if open(LOCK, "$s->{TopDir}/pc/$host/LOCK");
-    if ( -s "$s->{TopDir}/pc/$host/backups" ) {
-       unlink("$s->{TopDir}/pc/$host/backups.old")
-                   if ( -f "$s->{TopDir}/pc/$host/backups.old" );
-       rename("$s->{TopDir}/pc/$host/backups",
-              "$s->{TopDir}/pc/$host/backups.old")
-                   if ( -f "$s->{TopDir}/pc/$host/backups" );
-    }
-    if ( open(BK_INFO, ">$s->{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{@{$s->{BackupFields}}}));
-        }
-        close(BK_INFO);
+    #
+    # Generate the file contents
+    #
+    for ( $i = 0 ; $i < @Backups ; $i++ ) {
+        my %b = %{$Backups[$i]};
+        $contents .= join("\t", @b{@{$s->{BackupFields}}}) . "\n";
     }
     }
-    close(LOCK);
+    
+    #
+    # Write the file
+    #
+    return $s->TextFileWrite("$s->{TopDir}/pc/$host/backups", $contents);
 }
 
 sub RestoreInfoRead
 }
 
 sub RestoreInfoRead
@@ -126,26 +131,20 @@ sub RestoreInfoWrite
 {
     my($s, $host, @Restores) = @_;
     local(*RESTORE_INFO, *LOCK);
 {
     my($s, $host, @Restores) = @_;
     local(*RESTORE_INFO, *LOCK);
-    my($i);
+    my($i, $contents, $fileOk);
 
 
-    flock(LOCK, LOCK_EX) if open(LOCK, "$s->{TopDir}/pc/$host/LOCK");
-    if ( -s "$s->{TopDir}/pc/$host/restores" ) {
-       unlink("$s->{TopDir}/pc/$host/restores.old")
-                   if ( -f "$s->{TopDir}/pc/$host/restores.old" );
-       rename("$s->{TopDir}/pc/$host/restores",
-              "$s->{TopDir}/pc/$host/restores.old")
-                   if ( -f "$s->{TopDir}/pc/$host/restores" );
-    }
-    if ( open(RESTORE_INFO, ">$s->{TopDir}/pc/$host/restores") ) {
-       binmode(RESTORE_INFO);
-        for ( $i = 0 ; $i < @Restores ; $i++ ) {
-            my %b = %{$Restores[$i]};
-            printf(RESTORE_INFO "%s\n",
-                        join("\t", @b{@{$s->{RestoreFields}}}));
-        }
-        close(RESTORE_INFO);
+    #
+    # Generate the file contents
+    #
+    for ( $i = 0 ; $i < @Restores ; $i++ ) {
+        my %b = %{$Restores[$i]};
+        $contents .= join("\t", @b{@{$s->{RestoreFields}}}) . "\n";
     }
     }
-    close(LOCK);
+
+    #
+    # Write the file
+    #
+    return $s->TextFileWrite("$s->{TopDir}/pc/$host/restores", $contents);
 }
 
 sub ArchiveInfoRead
 }
 
 sub ArchiveInfoRead
@@ -173,26 +172,89 @@ sub ArchiveInfoWrite
 {
     my($s, $host, @Archives) = @_;
     local(*ARCHIVE_INFO, *LOCK);
 {
     my($s, $host, @Archives) = @_;
     local(*ARCHIVE_INFO, *LOCK);
-    my($i);
+    my($i, $contents, $fileOk);
 
 
-    flock(LOCK, LOCK_EX) if open(LOCK, "$s->{TopDir}/pc/$host/LOCK");
-    if ( -s "$s->{TopDir}/pc/$host/archives" ) {
-       unlink("$s->{TopDir}/pc/$host/archives.old")
-                   if ( -f "$s->{TopDir}/pc/$host/archives.old" );
-       rename("$s->{TopDir}/pc/$host/archives",
-              "$s->{TopDir}/pc/$host/archives.old")
-                   if ( -f "$s->{TopDir}/pc/$host/archives" );
+    #
+    # Generate the file contents
+    #
+    for ( $i = 0 ; $i < @Archives ; $i++ ) {
+        my %b = %{$Archives[$i]};
+        $contents .= join("\t", @b{@{$s->{ArchiveFields}}}) . "\n";
     }
     }
-    if ( open(ARCHIVE_INFO, ">$s->{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{@{$s->{ArchiveFields}}}));
+
+    #
+    # Write the file
+    #
+    return $s->TextFileWrite("$s->{TopDir}/pc/$host/archives", $contents);
+}
+
+#
+# Write a text file as safely as possible.  We write to
+# a new file, verify the file, and the rename the file.
+# The previous version of the file is renamed with a
+# .old extension.
+#
+sub TextFileWrite
+{
+    my($s, $file, $contents) = @_;
+    local(*FD, *LOCK);
+    my($fileOk);
+
+    (my $dir = $file) =~ s{(.+)/(.+)}{$1};
+
+    mkpath($dir, 0, 0775) if ( !-d $dir );
+    if ( open(FD, ">", "$file.new") ) {
+       binmode(FD);
+        print FD $contents;
+        close(FD);
+        #
+        # verify the file
+        #
+        if ( open(FD, "<", "$file.new") ) {
+            binmode(FD);
+            if ( join("", <FD>) ne $contents ) {
+                return "TextFileWrite: Failed to verify $file.new";
+            } else {
+                $fileOk = 1;
+            }
+            close(FD);
         }
         }
-        close(ARCHIVE_INFO);
     }
     }
-    close(LOCK);
+    if ( $fileOk ) {
+        my $lock;
+        
+        if ( open(LOCK, "$dir/LOCK") || open(LOCK, ">", "$dir/LOCK") ) {
+            $lock = 1;
+            flock(LOCK, LOCK_EX);
+        }
+        if ( -s "$file" ) {
+            unlink("$file.old")           if ( -f "$file.old" );
+            rename("$file", "$file.old")  if ( -f "$file" );
+        } else {
+            unlink("$file") if ( -f "$file" );
+        }
+        rename("$file.new", "$file") if ( -f "$file.new" );
+        close(LOCK) if ( $lock );
+    } else {
+        return "TextFileWrite: Failed to write $file.new";
+    }
+    return;
+}
+
+sub ConfigPath
+{
+    my($s, $host) = @_;
+
+    return "$s->{ConfDir}/config.pl" if ( !defined($host) );
+    if ( $s->{useFHS} ) {
+        return "$s->{ConfDir}/pc/$host.pl";
+    } else {
+        return "$s->{TopDir}/pc/$host/config.pl"
+            if ( -f "$s->{TopDir}/pc/$host/config.pl" );
+        return "$s->{ConfDir}/$host.pl"
+            if ( $host ne "config" && -f "$s->{ConfDir}/$host.pl" );
+        return "$s->{ConfDir}/pc/$host.pl";
+    }
 }
 
 sub ConfigDataRead
 }
 
 sub ConfigDataRead
@@ -204,15 +266,9 @@ sub ConfigDataRead
     # TODO: add lock
     #
     my $conf = {};
     # TODO: add lock
     #
     my $conf = {};
+    my $configPath = $s->ConfigPath($host);
 
 
-    if ( defined($host) ) {
-       push(@configs, "$s->{TopDir}/conf/$host.pl")
-               if ( $host ne "config" && -f "$s->{TopDir}/conf/$host.pl" );
-       push(@configs, "$s->{TopDir}/pc/$host/config.pl")
-               if ( -f "$s->{TopDir}/pc/$host/config.pl" );
-    } else {
-       push(@configs, "$s->{TopDir}/conf/config.pl");
-    }
+    push(@configs, $configPath) if ( -f $configPath );
     foreach $config ( @configs ) {
         %Conf = ();
         if ( !defined($ret = do $config) && ($! || $@) ) {
     foreach $config ( @configs ) {
         %Conf = ();
         if ( !defined($ret = do $config) && ($! || $@) ) {
@@ -223,6 +279,33 @@ sub ConfigDataRead
         }
         %$conf = ( %$conf, %Conf );
     }
         }
         %$conf = ( %$conf, %Conf );
     }
+    #
+    # Promote BackupFilesOnly and BackupFilesExclude to hashes
+    #
+    foreach my $param qw(BackupFilesOnly BackupFilesExclude) {
+        next if ( !defined($conf->{$param}) || ref($conf->{$param}) eq "HASH" );
+        $conf->{$param} = [ $conf->{$param} ]
+                                if ( ref($conf->{$param}) ne "ARRAY" );
+        $conf->{$param} = { "*" => $conf->{$param} };
+    }
+
+    #
+    # Handle backward compatibility with defunct BlackoutHourBegin,
+    # BlackoutHourEnd, and BlackoutWeekDays parameters.
+    #
+    if ( defined($conf->{BlackoutHourBegin}) ) {
+        push(@{$conf->{BlackoutPeriods}},
+             {
+                 hourBegin => $conf->{BlackoutHourBegin},
+                 hourEnd   => $conf->{BlackoutHourEnd},
+                 weekDays  => $conf->{BlackoutWeekDays},
+             }
+        );
+        delete($conf->{BlackoutHourBegin});
+        delete($conf->{BlackoutHourEnd});
+        delete($conf->{BlackoutWeekDays});
+    }
+
     return (undef, $conf);
 }
 
     return (undef, $conf);
 }
 
@@ -230,69 +313,68 @@ sub ConfigDataWrite
 {
     my($s, $host, $newConf) = @_;
 
 {
     my($s, $host, $newConf) = @_;
 
-    my($confPath) = $host eq "" ? "$s->{TopDir}/conf/config.pl"
-                               : "$s->{TopDir}/pc/$host/config.pl";
+    my $configPath = $s->ConfigPath($host);
 
 
-    my $err = $s->ConfigFileMerge($confPath, "$confPath.new", $newConf);
-    #
-    # TODO: add lock and rename
-    #
+    my($err, $contents) = $s->ConfigFileMerge("$configPath", $newConf);
+    if ( defined($err) ) {
+        return $err;
+    } else {
+        #
+        # Write the file
+        #
+        return $s->TextFileWrite($configPath, $contents);
+    }
 }
 
 sub ConfigFileMerge
 {
 }
 
 sub ConfigFileMerge
 {
-    my($s, $inFile, $outFile, $newConf) = @_;
-
-    open(C, $inFile) || return "ConfigFileMerge: can't open/read $inFile";
-    binmode(C);
-
-    open(OUT, ">", $outFile)
-                    || return "ConfigFileMerge: can't open/write $outFile";
-    binmode(OUT);
-
-    my($out);
-    my $comment = 1;
-    my $skipVar = 0;
-    my $endLine = undef;
+    my($s, $inFile, $newConf) = @_;
+    local(*C);
+    my($contents, $skipExpr, $fakeVar);
     my $done = {};
 
     my $done = {};
 
-    while ( <C> ) {
-       if ( $comment && /^\s*#/ ) {
-           $out .= $_;
-       } elsif ( /^\s*\$Conf\{([^}]*)\}\s*=/ ) {
-           my $var = $1;
-           if ( exists($newConf->{$var}) ) { 
-               print OUT $out;
-               my $d = Data::Dumper->new([$newConf->{$var}], [*value]);
-               $d->Indent(1);
-               $d->Terse(1);
-               my $value = $d->Dump;
-               $value =~ s/(.*)\n/$1;\n/s;
-               print OUT "\$Conf{$var} = ", $value;
-               $done->{$var} = 1;
-           }
-           $endLine = $1 if ( /^\s*\$Conf\{[^}]*} *= *<<(.*);/ );
-           $endLine = $1 if ( /^\s*\$Conf\{[^}]*} *= *<<'(.*)';/ );
-           $out = "";
-           $skipVar = 1;
-       } elsif ( $skipVar ) {
-           if ( !defined($endLine) && (/^\s*[\r\n]*$/ || /^\s*#/) ) {
-               $skipVar = 0;
-               $comment = 1;
-               $out .= $_;
-           }
-           if ( defined($endLine) && /^\Q$endLine\E[\n\r]*$/ ) {
-               $endLine = undef;
-               $skipVar = 0;
-               $comment = 1;
-           }
-       } else {
-           $out .= $_;
-       }
-    }
-    if ( $out ne "" ) {
-       print OUT $out;
+    if ( -f $inFile ) {
+        #
+        # Match existing settings in current config file
+        #
+        open(C, $inFile)
+            || return ("ConfigFileMerge: can't open/read $inFile", undef);
+        binmode(C);
+
+        while ( <C> ) {
+            if ( /^\s*\$Conf\{([^}]*)\}\s*=(.*)/ ) {
+                my $var = $1;
+                if ( exists($newConf->{$var}) ) {
+                    $skipExpr = "\$fakeVar = $2\n";
+                    my $d = Data::Dumper->new([$newConf->{$var}], [*value]);
+                    $d->Indent(1);
+                    $d->Terse(1);
+                    my $value = $d->Dump;
+                    $value =~ s/(.*)\n/$1;\n/s;
+                    $contents .= "\$Conf{$var} = " . $value;
+                    $done->{$var} = 1;
+                }
+            } elsif ( defined($skipExpr) ) {
+                $skipExpr .= $_;
+            } else {
+                $contents .= $_;
+            }
+            if ( defined($skipExpr) ) {
+                #
+                # if we have a complete expression, then we are done
+                # skipping text from the original config file.
+                #
+                $skipExpr = $1 if ( $skipExpr =~ /(.*)/s );
+                eval($skipExpr);
+                $skipExpr = undef if ( $@ eq "" );
+            }
+        }
+        close(C);
     }
     }
+
+    #
+    # Add new entries not matched in current config file
+    #
     foreach my $var ( sort(keys(%$newConf)) ) {
        next if ( $done->{$var} );
        my $d = Data::Dumper->new([$newConf->{$var}], [*value]);
     foreach my $var ( sort(keys(%$newConf)) ) {
        next if ( $done->{$var} );
        my $d = Data::Dumper->new([$newConf->{$var}], [*value]);
@@ -300,11 +382,10 @@ sub ConfigFileMerge
        $d->Terse(1);
        my $value = $d->Dump;
        $value =~ s/(.*)\n/$1;\n/s;
        $d->Terse(1);
        my $value = $d->Dump;
        $value =~ s/(.*)\n/$1;\n/s;
-       print OUT "\$Conf{$var} = ", $value;
+       $contents .= "\$Conf{$var} = " . $value;
        $done->{$var} = 1;
     }
        $done->{$var} = 1;
     }
-    close(C);
-    close(OUT);
+    return (undef, $contents);
 }
 
 #
 }
 
 #
@@ -313,11 +394,11 @@ sub ConfigFileMerge
 sub ConfigMTime
 {
     my($s) = @_;
 sub ConfigMTime
 {
     my($s) = @_;
-    return (stat("$s->{TopDir}/conf/config.pl"))[9];
+    return (stat($s->ConfigPath()))[9];
 }
 
 #
 }
 
 #
-# Returns information from the host file in $s->{TopDir}/conf/hosts.
+# Returns information from the host file in $s->{ConfDir}/hosts.
 # With no argument a ref to a hash of hosts is returned.  Each
 # hash contains fields as specified in the hosts file.  With an
 # argument a ref to a single hash is returned with information
 # With no argument a ref to a hash of hosts is returned.  Each
 # hash contains fields as specified in the hosts file.  With an
 # argument a ref to a single hash is returned with information
@@ -327,11 +408,12 @@ sub HostInfoRead
 {
     my($s, $host) = @_;
     my(%hosts, @hdr, @fld);
 {
     my($s, $host) = @_;
     my(%hosts, @hdr, @fld);
-    local(*HOST_INFO);
+    local(*HOST_INFO, *LOCK);
 
 
-    if ( !open(HOST_INFO, "$s->{TopDir}/conf/hosts") ) {
-        print(STDERR $s->timeStamp,
-                     "Can't open $s->{TopDir}/conf/hosts\n");
+    flock(LOCK, LOCK_EX) if open(LOCK, "$s->{ConfDir}/LOCK");
+    if ( !open(HOST_INFO, "$s->{ConfDir}/hosts") ) {
+        print(STDERR "Can't open $s->{ConfDir}/hosts\n");
+        close(LOCK);
         return {};
     }
     binmode(HOST_INFO);
         return {};
     }
     binmode(HOST_INFO);
@@ -354,9 +436,10 @@ sub HostInfoRead
         }
         if ( @hdr ) {
             if ( defined($host) ) {
         }
         if ( @hdr ) {
             if ( defined($host) ) {
-                next if ( lc($fld[0]) ne $host );
+                next if ( lc($fld[0]) ne lc($host) );
                 @{$hosts{lc($fld[0])}}{@hdr} = @fld;
                close(HOST_INFO);
                 @{$hosts{lc($fld[0])}}{@hdr} = @fld;
                close(HOST_INFO);
+                close(LOCK);
                 return \%hosts;
             } else {
                 @{$hosts{lc($fld[0])}}{@hdr} = @fld;
                 return \%hosts;
             } else {
                 @{$hosts{lc($fld[0])}}{@hdr} = @fld;
@@ -366,16 +449,78 @@ sub HostInfoRead
         }
     }
     close(HOST_INFO);
         }
     }
     close(HOST_INFO);
+    close(LOCK);
     return \%hosts;
 }
 
     return \%hosts;
 }
 
+#
+# Writes new hosts information to the hosts file in $s->{ConfDir}/hosts.
+# With no argument a ref to a hash of hosts is returned.  Each
+# hash contains fields as specified in the hosts file.  With an
+# argument a ref to a single hash is returned with information
+# for just that host.
+#
+sub HostInfoWrite
+{
+    my($s, $hosts) = @_;
+    my($gotHdr, @fld, $hostText, $contents);
+    local(*HOST_INFO);
+
+    if ( !open(HOST_INFO, "$s->{ConfDir}/hosts") ) {
+        return "Can't open $s->{ConfDir}/hosts";
+    }
+    foreach my $host ( keys(%$hosts) ) {
+        my $name = "$hosts->{$host}{host}";
+        my $rest = "\t$hosts->{$host}{dhcp}"
+                 . "\t$hosts->{$host}{user}"
+                 . "\t$hosts->{$host}{moreUsers}";
+        $name =~ s/ /\\ /g;
+        $rest =~ s/ //g;
+        $hostText->{$host} = $name . $rest;
+    }
+    binmode(HOST_INFO);
+    while ( <HOST_INFO> ) {
+        s/[\n\r]+//;
+        if ( /^\s*$/ || /^\s*#/ ) {
+            $contents .= $_ . "\n";
+            next;
+        }
+        if ( !$gotHdr ) {
+            $contents .= $_ . "\n";
+            $gotHdr = 1;
+            next;
+        }
+        @fld = split(/(?<!\\)\s+/, $1);
+        #
+        # Remove any \
+        #
+        foreach ( @fld ) {
+            s{\\(\s)}{$1}g;
+        }
+        if ( defined($hostText->{$fld[0]}) ) {
+            $contents .= $hostText->{$fld[0]} . "\n";
+            delete($hostText->{$fld[0]});
+        }
+    }
+    foreach my $host ( sort(keys(%$hostText)) ) {
+        $contents .= $hostText->{$host} . "\n";
+        delete($hostText->{$host});
+    }
+    close(HOST_INFO);
+
+    #
+    # Write and verify the new host file
+    #
+    return $s->TextFileWrite("$s->{ConfDir}/hosts", $contents);
+}
+
 #
 # Return the mtime of the hosts file
 #
 sub HostsMTime
 {
     my($s) = @_;
 #
 # Return the mtime of the hosts file
 #
 sub HostsMTime
 {
     my($s) = @_;
-    return (stat("$s->{TopDir}/conf/hosts"))[9];
+    return (stat("$s->{ConfDir}/hosts"))[9];
 }
 
 1;
 }
 
 1;