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