is a high-performance, enterprise-grade system for backing up Linux and WinXX PCs and laptops to a server’s disk (http/cgi user interface).
| Text.pm (BackupPC-4.3.2) | : | Text.pm (BackupPC-4.4.0) |
|---|
| | |
| skipping to change at line 32 | | skipping to change at line 32 |
|---|
| # This program is distributed in the hope that it will be useful, | | # This program is distributed in the hope that it will be useful, |
| # but WITHOUT ANY WARRANTY; without even the implied warranty of | | # but WITHOUT ANY WARRANTY; without even the implied warranty of |
| # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| # GNU General Public License for more details. | | # GNU General Public License for more details. |
| # | | # |
| # You should have received a copy of the GNU General Public License | | # You should have received a copy of the GNU General Public License |
| # along with this program. If not, see <http://www.gnu.org/licenses/>. | | # along with this program. If not, see <http://www.gnu.org/licenses/>. |
| # | | # |
| #======================================================================== | | #======================================================================== |
| # | | # |
|
| # Version 4.3.2, released 17 Feb 2020. | | # Version 4.4.0, released 20 Jun 2020. |
| # | | # |
| # See http://backuppc.sourceforge.net. | | # See http://backuppc.sourceforge.net. |
| # | | # |
| #======================================================================== | | #======================================================================== |
| | |
| package BackupPC::Storage::Text; | | package BackupPC::Storage::Text; |
| | |
| use strict; | | use strict; |
| use vars qw(%Conf %Status %Info); | | use vars qw(%Conf %Status %Info); |
| use Data::Dumper; | | use Data::Dumper; |
| use File::Path; | | use File::Path; |
| use Fcntl qw/:flock/; | | use Fcntl qw/:flock/; |
| use Storable qw(store retrieve fd_retrieve store_fd); | | use Storable qw(store retrieve fd_retrieve store_fd); |
| | |
| sub new | | sub new |
| { | | { |
| my $class = shift; | | my $class = shift; |
| my($flds, $paths) = @_; | | my($flds, $paths) = @_; |
| | |
|
| my $s = bless { | | my $s = bless {%$flds, %$paths}, $class; |
| %$flds, | | |
| %$paths, | | |
| }, $class; | | |
| return $s; | | return $s; |
| } | | } |
| | |
| sub setPaths | | sub setPaths |
| { | | { |
| my $class = shift; | | my $class = shift; |
| my($paths) = @_; | | my($paths) = @_; |
| | |
| foreach my $v ( keys(%$paths) ) { | | foreach my $v ( keys(%$paths) ) { |
| $class->{$v} = $paths->{$v}; | | $class->{$v} = $paths->{$v}; |
| | |
| skipping to change at line 79 | | skipping to change at line 76 |
|---|
| sub BackupInfoRead | | sub BackupInfoRead |
| { | | { |
| my($s, $host) = @_; | | my($s, $host) = @_; |
| my(@Backups, $bkFd, $lockFd, $locked); | | my(@Backups, $bkFd, $lockFd, $locked); |
| | |
| if ( open($lockFd, ">", "$s->{TopDir}/pc/$host/LOCK") ) { | | if ( open($lockFd, ">", "$s->{TopDir}/pc/$host/LOCK") ) { |
| flock($lockFd, LOCK_EX); | | flock($lockFd, LOCK_EX); |
| $locked = 1; | | $locked = 1; |
| } | | } |
| if ( open($bkFd, "$s->{TopDir}/pc/$host/backups") ) { | | if ( open($bkFd, "$s->{TopDir}/pc/$host/backups") ) { |
|
| binmode($bkFd); | | binmode($bkFd); |
| while ( <$bkFd> ) { | | while ( <$bkFd> ) { |
| s/[\n\r]+//; | | s/[\n\r]+//; |
| next if ( !/^(\d+\t(incr|full|partial|active).*)/ ); | | next if ( !/^(\d+\t(incr|full|partial|active).*)/ ); |
| $_ = $1; | | $_ = $1; |
| @{$Backups[@Backups]}{@{$s->{BackupFields}}} = split(/\t/); | | @{$Backups[@Backups]}{@{$s->{BackupFields}}} = split(/\t/); |
| } | | } |
| close($bkFd); | | close($bkFd); |
| } | | } |
| if ( $locked ) { | | if ( $locked ) { |
| flock($lockFd, LOCK_UN); | | flock($lockFd, LOCK_UN); |
| close($lockFd); | | close($lockFd); |
| } | | } |
|
| # | | |
| # Default the version field. Prior to 3.0.0 the xferMethod | | |
| # field is empty, so we use that to figure out the version. | | |
| # | | |
| for ( my $i = 0 ; $i < @Backups ; $i++ ) { | | for ( my $i = 0 ; $i < @Backups ; $i++ ) { |
|
| next if ( $Backups[$i]{version} ne "" ); | | # |
| if ( $Backups[$i]{xferMethod} eq "" ) { | | # Default the version field. Prior to 3.0.0 the xferMethod |
| $Backups[$i]{version} = "2.1.2"; | | # field is empty, so we use that to figure out the version. |
| } else { | | # |
| $Backups[$i]{version} = "3.0.0"; | | if ( $Backups[$i]{version} eq "" ) { |
| | if ( $Backups[$i]{xferMethod} eq "" ) { |
| | $Backups[$i]{version} = "2.1.2"; |
| | } else { |
| | $Backups[$i]{version} = "3.0.0"; |
| | } |
| } | | } |
|
| | # |
| | # Reconstitue share2path into a hash |
| | # |
| | if ( $Backups[$i]{share2path} ne "" ) { |
| | my $str = $Backups[$i]{share2path}; |
| | $str =~ s{%(..)}{chr(hex($1))}eg; |
| | $Backups[$i]{share2path} = eval $str; |
| | if ( $@ ) { |
| | print(STDERR "BackupInfoRead: host $host: can't rebuild share2pa |
| | th from $str\n"); |
| | } |
| | } |
| | $Backups[$i]{comment} =~ s{%(..)}{chr(hex($1))}eg; |
| } | | } |
| return @Backups; | | return @Backups; |
| } | | } |
| | |
| sub BackupInfoWrite | | sub BackupInfoWrite |
| { | | { |
| my($s, $host, @Backups) = @_; | | my($s, $host, @Backups) = @_; |
| my($i, $contents); | | my($i, $contents); |
| | |
| # | | # |
| # Generate the file contents | | # Generate the file contents |
| # | | # |
| for ( $i = 0 ; $i < @Backups ; $i++ ) { | | for ( $i = 0 ; $i < @Backups ; $i++ ) { |
| my %b = %{$Backups[$i]}; | | my %b = %{$Backups[$i]}; |
|
| | if ( ref($b{share2path}) eq 'HASH' ) { |
| | my $dump = Data::Dumper->new([$b{share2path}]); |
| | $dump->Indent(0); |
| | $dump->Sortkeys(1); |
| | $dump->Terse(1); |
| | my $value = $dump->Dump; |
| | $value =~ s{([%\t\n\r])}{sprintf("%%%02x", ord($1))}eg; |
| | $b{share2path} = $value; |
| | } |
| | $b{comment} =~ s{([%\t\n\r])}{sprintf("%%%02x", ord($1))}eg; |
| $contents .= join("\t", @b{@{$s->{BackupFields}}}) . "\n"; | | $contents .= join("\t", @b{@{$s->{BackupFields}}}) . "\n"; |
| } | | } |
| | |
| # | | # |
| # Write the file | | # Write the file |
| # | | # |
| return $s->TextFileWrite("$s->{TopDir}/pc/$host/backups", $contents); | | return $s->TextFileWrite("$s->{TopDir}/pc/$host/backups", $contents); |
| } | | } |
| | |
| sub RestoreInfoRead | | sub RestoreInfoRead |
| { | | { |
| my($s, $host) = @_; | | my($s, $host) = @_; |
| my(@Restores, $resFd, $lockFd, $locked); | | my(@Restores, $resFd, $lockFd, $locked); |
| | |
| if ( open($lockFd, ">", "$s->{TopDir}/pc/$host/LOCK") ) { | | if ( open($lockFd, ">", "$s->{TopDir}/pc/$host/LOCK") ) { |
| flock($lockFd, LOCK_EX); | | flock($lockFd, LOCK_EX); |
| $locked = 1; | | $locked = 1; |
| } | | } |
| if ( open($resFd, "$s->{TopDir}/pc/$host/restores") ) { | | if ( open($resFd, "$s->{TopDir}/pc/$host/restores") ) { |
|
| binmode($resFd); | | binmode($resFd); |
| while ( <$resFd> ) { | | while ( <$resFd> ) { |
| s/[\n\r]+//; | | s/[\n\r]+//; |
| next if ( !/^(\d+.*)/ ); | | next if ( !/^(\d+.*)/ ); |
| $_ = $1; | | $_ = $1; |
| @{$Restores[@Restores]}{@{$s->{RestoreFields}}} = split(/\t/); | | @{$Restores[@Restores]}{@{$s->{RestoreFields}}} = split(/\t/); |
| } | | } |
| close($resFd); | | close($resFd); |
| } | | } |
| if ( $locked ) { | | if ( $locked ) { |
| flock($lockFd, LOCK_UN); | | flock($lockFd, LOCK_UN); |
| | |
| skipping to change at line 234 | | skipping to change at line 254 |
|---|
| my($s, $file, $contents) = @_; | | my($s, $file, $contents) = @_; |
| my($fileOk, $fd); | | my($fileOk, $fd); |
| | |
| (my $dir = $file) =~ s{(.+)/(.+)}{$1}; | | (my $dir = $file) =~ s{(.+)/(.+)}{$1}; |
| | |
| if ( !-d $dir ) { | | if ( !-d $dir ) { |
| eval { mkpath($dir, 0, 0775) }; | | eval { mkpath($dir, 0, 0775) }; |
| return "TextFileWrite: can't create directory $dir" if ( $@ ); | | return "TextFileWrite: can't create directory $dir" if ( $@ ); |
| } | | } |
| if ( open($fd, ">", "$file.new") ) { | | if ( open($fd, ">", "$file.new") ) { |
|
| binmode($fd); | | binmode($fd); |
| print $fd $contents; | | print $fd $contents; |
| close($fd); | | close($fd); |
| # | | # |
| # verify the file | | # verify the file |
| # | | # |
| if ( open($fd, "<", "$file.new") ) { | | if ( open($fd, "<", "$file.new") ) { |
| binmode($fd); | | binmode($fd); |
| if ( join("", <$fd>) ne $contents ) { | | if ( join("", <$fd>) ne $contents ) { |
| return "TextFileWrite: Failed to verify $file.new"; | | return "TextFileWrite: Failed to verify $file.new"; |
| } else { | | } else { |
| $fileOk = 1; | | $fileOk = 1; |
| } | | } |
| close($fd); | | close($fd); |
| } | | } |
|
| | # |
| | # use same gid as original file |
| | # |
| | my $uid = (stat("$file.new"))[4]; |
| | my $gid = (stat($file))[5]; |
| | chown($uid, $gid, "$file.new") if ( defined($uid) && defined($gid) ); |
| } | | } |
| if ( $fileOk ) { | | if ( $fileOk ) { |
| my($locked, $lockFd); | | my($locked, $lockFd); |
| | |
| if ( open($lockFd, ">", "$dir/LOCK") ) { | | if ( open($lockFd, ">", "$dir/LOCK") ) { |
| $locked = 1; | | $locked = 1; |
| flock($lockFd, LOCK_EX); | | flock($lockFd, LOCK_EX); |
| } | | } |
| if ( -s "$file" ) { | | if ( -s "$file" ) { |
|
| unlink("$file.old") if ( -f "$file.old" ); | | unlink("$file.old") if ( -f "$file.old" ); |
| rename("$file", "$file.old") if ( -f "$file" ); | | rename("$file", "$file.old") if ( -f "$file" ); |
| } else { | | } else { |
| unlink("$file") if ( -f "$file" ); | | unlink("$file") if ( -f "$file" ); |
| } | | } |
| rename("$file.new", "$file") if ( -f "$file.new" ); | | rename("$file.new", "$file") if ( -f "$file.new" ); |
| if ( $locked ) { | | if ( $locked ) { |
| flock($lockFd, LOCK_UN); | | flock($lockFd, LOCK_UN); |
| close($lockFd); | | close($lockFd); |
| } | | } |
| } else { | | } else { |
| return "TextFileWrite: Failed to write $file.new"; | | return "TextFileWrite: Failed to write $file.new"; |
| | |
| skipping to change at line 283 | | skipping to change at line 309 |
|---|
| | |
| sub ConfigPath | | sub ConfigPath |
| { | | { |
| my($s, $host) = @_; | | my($s, $host) = @_; |
| | |
| return "$s->{ConfDir}/config.pl" if ( !defined($host) ); | | return "$s->{ConfDir}/config.pl" if ( !defined($host) ); |
| if ( $s->{useFHS} ) { | | if ( $s->{useFHS} ) { |
| return "$s->{ConfDir}/pc/$host.pl"; | | return "$s->{ConfDir}/pc/$host.pl"; |
| } else { | | } else { |
| return "$s->{TopDir}/pc/$host/config.pl" | | return "$s->{TopDir}/pc/$host/config.pl" |
|
| if ( -f "$s->{TopDir}/pc/$host/config.pl" ); | | if ( -f "$s->{TopDir}/pc/$host/config.pl" ); |
| return "$s->{ConfDir}/$host.pl" | | return "$s->{ConfDir}/$host.pl" |
|
| if ( $host ne "config" && -f "$s->{ConfDir}/$host.pl" ); | | if ( $host ne "config" && -f "$s->{ConfDir}/$host.pl" ); |
| return "$s->{ConfDir}/pc/$host.pl"; | | return "$s->{ConfDir}/pc/$host.pl"; |
| } | | } |
| } | | } |
| | |
| sub ConfigDataRead | | sub ConfigDataRead |
| { | | { |
| my($s, $host, $prevConfig) = @_; | | my($s, $host, $prevConfig) = @_; |
| my($ret, $mesg, $config, @configs); | | my($ret, $mesg, $config, @configs); |
| | |
| # | | # |
| # TODO: add lock | | # TODO: add lock |
| # | | # |
|
| my $conf = $prevConfig || {}; | | my $conf = $prevConfig || {}; |
| my $configPath = $s->ConfigPath($host); | | my $configPath = $s->ConfigPath($host); |
| | |
| push(@configs, $configPath) if ( -f $configPath ); | | push(@configs, $configPath) if ( -f $configPath ); |
| foreach $config ( @configs ) { | | foreach $config ( @configs ) { |
| %Conf = %$conf; | | %Conf = %$conf; |
| if ( !defined($ret = do $config) && ($! || $@) ) { | | if ( !defined($ret = do $config) && ($! || $@) ) { |
|
| $mesg = "Couldn't open $config: $!" if ( $! ); | | $mesg = "Couldn't open $config: $!" if ( $! ); |
| $mesg = "Couldn't execute $config: $@" if ( $@ ); | | $mesg = "Couldn't execute $config: $@" if ( $@ ); |
| $mesg =~ s/[\n\r]+//; | | $mesg =~ s/[\n\r]+//; |
| return ($mesg, $conf); | | return ($mesg, $conf); |
| } | | } |
| %$conf = %Conf; | | %$conf = %Conf; |
| } | | } |
| | |
| # | | # |
| # Promote BackupFilesOnly and BackupFilesExclude to hashes | | # Promote BackupFilesOnly and BackupFilesExclude to hashes |
| # | | # |
| foreach my $param ( qw(BackupFilesOnly BackupFilesExclude) ) { | | foreach my $param ( qw(BackupFilesOnly BackupFilesExclude) ) { |
| next if ( !defined($conf->{$param}) || ref($conf->{$param}) eq "HASH" ); | | next if ( !defined($conf->{$param}) || ref($conf->{$param}) eq "HASH" ); |
|
| $conf->{$param} = [ $conf->{$param} ] | | $conf->{$param} = [$conf->{$param}] |
| if ( ref($conf->{$param}) ne "ARRAY" ); | | if ( ref($conf->{$param}) ne "ARRAY" ); |
| $conf->{$param} = { "*" => $conf->{$param} }; | | $conf->{$param} = {"*" => $conf->{$param}}; |
| } | | } |
| | |
| # | | # |
| # Handle backward compatibility with defunct BlackoutHourBegin, | | # Handle backward compatibility with defunct BlackoutHourBegin, |
| # BlackoutHourEnd, and BlackoutWeekDays parameters. | | # BlackoutHourEnd, and BlackoutWeekDays parameters. |
| # | | # |
| if ( defined($conf->{BlackoutHourBegin}) ) { | | if ( defined($conf->{BlackoutHourBegin}) ) { |
|
| push(@{$conf->{BlackoutPeriods}}, | | push( |
| { | | @{$conf->{BlackoutPeriods}}, |
| hourBegin => $conf->{BlackoutHourBegin}, | | { |
| hourEnd => $conf->{BlackoutHourEnd}, | | hourBegin => $conf->{BlackoutHourBegin}, |
| weekDays => $conf->{BlackoutWeekDays}, | | hourEnd => $conf->{BlackoutHourEnd}, |
| } | | weekDays => $conf->{BlackoutWeekDays}, |
| | } |
| ); | | ); |
| delete($conf->{BlackoutHourBegin}); | | delete($conf->{BlackoutHourBegin}); |
| delete($conf->{BlackoutHourEnd}); | | delete($conf->{BlackoutHourEnd}); |
| delete($conf->{BlackoutWeekDays}); | | delete($conf->{BlackoutWeekDays}); |
| } | | } |
| | |
| # | | # |
| # Check that certain settings have valid values | | # Check that certain settings have valid values |
| # | | # |
|
| if ( $conf->{BackupPCNightlyPeriod} != 1 | | if ( $conf->{BackupPCNightlyPeriod} != 1 |
| && $conf->{BackupPCNightlyPeriod} != 2 | | && $conf->{BackupPCNightlyPeriod} != 2 |
| && $conf->{BackupPCNightlyPeriod} != 4 | | && $conf->{BackupPCNightlyPeriod} != 4 |
| && $conf->{BackupPCNightlyPeriod} != 8 | | && $conf->{BackupPCNightlyPeriod} != 8 |
| && $conf->{BackupPCNightlyPeriod} != 16 ) { | | && $conf->{BackupPCNightlyPeriod} != 16 ) { |
| $conf->{BackupPCNightlyPeriod} = 1; | | $conf->{BackupPCNightlyPeriod} = 1; |
| } | | } |
| if ( $conf->{PoolSizeNightlyUpdatePeriod} != 0 | | if ( $conf->{PoolSizeNightlyUpdatePeriod} != 0 |
| && $conf->{PoolSizeNightlyUpdatePeriod} != 1 | | && $conf->{PoolSizeNightlyUpdatePeriod} != 1 |
| && $conf->{PoolSizeNightlyUpdatePeriod} != 2 | | && $conf->{PoolSizeNightlyUpdatePeriod} != 2 |
| && $conf->{PoolSizeNightlyUpdatePeriod} != 4 | | && $conf->{PoolSizeNightlyUpdatePeriod} != 4 |
| && $conf->{PoolSizeNightlyUpdatePeriod} != 8 | | && $conf->{PoolSizeNightlyUpdatePeriod} != 8 |
| && $conf->{PoolSizeNightlyUpdatePeriod} != 16 ) { | | && $conf->{PoolSizeNightlyUpdatePeriod} != 16 ) { |
| $conf->{PoolSizeNightlyUpdatePeriod} = 16; | | $conf->{PoolSizeNightlyUpdatePeriod} = 16; |
| } | | } |
| | |
| return (undef, $conf); | | return (undef, $conf); |
| } | | } |
| | |
| sub ConfigDataWrite | | sub ConfigDataWrite |
| { | | { |
| my($s, $host, $newConf) = @_; | | my($s, $host, $newConf) = @_; |
| | |
| my $configPath = $s->ConfigPath($host); | | my $configPath = $s->ConfigPath($host); |
| | |
| skipping to change at line 390 | | skipping to change at line 417 |
|---|
| { | | { |
| my($s, $inFile, $newConf) = @_; | | my($s, $inFile, $newConf) = @_; |
| my($contents, $skipExpr, $fakeVar, $configFd); | | my($contents, $skipExpr, $fakeVar, $configFd); |
| my $done = {}; | | my $done = {}; |
| | |
| if ( -f $inFile ) { | | if ( -f $inFile ) { |
| # | | # |
| # Match existing settings in current config file | | # Match existing settings in current config file |
| # | | # |
| open($configFd, $inFile) | | open($configFd, $inFile) |
|
| || return ("ConfigFileMerge: can't open/read $inFile", undef); | | || return ("ConfigFileMerge: can't open/read $inFile", undef); |
| binmode($configFd); | | binmode($configFd); |
| | |
| while ( <$configFd> ) { | | while ( <$configFd> ) { |
| if ( /^\s*\$Conf\{([^}]*)\}\s*=(.*)/ ) { | | if ( /^\s*\$Conf\{([^}]*)\}\s*=(.*)/ ) { |
| my $var = $1; | | my $var = $1; |
| $skipExpr = "\$fakeVar = $2\n"; | | $skipExpr = "\$fakeVar = $2\n"; |
| if ( exists($newConf->{$var}) ) { | | if ( exists($newConf->{$var}) ) { |
| my $d = Data::Dumper->new([$newConf->{$var}], [*value]); | | my $d = Data::Dumper->new([$newConf->{$var}], [*value]); |
| $d->Indent(1); | | $d->Indent(1); |
| $d->Terse(1); | | $d->Terse(1); |
| | |
| skipping to change at line 412 | | skipping to change at line 439 |
|---|
| my $value = $d->Dump; | | my $value = $d->Dump; |
| $value =~ s/(.*)\n/$1;\n/s; | | $value =~ s/(.*)\n/$1;\n/s; |
| $contents .= "\$Conf{$var} = " . $value; | | $contents .= "\$Conf{$var} = " . $value; |
| $done->{$var} = 1; | | $done->{$var} = 1; |
| } | | } |
| } elsif ( defined($skipExpr) ) { | | } elsif ( defined($skipExpr) ) { |
| $skipExpr .= $_; | | $skipExpr .= $_; |
| } else { | | } else { |
| $contents .= $_; | | $contents .= $_; |
| } | | } |
|
| if ( defined($skipExpr) | | if ( defined($skipExpr) && ($skipExpr =~ /^\$fakeVar = *<</ || $skip |
| && ($skipExpr =~ /^\$fakeVar = *<</ | | Expr =~ /;[\n\r]*$/) ) { |
| || $skipExpr =~ /;[\n\r]*$/) ) { | | |
| # | | # |
| # if we have a complete expression, then we are done | | # if we have a complete expression, then we are done |
| # skipping text from the original config file. | | # skipping text from the original config file. |
| # | | # |
| $skipExpr = $1 if ( $skipExpr =~ /(.*)/s ); | | $skipExpr = $1 if ( $skipExpr =~ /(.*)/s ); |
| eval($skipExpr); | | eval($skipExpr); |
| $skipExpr = undef if ( $@ eq "" ); | | $skipExpr = undef if ( $@ eq "" ); |
| } | | } |
| } | | } |
| close($configFd); | | close($configFd); |
| } | | } |
| | |
| # | | # |
| # Add new entries not matched in current config file | | # Add new entries not matched in current config file |
| # | | # |
| foreach my $var ( sort(keys(%$newConf)) ) { | | foreach my $var ( sort(keys(%$newConf)) ) { |
|
| next if ( $done->{$var} ); | | next if ( $done->{$var} ); |
| my $d = Data::Dumper->new([$newConf->{$var}], [*value]); | | my $d = Data::Dumper->new([$newConf->{$var}], [*value]); |
| $d->Indent(1); | | $d->Indent(1); |
| $d->Terse(1); | | $d->Terse(1); |
| $d->Sortkeys(1); | | $d->Sortkeys(1); |
|
| my $value = $d->Dump; | | my $value = $d->Dump; |
| $value =~ s/(.*)\n/$1;\n/s; | | $value =~ s/(.*)\n/$1;\n/s; |
| $contents .= "\$Conf{$var} = " . $value; | | $contents .= "\$Conf{$var} = " . $value; |
| $done->{$var} = 1; | | $done->{$var} = 1; |
| } | | } |
| return (undef, $contents); | | return (undef, $contents); |
| } | | } |
| | |
| # | | # |
| # Return the mtime of the config file | | # Return the mtime of the config file |
| # | | # |
| sub ConfigMTime | | sub ConfigMTime |
| { | | { |
| my($s) = @_; | | my($s) = @_; |
| return (stat($s->ConfigPath()))[9]; | | return (stat($s->ConfigPath()))[9]; |
| } | | } |
| | |
| sub StatusDataRead | | sub StatusDataRead |
| { | | { |
| my($s) = @_; | | my($s) = @_; |
| my($ret, $mesg); | | my($ret, $mesg); |
| | |
| %Status = (); | | %Status = (); |
| %Info = (); | | %Info = (); |
|
| if ( -f "$s->{LogDir}/status.pl" | | if ( -f "$s->{LogDir}/status.pl" |
| && !defined($ret = do "$s->{LogDir}/status.pl") && ($! || $@) ) { | | && !defined($ret = do "$s->{LogDir}/status.pl") |
| $mesg = "Couldn't open $s->{LogDir}/status.pl: $!" if ( $! ); | | && ($! || $@) ) { |
| | $mesg = "Couldn't open $s->{LogDir}/status.pl: $!" if ( $! ); |
| $mesg = "Couldn't execute $s->{LogDir}/status.pl: $@" if ( $@ ); | | $mesg = "Couldn't execute $s->{LogDir}/status.pl: $@" if ( $@ ); |
| $mesg =~ s/[\n\r]+//; | | $mesg =~ s/[\n\r]+//; |
| rename("$s->{LogDir}/status.pl", "$s->{LogDir}/status.pl.bad"); | | rename("$s->{LogDir}/status.pl", "$s->{LogDir}/status.pl.bad"); |
| return ($mesg, undef); | | return ($mesg, undef); |
| } | | } |
| return (\%Status, \%Info); | | return (\%Status, \%Info); |
| } | | } |
| | |
| sub StatusDataWrite | | sub StatusDataWrite |
| { | | { |
| my($s, $status, $info) = @_; | | my($s, $status, $info) = @_; |
| | |
|
| my($dump) = Data::Dumper->new( | | my($dump) = Data::Dumper->new([$info, $status], [qw(*Info *Status)]); |
| [ $info, $status], | | |
| [qw(*Info *Status)]); | | |
| $dump->Indent(1); | | $dump->Indent(1); |
| my $text = $dump->Dump; | | my $text = $dump->Dump; |
| $s->TextFileWrite("$s->{LogDir}/status.pl", $text); | | $s->TextFileWrite("$s->{LogDir}/status.pl", $text); |
| } | | } |
| | |
| # | | # |
| # Returns information from the host file in $s->{ConfDir}/hosts. | | # Returns information from the host file in $s->{ConfDir}/hosts. |
| # With no argument a ref to a hash of hosts is returned. Each | | # With no argument a ref to a hash of hosts is returned. Each |
| # hash contains fields as specified in the hosts file. With an | | # hash contains fields as specified in the hosts file. With an |
| # argument a ref to a single hash is returned with information | | # argument a ref to a single hash is returned with information |
| | |
| skipping to change at line 517 | | skipping to change at line 541 |
|---|
| } | | } |
| binmode($hostFd); | | binmode($hostFd); |
| while ( <$hostFd> ) { | | while ( <$hostFd> ) { |
| s/[\n\r]+//; | | s/[\n\r]+//; |
| s/#.*//; | | s/#.*//; |
| s/\s+$//; | | s/\s+$//; |
| next if ( /^\s*$/ || !/^([\w\.\\-]+\s+.*)/ ); | | next if ( /^\s*$/ || !/^([\w\.\\-]+\s+.*)/ ); |
| # | | # |
| # Split on white space, except if preceded by \ | | # Split on white space, except if preceded by \ |
| # using zero-width negative look-behind assertion | | # using zero-width negative look-behind assertion |
|
| # (always wanted to use one of those). | | # (always wanted to use one of those). |
| # | | # |
| @fld = split(/(?<!\\)\s+/, $1); | | @fld = split(/(?<!\\)\s+/, $1); |
| # | | # |
| # Remove any \ | | # Remove any \ |
| # | | # |
| foreach ( @fld ) { | | foreach ( @fld ) { |
| s{\\(\s)}{$1}g; | | s{\\(\s)}{$1}g; |
| } | | } |
| if ( @hdr ) { | | if ( @hdr ) { |
| if ( defined($host) ) { | | if ( defined($host) ) { |
| next if ( lc($fld[0]) ne lc($host) ); | | next if ( lc($fld[0]) ne lc($host) ); |
| @{$hosts{lc($fld[0])}}{@hdr} = @fld; | | @{$hosts{lc($fld[0])}}{@hdr} = @fld; |
|
| close($hostFd); | | close($hostFd); |
| if ( $locked ) { | | if ( $locked ) { |
| flock($lockFd, LOCK_UN); | | flock($lockFd, LOCK_UN); |
| close($lockFd); | | close($lockFd); |
| } | | } |
| return \%hosts; | | return \%hosts; |
| } else { | | } else { |
| @{$hosts{lc($fld[0])}}{@hdr} = @fld; | | @{$hosts{lc($fld[0])}}{@hdr} = @fld; |
| } | | } |
| } else { | | } else { |
| @hdr = @fld; | | @hdr = @fld; |
| | |
| skipping to change at line 568 | | skipping to change at line 592 |
|---|
| sub HostInfoWrite | | sub HostInfoWrite |
| { | | { |
| my($s, $hosts) = @_; | | my($s, $hosts) = @_; |
| my($gotHdr, @fld, $hostText, $contents, $hostFd); | | my($gotHdr, @fld, $hostText, $contents, $hostFd); |
| | |
| if ( !open($hostFd, "$s->{ConfDir}/hosts") ) { | | if ( !open($hostFd, "$s->{ConfDir}/hosts") ) { |
| return "Can't open $s->{ConfDir}/hosts"; | | return "Can't open $s->{ConfDir}/hosts"; |
| } | | } |
| foreach my $host ( keys(%$hosts) ) { | | foreach my $host ( keys(%$hosts) ) { |
| my $name = "$hosts->{$host}{host}"; | | my $name = "$hosts->{$host}{host}"; |
|
| my $rest = "\t$hosts->{$host}{dhcp}" | | my $rest = "\t$hosts->{$host}{dhcp}\t$hosts->{$host}{user}\t$hosts->{$ho |
| . "\t$hosts->{$host}{user}" | | st}{moreUsers}"; |
| . "\t$hosts->{$host}{moreUsers}"; | | |
| $name =~ s/ /\\ /g; | | $name =~ s/ /\\ /g; |
| $rest =~ s/ //g; | | $rest =~ s/ //g; |
| $hostText->{$host} = $name . $rest; | | $hostText->{$host} = $name . $rest; |
| } | | } |
| binmode($hostFd); | | binmode($hostFd); |
| while ( <$hostFd> ) { | | while ( <$hostFd> ) { |
| s/[\n\r]+//; | | s/[\n\r]+//; |
| if ( /^\s*$/ || /^\s*#/ ) { | | if ( /^\s*$/ || /^\s*#/ ) { |
| $contents .= $_ . "\n"; | | $contents .= $_ . "\n"; |
| next; | | next; |
| | | |
| End of changes. 27 change blocks. |
|---|
| 69 lines changed or deleted | | 94 lines changed or added |
|---|
"Fossies" - the Fresh Open Source Software Archive 