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