1 #============================================================= -*-perl-*-
3 # BackupPC::Storage::Text package
7 # This library defines a BackupPC::Storage::Text class that implements
8 # BackupPC's persistent state storage (config, host info, backup
9 # and restore info) using text files.
12 # Craig Barratt <cbarratt@users.sourceforge.net>
15 # Copyright (C) 2004 Craig Barratt
17 # This program is free software; you can redistribute it and/or modify
18 # it under the terms of the GNU General Public License as published by
19 # the Free Software Foundation; either version 2 of the License, or
20 # (at your option) any later version.
22 # This program is distributed in the hope that it will be useful,
23 # but WITHOUT ANY WARRANTY; without even the implied warranty of
24 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
25 # GNU General Public License for more details.
27 # You should have received a copy of the GNU General Public License
28 # along with this program; if not, write to the Free Software
29 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
31 #========================================================================
33 # Version 2.1.0, released 20 Jun 2004.
35 # See http://backuppc.sourceforge.net.
37 #========================================================================
39 package BackupPC::Storage::Text;
50 my($flds, $paths) = @_;
64 foreach my $v ( keys(%$paths) ) {
65 $class->{$v} = $paths->{$v};
72 local(*BK_INFO, *LOCK);
75 flock(LOCK, LOCK_EX) if open(LOCK, "$s->{TopDir}/pc/$host/LOCK");
76 if ( open(BK_INFO, "$s->{TopDir}/pc/$host/backups") ) {
80 next if ( !/^(\d+\t(incr|full|partial).*)/ );
82 @{$Backups[@Backups]}{@{$s->{BackupFields}}} = split(/\t/);
92 my($s, $host, @Backups) = @_;
93 my($i, $contents, $fileOk);
96 # Generate the file contents
98 for ( $i = 0 ; $i < @Backups ; $i++ ) {
99 my %b = %{$Backups[$i]};
100 $contents .= join("\t", @b{@{$s->{BackupFields}}}) . "\n";
106 return $s->TextFileWrite("$s->{TopDir}/pc/$host", "backups", $contents);
112 local(*RESTORE_INFO, *LOCK);
115 flock(LOCK, LOCK_EX) if open(LOCK, "$s->{TopDir}/pc/$host/LOCK");
116 if ( open(RESTORE_INFO, "$s->{TopDir}/pc/$host/restores") ) {
117 binmode(RESTORE_INFO);
118 while ( <RESTORE_INFO> ) {
120 next if ( !/^(\d+.*)/ );
122 @{$Restores[@Restores]}{@{$s->{RestoreFields}}} = split(/\t/);
132 my($s, $host, @Restores) = @_;
133 local(*RESTORE_INFO, *LOCK);
134 my($i, $contents, $fileOk);
137 # Generate the file contents
139 for ( $i = 0 ; $i < @Restores ; $i++ ) {
140 my %b = %{$Restores[$i]};
141 $contents .= join("\t", @b{@{$s->{RestoreFields}}}) . "\n";
147 return $s->TextFileWrite("$s->{TopDir}/pc/$host", "restores", $contents);
153 local(*ARCHIVE_INFO, *LOCK);
156 flock(LOCK, LOCK_EX) if open(LOCK, "$s->{TopDir}/pc/$host/LOCK");
157 if ( open(ARCHIVE_INFO, "$s->{TopDir}/pc/$host/archives") ) {
158 binmode(ARCHIVE_INFO);
159 while ( <ARCHIVE_INFO> ) {
161 next if ( !/^(\d+.*)/ );
163 @{$Archives[@Archives]}{@{$s->{ArchiveFields}}} = split(/\t/);
173 my($s, $host, @Archives) = @_;
174 local(*ARCHIVE_INFO, *LOCK);
175 my($i, $contents, $fileOk);
178 # Generate the file contents
180 for ( $i = 0 ; $i < @Archives ; $i++ ) {
181 my %b = %{$Archives[$i]};
182 $contents .= join("\t", @b{@{$s->{ArchiveFields}}}) . "\n";
188 return $s->TextFileWrite("$s->{TopDir}/pc/$host", "archives", $contents);
192 # Write a text file as safely as possible. We write to
193 # a new file, verify the file, and the rename the file.
194 # The previous version of the file is renamed with a
199 my($s, $dir, $file, $contents) = @_;
203 mkpath($dir, 0, 0775) if ( !-d $dir );
204 if ( open(FD, ">", "$dir/$file.new") ) {
211 if ( open(FD, "<", "$dir/$file.new") ) {
213 if ( join("", <FD>) ne $contents ) {
214 return "TextFileWrite: Failed to verify $dir/$file.new";
224 if ( open(LOCK, "$dir/LOCK") || open(LOCK, ">", "$dir/LOCK") ) {
226 flock(LOCK, LOCK_EX);
228 if ( -s "$dir/$file" ) {
229 unlink("$dir/$file.old") if ( -f "$dir/$file.old" );
230 rename("$dir/$file", "$dir/$file.old") if ( -f "$dir/$file" );
232 unlink("$dir/$file") if ( -f "$dir/$file" );
234 rename("$dir/$file.new", "$dir/$file") if ( -f "$dir/$file.new" );
235 close(LOCK) if ( $lock );
237 return "TextFileWrite: Failed to write $dir/$file.new";
245 my($ret, $mesg, $config, @configs);
252 if ( defined($host) ) {
253 push(@configs, "$s->{TopDir}/conf/$host.pl")
254 if ( $host ne "config" && -f "$s->{TopDir}/conf/$host.pl" );
255 push(@configs, "$s->{TopDir}/pc/$host/config.pl")
256 if ( -f "$s->{TopDir}/pc/$host/config.pl" );
258 push(@configs, "$s->{TopDir}/conf/config.pl");
260 foreach $config ( @configs ) {
262 if ( !defined($ret = do $config) && ($! || $@) ) {
263 $mesg = "Couldn't open $config: $!" if ( $! );
264 $mesg = "Couldn't execute $config: $@" if ( $@ );
265 $mesg =~ s/[\n\r]+//;
266 return ($mesg, $conf);
268 %$conf = ( %$conf, %Conf );
271 # Promote BackupFilesOnly and BackupFilesExclude to hashes
273 foreach my $param qw(BackupFilesOnly BackupFilesExclude) {
274 next if ( !defined($conf->{$param}) || ref($conf->{$param}) eq "HASH" );
275 $conf->{$param} = [ $conf->{$param} ]
276 if ( ref($conf->{$param}) ne "ARRAY" );
277 $conf->{$param} = { "*" => $conf->{$param} };
280 return (undef, $conf);
285 my($s, $host, $newConf) = @_;
287 my($confDir) = $host eq "" ? "$s->{TopDir}/conf"
288 : "$s->{TopDir}/pc/$host";
290 my($err, $contents) = $s->ConfigFileMerge("$confDir/config.pl", $newConf);
291 if ( defined($err) ) {
297 return $s->TextFileWrite($confDir, "config.pl", $contents);
303 my($s, $inFile, $newConf) = @_;
313 # Match existing settings in current config file
316 || return ("ConfigFileMerge: can't open/read $inFile", undef);
320 if ( $comment && /^\s*#/ ) {
322 } elsif ( /^\s*\$Conf\{([^}]*)\}\s*=/ ) {
324 if ( exists($newConf->{$var}) ) {
326 my $d = Data::Dumper->new([$newConf->{$var}], [*value]);
329 my $value = $d->Dump;
330 $value =~ s/(.*)\n/$1;\n/s;
331 $contents .= "\$Conf{$var} = " . $value;
334 $endLine = $1 if ( /^\s*\$Conf\{[^}]*} *= *<<(.*);/ );
335 $endLine = $1 if ( /^\s*\$Conf\{[^}]*} *= *<<'(.*)';/ );
338 } elsif ( $skipVar ) {
339 if ( !defined($endLine) && (/^\s*[\r\n]*$/ || /^\s*#/) ) {
344 if ( defined($endLine) && /^\Q$endLine\E[\n\r]*$/ ) {
358 # Add new entries not matched in current config file
360 foreach my $var ( sort(keys(%$newConf)) ) {
361 next if ( $done->{$var} );
362 my $d = Data::Dumper->new([$newConf->{$var}], [*value]);
365 my $value = $d->Dump;
366 $value =~ s/(.*)\n/$1;\n/s;
367 $contents .= "\$Conf{$var} = " . $value;
370 return (undef, $contents);
374 # Return the mtime of the config file
379 return (stat("$s->{TopDir}/conf/config.pl"))[9];
383 # Returns information from the host file in $s->{TopDir}/conf/hosts.
384 # With no argument a ref to a hash of hosts is returned. Each
385 # hash contains fields as specified in the hosts file. With an
386 # argument a ref to a single hash is returned with information
387 # for just that host.
392 my(%hosts, @hdr, @fld);
393 local(*HOST_INFO, *LOCK);
395 flock(LOCK, LOCK_EX) if open(LOCK, "$s->{TopDir}/pc/$host/LOCK");
396 if ( !open(HOST_INFO, "$s->{TopDir}/conf/hosts") ) {
397 print(STDERR "Can't open $s->{TopDir}/conf/hosts\n");
402 while ( <HOST_INFO> ) {
406 next if ( /^\s*$/ || !/^([\w\.\\-]+\s+.*)/ );
408 # Split on white space, except if preceded by \
409 # using zero-width negative look-behind assertion
410 # (always wanted to use one of those).
412 @fld = split(/(?<!\\)\s+/, $1);
420 if ( defined($host) ) {
421 next if ( lc($fld[0]) ne lc($host) );
422 @{$hosts{$fld[0]}}{@hdr} = @fld;
427 @{$hosts{$fld[0]}}{@hdr} = @fld;
439 # Writes new hosts information to the hosts file in $s->{TopDir}/conf/hosts.
440 # With no argument a ref to a hash of hosts is returned. Each
441 # hash contains fields as specified in the hosts file. With an
442 # argument a ref to a single hash is returned with information
443 # for just that host.
448 my($gotHdr, @fld, $hostText, $contents);
451 if ( !open(HOST_INFO, "$s->{TopDir}/conf/hosts") ) {
452 return "Can't open $s->{TopDir}/conf/hosts";
454 foreach my $host ( keys(%$hosts) ) {
455 my $name = "$hosts->{$host}{host}";
456 my $rest = "\t$hosts->{$host}{dhcp}"
457 . "\t$hosts->{$host}{user}"
458 . "\t$hosts->{$host}{moreUsers}";
461 $hostText->{$host} = $name . $rest;
464 while ( <HOST_INFO> ) {
466 if ( /^\s*$/ || /^\s*#/ ) {
467 $contents .= $_ . "\n";
471 $contents .= $_ . "\n";
475 @fld = split(/(?<!\\)\s+/, $1);
482 if ( defined($hostText->{$fld[0]}) ) {
483 $contents .= $hostText->{$fld[0]} . "\n";
484 delete($hostText->{$fld[0]});
487 foreach my $host ( sort(keys(%$hostText)) ) {
488 $contents .= $hostText->{$host} . "\n";
489 delete($hostText->{$host});
494 # Write and verify the new host file
496 return $s->TextFileWrite("$s->{TopDir}/conf", "hosts", $contents);
500 # Return the mtime of the hosts file
505 return (stat("$s->{TopDir}/conf/hosts"))[9];