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