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