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