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