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 2.1.0, released 20 Jun 2004.
  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 Fcntl qw/:flock/;
  45
  46 sub new
  47 {
  48     my $class = shift;
  49     my($flds, $paths) = @_;
  50
  51     my $s = bless {
  52         %$flds,
  53         %$paths,
  54     }, $class;
  55     return $s;
  56 }
  57
  58 sub BackupInfoRead
  59 {
  60     my($s, $host) = @_;
  61     local(*BK_INFO, *LOCK);
  62     my(@Backups);
  63
  64     flock(LOCK, LOCK_EX) if open(LOCK, "$s->{TopDir}/pc/$host/LOCK");
  65     if ( open(BK_INFO, "$s->{TopDir}/pc/$host/backups") ) {
  66         binmode(BK_INFO);
  67         while ( <BK_INFO> ) {
  68             s/[\n\r]+//;
  69             next if ( !/^(\d+\t(incr|full|partial)[\d\t]*$)/ );
  70             $_ = $1;
  71             @{$Backups[@Backups]}{@{$s->{BackupFields}}} = split(/\t/);
  72         }
  73         close(BK_INFO);
  74     }
  75     close(LOCK);
  76     return @Backups;
  77 }
  78
  79 sub BackupInfoWrite
  80 {
  81     my($s, $host, @Backups) = @_;
  82     local(*BK_INFO, *LOCK);
  83     my($i);
  84
  85     flock(LOCK, LOCK_EX) if open(LOCK, "$s->{TopDir}/pc/$host/LOCK");
  86     if ( -s "$s->{TopDir}/pc/$host/backups" ) {
  87         unlink("$s->{TopDir}/pc/$host/backups.old")
  88                     if ( -f "$s->{TopDir}/pc/$host/backups.old" );
  89         rename("$s->{TopDir}/pc/$host/backups",
  90                "$s->{TopDir}/pc/$host/backups.old")
  91                     if ( -f "$s->{TopDir}/pc/$host/backups" );
  92     }
  93     if ( open(BK_INFO, ">$s->{TopDir}/pc/$host/backups") ) {
  94         binmode(BK_INFO);
  95         for ( $i = 0 ; $i < @Backups ; $i++ ) {
  96             my %b = %{$Backups[$i]};
  97             printf(BK_INFO "%s\n", join("\t", @b{@{$s->{BackupFields}}}));
  98         }
  99         close(BK_INFO);
 100     }
 101     close(LOCK);
 102 }
 103
 104 sub RestoreInfoRead
 105 {
 106     my($s, $host) = @_;
 107     local(*RESTORE_INFO, *LOCK);
 108     my(@Restores);
 109
 110     flock(LOCK, LOCK_EX) if open(LOCK, "$s->{TopDir}/pc/$host/LOCK");
 111     if ( open(RESTORE_INFO, "$s->{TopDir}/pc/$host/restores") ) {
 112         binmode(RESTORE_INFO);
 113         while ( <RESTORE_INFO> ) {
 114             s/[\n\r]+//;
 115             next if ( !/^(\d+.*)/ );
 116             $_ = $1;
 117             @{$Restores[@Restores]}{@{$s->{RestoreFields}}} = split(/\t/);
 118         }
 119         close(RESTORE_INFO);
 120     }
 121     close(LOCK);
 122     return @Restores;
 123 }
 124
 125 sub RestoreInfoWrite
 126 {
 127     my($s, $host, @Restores) = @_;
 128     local(*RESTORE_INFO, *LOCK);
 129     my($i);
 130
 131     flock(LOCK, LOCK_EX) if open(LOCK, "$s->{TopDir}/pc/$host/LOCK");
 132     if ( -s "$s->{TopDir}/pc/$host/restores" ) {
 133         unlink("$s->{TopDir}/pc/$host/restores.old")
 134                     if ( -f "$s->{TopDir}/pc/$host/restores.old" );
 135         rename("$s->{TopDir}/pc/$host/restores",
 136                "$s->{TopDir}/pc/$host/restores.old")
 137                     if ( -f "$s->{TopDir}/pc/$host/restores" );
 138     }
 139     if ( open(RESTORE_INFO, ">$s->{TopDir}/pc/$host/restores") ) {
 140         binmode(RESTORE_INFO);
 141         for ( $i = 0 ; $i < @Restores ; $i++ ) {
 142             my %b = %{$Restores[$i]};
 143             printf(RESTORE_INFO "%s\n",
 144                         join("\t", @b{@{$s->{RestoreFields}}}));
 145         }
 146         close(RESTORE_INFO);
 147     }
 148     close(LOCK);
 149 }
 150
 151 sub ArchiveInfoRead
 152 {
 153     my($s, $host) = @_;
 154     local(*ARCHIVE_INFO, *LOCK);
 155     my(@Archives);
 156
 157     flock(LOCK, LOCK_EX) if open(LOCK, "$s->{TopDir}/pc/$host/LOCK");
 158     if ( open(ARCHIVE_INFO, "$s->{TopDir}/pc/$host/archives") ) {
 159         binmode(ARCHIVE_INFO);
 160         while ( <ARCHIVE_INFO> ) {
 161             s/[\n\r]+//;
 162             next if ( !/^(\d+.*)/ );
 163             $_ = $1;
 164             @{$Archives[@Archives]}{@{$s->{ArchiveFields}}} = split(/\t/);
 165         }
 166         close(ARCHIVE_INFO);
 167     }
 168     close(LOCK);
 169     return @Archives;
 170 }
 171
 172 sub ArchiveInfoWrite
 173 {
 174     my($s, $host, @Archives) = @_;
 175     local(*ARCHIVE_INFO, *LOCK);
 176     my($i);
 177
 178     flock(LOCK, LOCK_EX) if open(LOCK, "$s->{TopDir}/pc/$host/LOCK");
 179     if ( -s "$s->{TopDir}/pc/$host/archives" ) {
 180         unlink("$s->{TopDir}/pc/$host/archives.old")
 181                     if ( -f "$s->{TopDir}/pc/$host/archives.old" );
 182         rename("$s->{TopDir}/pc/$host/archives",
 183                "$s->{TopDir}/pc/$host/archives.old")
 184                     if ( -f "$s->{TopDir}/pc/$host/archives" );
 185     }
 186     if ( open(ARCHIVE_INFO, ">$s->{TopDir}/pc/$host/archives") ) {
 187         binmode(ARCHIVE_INFO);
 188         for ( $i = 0 ; $i < @Archives ; $i++ ) {
 189             my %b = %{$Archives[$i]};
 190             printf(ARCHIVE_INFO "%s\n",
 191                         join("\t", @b{@{$s->{ArchiveFields}}}));
 192         }
 193         close(ARCHIVE_INFO);
 194     }
 195     close(LOCK);
 196 }
 197
 198 sub ConfigDataRead
 199 {
 200     my($s, $host) = @_;
 201     my($ret, $mesg, $config, @configs);
 202
 203     #
 204     # TODO: add lock
 205     #
 206     my $conf = {};
 207
 208     if ( defined($host) ) {
 209         push(@configs, "$s->{TopDir}/conf/$host.pl")
 210                 if ( $host ne "config" && -f "$s->{TopDir}/conf/$host.pl" );
 211         push(@configs, "$s->{TopDir}/pc/$host/config.pl")
 212                 if ( -f "$s->{TopDir}/pc/$host/config.pl" );
 213     } else {
 214         push(@configs, "$s->{TopDir}/conf/config.pl");
 215     }
 216     foreach $config ( @configs ) {
 217         %Conf = ();
 218         if ( !defined($ret = do $config) && ($! || $@) ) {
 219             $mesg = "Couldn't open $config: $!" if ( $! );
 220             $mesg = "Couldn't execute $config: $@" if ( $@ );
 221             $mesg =~ s/[\n\r]+//;
 222             return ($mesg, $conf);
 223         }
 224         %$conf = ( %$conf, %Conf );
 225     }
 226     return (undef, $conf);
 227 }
 228
 229 sub ConfigDataWrite
 230 {
 231     my($s, $host, $newConf) = @_;
 232
 233     my($confPath) = $host eq "" ? "$s->{TopDir}/conf/config.pl"
 234                                 : "$s->{TopDir}/pc/$host/config.pl";
 235
 236     my $err = $s->ConfigFileMerge($confPath, "$confPath.new", $newConf);
 237     #
 238     # TODO: add lock and rename
 239     #
 240 }
 241
 242 sub ConfigFileMerge
 243 {
 244     my($s, $inFile, $outFile, $newConf) = @_;
 245
 246     open(C, $inFile) || return "ConfigFileMerge: can't open/read $inFile";
 247     binmode(C);
 248
 249     open(OUT, ">", $outFile)
 250                      || return "ConfigFileMerge: can't open/write $outFile";
 251     binmode(OUT);
 252
 253     my($out);
 254     my $comment = 1;
 255     my $skipVar = 0;
 256     my $endLine = undef;
 257     my $done = {};
 258
 259     while ( <C> ) {
 260         if ( $comment && /^\s*#/ ) {
 261             $out .= $_;
 262         } elsif ( /^\s*\$Conf\{([^}]*)\}\s*=/ ) {
 263             my $var = $1;
 264             if ( exists($newConf->{$var}) ) {
 265                 print OUT $out;
 266                 my $d = Data::Dumper->new([$newConf->{$var}], [*value]);
 267                 $d->Indent(1);
 268                 $d->Terse(1);
 269                 my $value = $d->Dump;
 270                 $value =~ s/(.*)\n/$1;\n/s;
 271                 print OUT "\$Conf{$var} = ", $value;
 272                 $done->{$var} = 1;
 273             }
 274             $endLine = $1 if ( /^\s*\$Conf\{[^}]*} *= *<<(.*);/ );
 275             $endLine = $1 if ( /^\s*\$Conf\{[^}]*} *= *<<'(.*)';/ );
 276             $out = "";
 277             $skipVar = 1;
 278         } elsif ( $skipVar ) {
 279             if ( !defined($endLine) && (/^\s*[\r\n]*$/ || /^\s*#/) ) {
 280                 $skipVar = 0;
 281                 $comment = 1;
 282                 $out .= $_;
 283             }
 284             if ( defined($endLine) && /^\Q$endLine\E[\n\r]*$/ ) {
 285                 $endLine = undef;
 286                 $skipVar = 0;
 287                 $comment = 1;
 288             }
 289         } else {
 290             $out .= $_;
 291         }
 292     }
 293     if ( $out ne "" ) {
 294         print OUT $out;
 295     }
 296     foreach my $var ( sort(keys(%$newConf)) ) {
 297         next if ( $done->{$var} );
 298         my $d = Data::Dumper->new([$newConf->{$var}], [*value]);
 299         $d->Indent(1);
 300         $d->Terse(1);
 301         my $value = $d->Dump;
 302         $value =~ s/(.*)\n/$1;\n/s;
 303         print OUT "\$Conf{$var} = ", $value;
 304         $done->{$var} = 1;
 305     }
 306     close(C);
 307     close(OUT);
 308 }
 309
 310 #
 311 # Return the mtime of the config file
 312 #
 313 sub ConfigMTime
 314 {
 315     my($s) = @_;
 316     return (stat("$s->{TopDir}/conf/config.pl"))[9];
 317 }
 318
 319 #
 320 # Returns information from the host file in $s->{TopDir}/conf/hosts.
 321 # With no argument a ref to a hash of hosts is returned.  Each
 322 # hash contains fields as specified in the hosts file.  With an
 323 # argument a ref to a single hash is returned with information
 324 # for just that host.
 325 #
 326 sub HostInfoRead
 327 {
 328     my($s, $host) = @_;
 329     my(%hosts, @hdr, @fld);
 330     local(*HOST_INFO);
 331
 332     if ( !open(HOST_INFO, "$s->{TopDir}/conf/hosts") ) {
 333         print(STDERR $s->timeStamp,
 334                      "Can't open $s->{TopDir}/conf/hosts\n");
 335         return {};
 336     }
 337     binmode(HOST_INFO);
 338     while ( <HOST_INFO> ) {
 339         s/[\n\r]+//;
 340         s/#.*//;
 341         s/\s+$//;
 342         next if ( /^\s*$/ || !/^([\w\.\\-]+\s+.*)/ );
 343         #
 344         # Split on white space, except if preceded by \
 345         # using zero-width negative look-behind assertion
 346         # (always wanted to use one of those).
 347         #
 348         @fld = split(/(?<!\\)\s+/, $1);
 349         #
 350         # Remove any \
 351         #
 352         foreach ( @fld ) {
 353             s{\\(\s)}{$1}g;
 354         }
 355         if ( @hdr ) {
 356             if ( defined($host) ) {
 357                 next if ( lc($fld[0]) ne $host );
 358                 @{$hosts{lc($fld[0])}}{@hdr} = @fld;
 359                 close(HOST_INFO);
 360                 return \%hosts;
 361             } else {
 362                 @{$hosts{lc($fld[0])}}{@hdr} = @fld;
 363             }
 364         } else {
 365             @hdr = @fld;
 366         }
 367     }
 368     close(HOST_INFO);
 369     return \%hosts;
 370 }
 371
 372 #
 373 # Return the mtime of the hosts file
 374 #
 375 sub HostsMTime
 376 {
 377     my($s) = @_;
 378     return (stat("$s->{TopDir}/conf/hosts"))[9];
 379 }
 380
 381 1;