lib/BackupPC/Storage/Text.pm

   1 #============================================================= -*-perl-*-
   2 #
   3 # BackupPC::Storage::Text package
   4 #
   5 # DESCRIPTION
   6 #
   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.
  10 #
  11 # AUTHOR
  12 #   Craig Barratt  <cbarratt@users.sourceforge.net>
  13 #
  14 # COPYRIGHT
  15 #   Copyright (C) 2004  Craig Barratt
  16 #
  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.
  21 #
  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.
  26 #
  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
  30 #
  31 #========================================================================
  32 #
  33 # Version 3.0.0, released 28 Jan 2007.
  34 #
  35 # See http://backuppc.sourceforge.net.
  36 #
  37 #========================================================================
  38
  39 package BackupPC::Storage::Text;
  40
  41 use strict;
  42 use vars qw(%Conf);
  43 use Data::Dumper;
  44 use File::Path;
  45 use Fcntl qw/:flock/;
  46
  47 sub new
  48 {
  49     my $class = shift;
  50     my($flds, $paths) = @_;
  51
  52     my $s = bless {
  53         %$flds,
  54         %$paths,
  55     }, $class;
  56     return $s;
  57 }
  58
  59 sub setPaths
  60 {
  61     my $class = shift;
  62     my($paths) = @_;
  63
  64     foreach my $v ( keys(%$paths) ) {
  65         $class->{$v} = $paths->{$v};
  66     }
  67 }
  68
  69 sub BackupInfoRead
  70 {
  71     my($s, $host) = @_;
  72     local(*BK_INFO, *LOCK);
  73     my(@Backups);
  74
  75     flock(LOCK, LOCK_EX) if open(LOCK, "$s->{TopDir}/pc/$host/LOCK");
  76     if ( open(BK_INFO, "$s->{TopDir}/pc/$host/backups") ) {
  77         binmode(BK_INFO);
  78         while ( <BK_INFO> ) {
  79             s/[\n\r]+//;
  80             next if ( !/^(\d+\t(incr|full|partial).*)/ );
  81             $_ = $1;
  82             @{$Backups[@Backups]}{@{$s->{BackupFields}}} = split(/\t/);
  83         }
  84         close(BK_INFO);
  85     }
  86     close(LOCK);
  87     #
  88     # Default the level and version fields if not present
  89     #
  90     for ( my $i = 0 ; $i < @Backups ; $i++ ) {
  91         if ( defined($Backups[$i]{level}) ) {
  92             if ( !defined($Backups[$i]{version}) ) {
  93                 $Backups[$i]{version} = "3.0.0";
  94             }
  95         } else {
  96             $Backups[$i]{level} = $Backups[$i]{type} eq "incr" ? 1 : 0;
  97             $Backups[$i]{version} = "2.1.2";
  98         }
  99     }
 100     return @Backups;
 101 }
 102
 103 sub BackupInfoWrite
 104 {
 105     my($s, $host, @Backups) = @_;
 106     my($i, $contents, $fileOk);
 107
 108     #
 109     # Generate the file contents
 110     #
 111     for ( $i = 0 ; $i < @Backups ; $i++ ) {
 112         my %b = %{$Backups[$i]};
 113         $contents .= join("\t", @b{@{$s->{BackupFields}}}) . "\n";
 114     }
 115
 116     #
 117     # Write the file
 118     #
 119     return $s->TextFileWrite("$s->{TopDir}/pc/$host/backups", $contents);
 120 }
 121
 122 sub RestoreInfoRead
 123 {
 124     my($s, $host) = @_;
 125     local(*RESTORE_INFO, *LOCK);
 126     my(@Restores);
 127
 128     flock(LOCK, LOCK_EX) if open(LOCK, "$s->{TopDir}/pc/$host/LOCK");
 129     if ( open(RESTORE_INFO, "$s->{TopDir}/pc/$host/restores") ) {
 130         binmode(RESTORE_INFO);
 131         while ( <RESTORE_INFO> ) {
 132             s/[\n\r]+//;
 133             next if ( !/^(\d+.*)/ );
 134             $_ = $1;
 135             @{$Restores[@Restores]}{@{$s->{RestoreFields}}} = split(/\t/);
 136         }
 137         close(RESTORE_INFO);
 138     }
 139     close(LOCK);
 140     return @Restores;
 141 }
 142
 143 sub RestoreInfoWrite
 144 {
 145     my($s, $host, @Restores) = @_;
 146     local(*RESTORE_INFO, *LOCK);
 147     my($i, $contents, $fileOk);
 148
 149     #
 150     # Generate the file contents
 151     #
 152     for ( $i = 0 ; $i < @Restores ; $i++ ) {
 153         my %b = %{$Restores[$i]};
 154         $contents .= join("\t", @b{@{$s->{RestoreFields}}}) . "\n";
 155     }
 156
 157     #
 158     # Write the file
 159     #
 160     return $s->TextFileWrite("$s->{TopDir}/pc/$host/restores", $contents);
 161 }
 162
 163 sub ArchiveInfoRead
 164 {
 165     my($s, $host) = @_;
 166     local(*ARCHIVE_INFO, *LOCK);
 167     my(@Archives);
 168
 169     flock(LOCK, LOCK_EX) if open(LOCK, "$s->{TopDir}/pc/$host/LOCK");
 170     if ( open(ARCHIVE_INFO, "$s->{TopDir}/pc/$host/archives") ) {
 171         binmode(ARCHIVE_INFO);
 172         while ( <ARCHIVE_INFO> ) {
 173             s/[\n\r]+//;
 174             next if ( !/^(\d+.*)/ );
 175             $_ = $1;
 176             @{$Archives[@Archives]}{@{$s->{ArchiveFields}}} = split(/\t/);
 177         }
 178         close(ARCHIVE_INFO);
 179     }
 180     close(LOCK);
 181     return @Archives;
 182 }
 183
 184 sub ArchiveInfoWrite
 185 {
 186     my($s, $host, @Archives) = @_;
 187     local(*ARCHIVE_INFO, *LOCK);
 188     my($i, $contents, $fileOk);
 189
 190     #
 191     # Generate the file contents
 192     #
 193     for ( $i = 0 ; $i < @Archives ; $i++ ) {
 194         my %b = %{$Archives[$i]};
 195         $contents .= join("\t", @b{@{$s->{ArchiveFields}}}) . "\n";
 196     }
 197
 198     #
 199     # Write the file
 200     #
 201     return $s->TextFileWrite("$s->{TopDir}/pc/$host/archives", $contents);
 202 }
 203
 204 #
 205 # Write a text file as safely as possible.  We write to
 206 # a new file, verify the file, and the rename the file.
 207 # The previous version of the file is renamed with a
 208 # .old extension.
 209 #
 210 sub TextFileWrite
 211 {
 212     my($s, $file, $contents) = @_;
 213     local(*FD, *LOCK);
 214     my($fileOk);
 215
 216     (my $dir = $file) =~ s{(.+)/(.+)}{$1};
 217
 218     mkpath($dir, 0, 0775) if ( !-d $dir );
 219     if ( open(FD, ">", "$file.new") ) {
 220         binmode(FD);
 221         print FD $contents;
 222         close(FD);
 223         #
 224         # verify the file
 225         #
 226         if ( open(FD, "<", "$file.new") ) {
 227             binmode(FD);
 228             if ( join("", <FD>) ne $contents ) {
 229                 return "TextFileWrite: Failed to verify $file.new";
 230             } else {
 231                 $fileOk = 1;
 232             }
 233             close(FD);
 234         }
 235     }
 236     if ( $fileOk ) {
 237         my $lock;
 238
 239         if ( open(LOCK, "$dir/LOCK") || open(LOCK, ">", "$dir/LOCK") ) {
 240             $lock = 1;
 241             flock(LOCK, LOCK_EX);
 242         }
 243         if ( -s "$file" ) {
 244             unlink("$file.old")           if ( -f "$file.old" );
 245             rename("$file", "$file.old")  if ( -f "$file" );
 246         } else {
 247             unlink("$file") if ( -f "$file" );
 248         }
 249         rename("$file.new", "$file") if ( -f "$file.new" );
 250         close(LOCK) if ( $lock );
 251     } else {
 252         return "TextFileWrite: Failed to write $file.new";
 253     }
 254     return;
 255 }
 256
 257 sub ConfigPath
 258 {
 259     my($s, $host) = @_;
 260
 261     return "$s->{ConfDir}/config.pl" if ( !defined($host) );
 262     if ( $s->{useFHS} ) {
 263         return "$s->{ConfDir}/pc/$host.pl";
 264     } else {
 265         return "$s->{TopDir}/pc/$host/config.pl"
 266             if ( -f "$s->{TopDir}/pc/$host/config.pl" );
 267         return "$s->{ConfDir}/$host.pl"
 268             if ( $host ne "config" && -f "$s->{ConfDir}/$host.pl" );
 269         return "$s->{ConfDir}/pc/$host.pl";
 270     }
 271 }
 272
 273 sub ConfigDataRead
 274 {
 275     my($s, $host) = @_;
 276     my($ret, $mesg, $config, @configs);
 277
 278     #
 279     # TODO: add lock
 280     #
 281     my $conf = {};
 282     my $configPath = $s->ConfigPath($host);
 283
 284     push(@configs, $configPath) if ( -f $configPath );
 285     foreach $config ( @configs ) {
 286         %Conf = ();
 287         if ( !defined($ret = do $config) && ($! || $@) ) {
 288             $mesg = "Couldn't open $config: $!" if ( $! );
 289             $mesg = "Couldn't execute $config: $@" if ( $@ );
 290             $mesg =~ s/[\n\r]+//;
 291             return ($mesg, $conf);
 292         }
 293         %$conf = ( %$conf, %Conf );
 294     }
 295
 296     #
 297     # Promote BackupFilesOnly and BackupFilesExclude to hashes
 298     #
 299     foreach my $param qw(BackupFilesOnly BackupFilesExclude) {
 300         next if ( !defined($conf->{$param}) || ref($conf->{$param}) eq "HASH" );
 301         $conf->{$param} = [ $conf->{$param} ]
 302                                 if ( ref($conf->{$param}) ne "ARRAY" );
 303         $conf->{$param} = { "*" => $conf->{$param} };
 304     }
 305
 306     #
 307     # Handle backward compatibility with defunct BlackoutHourBegin,
 308     # BlackoutHourEnd, and BlackoutWeekDays parameters.
 309     #
 310     if ( defined($conf->{BlackoutHourBegin}) ) {
 311         push(@{$conf->{BlackoutPeriods}},
 312              {
 313                  hourBegin => $conf->{BlackoutHourBegin},
 314                  hourEnd   => $conf->{BlackoutHourEnd},
 315                  weekDays  => $conf->{BlackoutWeekDays},
 316              }
 317         );
 318         delete($conf->{BlackoutHourBegin});
 319         delete($conf->{BlackoutHourEnd});
 320         delete($conf->{BlackoutWeekDays});
 321     }
 322
 323     #
 324     # Make sure IncrLevels is defined
 325     #
 326     $conf->{IncrLevels} = [1] if ( !defined($conf->{IncrLevels}) );
 327
 328     return (undef, $conf);
 329 }
 330
 331 sub ConfigDataWrite
 332 {
 333     my($s, $host, $newConf) = @_;
 334
 335     my $configPath = $s->ConfigPath($host);
 336
 337     my($err, $contents) = $s->ConfigFileMerge("$configPath", $newConf);
 338     if ( defined($err) ) {
 339         return $err;
 340     } else {
 341         #
 342         # Write the file
 343         #
 344         return $s->TextFileWrite($configPath, $contents);
 345     }
 346 }
 347
 348 sub ConfigFileMerge
 349 {
 350     my($s, $inFile, $newConf) = @_;
 351     local(*C);
 352     my($contents, $skipExpr, $fakeVar);
 353     my $done = {};
 354
 355     if ( -f $inFile ) {
 356         #
 357         # Match existing settings in current config file
 358         #
 359         open(C, $inFile)
 360             || return ("ConfigFileMerge: can't open/read $inFile", undef);
 361         binmode(C);
 362
 363         while ( <C> ) {
 364             if ( /^\s*\$Conf\{([^}]*)\}\s*=(.*)/ ) {
 365                 my $var = $1;
 366                 $skipExpr = "\$fakeVar = $2\n";
 367                 if ( exists($newConf->{$var}) ) {
 368                     my $d = Data::Dumper->new([$newConf->{$var}], [*value]);
 369                     $d->Indent(1);
 370                     $d->Terse(1);
 371                     my $value = $d->Dump;
 372                     $value =~ s/(.*)\n/$1;\n/s;
 373                     $contents .= "\$Conf{$var} = " . $value;
 374                     $done->{$var} = 1;
 375                 }
 376             } elsif ( defined($skipExpr) ) {
 377                 $skipExpr .= $_;
 378             } else {
 379                 $contents .= $_;
 380             }
 381             if ( defined($skipExpr)
 382                     && ($skipExpr =~ /^\$fakeVar = *<</
 383                         || $skipExpr =~ /;[\n\r]*$/) ) {
 384                 #
 385                 # if we have a complete expression, then we are done
 386                 # skipping text from the original config file.
 387                 #
 388                 $skipExpr = $1 if ( $skipExpr =~ /(.*)/s );
 389                 eval($skipExpr);
 390                 $skipExpr = undef if ( $@ eq "" );
 391             }
 392         }
 393         close(C);
 394     }
 395
 396     #
 397     # Add new entries not matched in current config file
 398     #
 399     foreach my $var ( sort(keys(%$newConf)) ) {
 400         next if ( $done->{$var} );
 401         my $d = Data::Dumper->new([$newConf->{$var}], [*value]);
 402         $d->Indent(1);
 403         $d->Terse(1);
 404         my $value = $d->Dump;
 405         $value =~ s/(.*)\n/$1;\n/s;
 406         $contents .= "\$Conf{$var} = " . $value;
 407         $done->{$var} = 1;
 408     }
 409     return (undef, $contents);
 410 }
 411
 412 #
 413 # Return the mtime of the config file
 414 #
 415 sub ConfigMTime
 416 {
 417     my($s) = @_;
 418     return (stat($s->ConfigPath()))[9];
 419 }
 420
 421 #
 422 # Returns information from the host file in $s->{ConfDir}/hosts.
 423 # With no argument a ref to a hash of hosts is returned.  Each
 424 # hash contains fields as specified in the hosts file.  With an
 425 # argument a ref to a single hash is returned with information
 426 # for just that host.
 427 #
 428 sub HostInfoRead
 429 {
 430     my($s, $host) = @_;
 431     my(%hosts, @hdr, @fld);
 432     local(*HOST_INFO, *LOCK);
 433
 434     flock(LOCK, LOCK_EX) if open(LOCK, "$s->{ConfDir}/LOCK");
 435     if ( !open(HOST_INFO, "$s->{ConfDir}/hosts") ) {
 436         print(STDERR "Can't open $s->{ConfDir}/hosts\n");
 437         close(LOCK);
 438         return {};
 439     }
 440     binmode(HOST_INFO);
 441     while ( <HOST_INFO> ) {
 442         s/[\n\r]+//;
 443         s/#.*//;
 444         s/\s+$//;
 445         next if ( /^\s*$/ || !/^([\w\.\\-]+\s+.*)/ );
 446         #
 447         # Split on white space, except if preceded by \
 448         # using zero-width negative look-behind assertion
 449         # (always wanted to use one of those).
 450         #
 451         @fld = split(/(?<!\\)\s+/, $1);
 452         #
 453         # Remove any \
 454         #
 455         foreach ( @fld ) {
 456             s{\\(\s)}{$1}g;
 457         }
 458         if ( @hdr ) {
 459             if ( defined($host) ) {
 460                 next if ( lc($fld[0]) ne lc($host) );
 461                 @{$hosts{lc($fld[0])}}{@hdr} = @fld;
 462                 close(HOST_INFO);
 463                 close(LOCK);
 464                 return \%hosts;
 465             } else {
 466                 @{$hosts{lc($fld[0])}}{@hdr} = @fld;
 467             }
 468         } else {
 469             @hdr = @fld;
 470         }
 471     }
 472     close(HOST_INFO);
 473     close(LOCK);
 474     return \%hosts;
 475 }
 476
 477 #
 478 # Writes new hosts information to the hosts file in $s->{ConfDir}/hosts.
 479 # With no argument a ref to a hash of hosts is returned.  Each
 480 # hash contains fields as specified in the hosts file.  With an
 481 # argument a ref to a single hash is returned with information
 482 # for just that host.
 483 #
 484 sub HostInfoWrite
 485 {
 486     my($s, $hosts) = @_;
 487     my($gotHdr, @fld, $hostText, $contents);
 488     local(*HOST_INFO);
 489
 490     if ( !open(HOST_INFO, "$s->{ConfDir}/hosts") ) {
 491         return "Can't open $s->{ConfDir}/hosts";
 492     }
 493     foreach my $host ( keys(%$hosts) ) {
 494         my $name = "$hosts->{$host}{host}";
 495         my $rest = "\t$hosts->{$host}{dhcp}"
 496                  . "\t$hosts->{$host}{user}"
 497                  . "\t$hosts->{$host}{moreUsers}";
 498         $name =~ s/ /\\ /g;
 499         $rest =~ s/ //g;
 500         $hostText->{$host} = $name . $rest;
 501     }
 502     binmode(HOST_INFO);
 503     while ( <HOST_INFO> ) {
 504         s/[\n\r]+//;
 505         if ( /^\s*$/ || /^\s*#/ ) {
 506             $contents .= $_ . "\n";
 507             next;
 508         }
 509         if ( !$gotHdr ) {
 510             $contents .= $_ . "\n";
 511             $gotHdr = 1;
 512             next;
 513         }
 514         @fld = split(/(?<!\\)\s+/, $1);
 515         #
 516         # Remove any \
 517         #
 518         foreach ( @fld ) {
 519             s{\\(\s)}{$1}g;
 520         }
 521         if ( defined($hostText->{$fld[0]}) ) {
 522             $contents .= $hostText->{$fld[0]} . "\n";
 523             delete($hostText->{$fld[0]});
 524         }
 525     }
 526     foreach my $host ( sort(keys(%$hostText)) ) {
 527         $contents .= $hostText->{$host} . "\n";
 528         delete($hostText->{$host});
 529     }
 530     close(HOST_INFO);
 531
 532     #
 533     # Write and verify the new host file
 534     #
 535     return $s->TextFileWrite("$s->{ConfDir}/hosts", $contents);
 536 }
 537
 538 #
 539 # Return the mtime of the hosts file
 540 #
 541 sub HostsMTime
 542 {
 543     my($s) = @_;
 544     return (stat("$s->{ConfDir}/hosts"))[9];
 545 }
 546
 547 1;