8a3523cc612b6d313d5a8fd1dc2eb9ffb590e655
[BackupPC.git] / bin / BackupPC_compressPool
1 #!/bin/perl
2 #============================================================= -*-perl-*-
3 #
4 # BackupPC_compressPool: Compress existing pool
5 #
6 # DESCRIPTION
7 #
8 #   Usage: BackupPC_compressPool [-t] [-r] <host>
9 #
10 #   Flags:
11 #     -t     test mode: do everything except actually replace the pool files.
12 #            Useful for estimating total run time without making any real
13 #            changes.
14 #     -r     read check: re-read the compressed file and compare it against
15 #            the original uncompressed file.  Can only be used in test mode.
16 #     -c #   number of children to fork.  BackupPC_compressPool can take
17 #            a long time to run, so to speed things up it spawns four children,
18 #            each working on a different part of the pool.  You can change
19 #            the number of children with the -c option.
20 #
21 #   BackupPC_compressPool is used to convert an uncompressed pool to
22 #   a compressed pool.  If BackupPC compression is enabled after
23 #   uncompressed backups already exist, BackupPC_compressPool can
24 #   be used to compress all the old uncompressed backups.
25 #
26 #   It is important that BackupPC not run while BackupPC_compressPool
27 #   runs.  Also, BackupPC_compressPool must run to completion before
28 #   BackupPC is restarted.
29 #
30 # AUTHOR
31 #   Craig Barratt  <cbarratt@users.sourceforge.net>
32 #
33 # COPYRIGHT
34 #   Copyright (C) 2001-2007  Craig Barratt
35 #
36 #   This program is free software; you can redistribute it and/or modify
37 #   it under the terms of the GNU General Public License as published by
38 #   the Free Software Foundation; either version 2 of the License, or
39 #   (at your option) any later version.
40 #
41 #   This program is distributed in the hope that it will be useful,
42 #   but WITHOUT ANY WARRANTY; without even the implied warranty of
43 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
44 #   GNU General Public License for more details.
45 #
46 #   You should have received a copy of the GNU General Public License
47 #   along with this program; if not, write to the Free Software
48 #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
49 #
50 #========================================================================
51 #
52 # Version 3.1.0beta0, released 3 Sep 2007.
53 #
54 # See http://backuppc.sourceforge.net.
55 #
56 #========================================================================
57
58 use strict;
59 no  utf8;
60
61 use File::Find;
62 use File::Path;
63 use Compress::Zlib;
64 use Getopt::Std;
65 use lib "/usr/local/BackupPC/lib";
66 use BackupPC::Lib;
67 use BackupPC::FileZIO;
68
69 die("BackupPC::Lib->new failed\n") if ( !(my $bpc = BackupPC::Lib->new) );
70 $bpc->ChildInit();
71 my $TopDir   = $bpc->TopDir();
72 my $LogDir   = $bpc->LogDir();
73 my $BinDir   = $bpc->BinDir();
74 my %Conf     = $bpc->Conf();
75 my $PoolDir  = "$TopDir/pool";
76 my $CPoolDir = "$TopDir/cpool";
77 my $Compress = $Conf{CompressLevel};
78 my %opts;
79 my $SigName = "";
80
81 #
82 # Catch various signals
83 #
84 foreach my $sig ( qw(INT BUS SEGV PIPE TERM ALRM HUP) ) {
85     $SIG{$sig} = \&catch_signal;
86 }
87
88 $| = 1;
89
90 my $CompMaxRead  = 131072;          # 128K
91 my $CompMaxWrite = 6291456;         # 6MB
92
93 if ( !getopts("trc:", \%opts) || @ARGV != 0 ) {
94     print("usage: $0 [-c nChild] [-r] [-t]\n");
95     exit(1);
96 }
97 my $TestMode  = $opts{t};
98 my $ReadCheck = $opts{r};
99 my $nChild    = $opts{c} || 4;
100 if ( $ReadCheck && !$TestMode ) {
101     print(STDERR "$0: -r (read check) option must have -t (test)\n");
102     exit(1);
103 }
104 if ( $nChild < 1 || $nChild >= 16 ) {
105     print(STDERR "$0: number of children (-c option) must be from 1 to 16\n");
106     exit(1);
107 }
108 if ( !BackupPC::FileZIO->compOk ) {
109     print STDERR <<EOF;
110 $0: Compress::Zlib is not installed.   You need to install it
111 before running this script.
112 EOF
113     exit(1);
114 }
115 if ( $Compress <= 0 ) {
116     print STDERR <<EOF;
117 $0: compression is not enabled. \%Conf{CompressLevel} needs
118 to be set to a value from 1 to 9.  Please edit the config.pl file and
119 re-start $0.
120 EOF
121     exit(1);
122 }
123
124 my $Errors     = 0;
125 my $SubDirDone = 0;
126 my $SubDirCnt  = 0;
127 my $SubDirCurr = 0;
128 my $FileCnt    = 0;
129 my $FileOrigSz = 0;
130 my $FileCompressSz = 0;
131
132 my $err = $bpc->ServerConnect($Conf{ServerHost}, $Conf{ServerPort});
133 if ( $err eq "" ) {
134     print <<EOF;
135 BackupPC is running on $Conf{ServerHost}.  You need to stop BackupPC
136 before you can upgrade the code.  Depending upon your installation,
137 you could run "/etc/init.d/backuppc stop".
138 EOF
139     exit(1);
140 }
141
142 umask($Conf{UmaskMode});
143
144 sub cpoolFileName
145 {
146     my($new) = @_;
147     if ( $new !~ m{/(\w/\w/\w)/(\w{32})(_\d+)?$} ) {
148         print("Error: Can't parse filename from $new\n");
149         $Errors++;
150         return;
151     }
152     my $dir = "$CPoolDir/$1";
153     $new = "$dir/$2";
154     mkpath($dir, 0, 0777) if ( !-d $dir );
155     return $new if ( !-f $new );
156     for ( my $i = 0 ; ; $i++ ) {
157         return "${new}_$i" if ( !-f "${new}_$i" );
158     }
159 }
160
161 sub doCompress
162 {
163     my $file = ($File::Find::name =~ /(.*)/ && $1);
164     local(*FH, *OUT);
165     my(@s) = stat($file);
166     my($n, $dataIn, $dataOut, $flush, $copy);
167
168     if ( $SigName ) {
169         print("Child got signal $SigName; quitting\n");
170         reportStats();
171         exit(0);
172     }
173     return if ( !-f $file );
174     my $defl = deflateInit(
175                 -Bufsize => 65536,
176                 -Level   => $Compress,
177            );
178     if ( !open(FH, $TestMode ? "<" : "+<", $file) ) {
179         print("Error: Can't open $file for read/write\n");
180         $Errors++;
181         return;
182     }
183     binmode(FH);
184     while ( sysread(FH, $dataIn, $CompMaxWrite) > 0 ) {
185         $flush = 0;
186         $FileOrigSz += length($dataIn);
187         my $fragOut = $defl->deflate($dataIn);
188         if ( length($fragOut) < $CompMaxRead ) {
189             #
190             # Compression is too high: to avoid huge memory requirements
191             # on read we need to flush().
192             #
193             $fragOut .= $defl->flush();
194             $flush = 1;
195             $defl = deflateInit(
196                         -Bufsize => 65536,
197                         -Level   => $Compress,
198                    );
199         }
200         $dataOut .= $fragOut;
201         if ( !$copy && length($dataOut) > $CompMaxWrite ) {
202             if ( !open(OUT, "+>", "$file.__z") ) {
203                 print("Error: Can't open $file.__z for write\n");
204                 $Errors++;
205                 close(FH);
206                 return;
207             }
208             binmode(OUT);
209             $copy = 1;
210         }
211         if ( $copy && $dataOut ne "" ) {
212             if ( syswrite(OUT, $dataOut) != length($dataOut) ) {
213                 printf("Error: Can't write %d bytes to %s\n",
214                                     length($dataOut), "$file.__z");
215                 $Errors++;
216                 close(OUT);
217                 close(FH);
218                 unlink("$file.__z");
219                 return;
220             }
221             $FileCompressSz += length($dataOut);
222             $dataOut = undef;
223         }
224     }
225     if ( !$flush ) {
226         $dataOut .= $defl->flush();
227         if ( $copy && $dataOut ne "" ) {
228             if ( syswrite(OUT, $dataOut) != length($dataOut) ) {
229                 printf("Error: Can't write %d bytes to %s\n",
230                                     length($dataOut), "$file.__z");
231                 $Errors++;
232                 close(OUT);
233                 close(FH);
234                 unlink("$file.__z");
235                 return;
236             }
237             $FileCompressSz += length($dataOut);
238             $dataOut = undef;
239         }
240     }
241     my $newFile = cpoolFileName($file);
242     if ( $TestMode ) {
243         close(FH);
244         if ( !open(FH, ">", $newFile) ) {
245             print("Error: Can't open $newFile for write\n");
246             $Errors++;
247             close(FH);
248             unlink("$file.__z");
249             return;
250         }
251         binmode(FH);
252     }
253     if ( $copy ) {
254         if ( !sysseek(OUT, 0, 0) ) {
255             print("Error: Can't seek $file.__z to 0\n");
256             $Errors++;
257         }
258         if ( !sysseek(FH, 0, 0) ) {
259             print("Error: Can't seek $newFile to 0\n");
260             $Errors++;
261         }
262         while ( sysread(OUT, $dataIn, $CompMaxWrite) > 0 ) {
263             if ( syswrite(FH, $dataIn) != length($dataIn) ) {
264                 printf("Error: Can't write %d bytes to %s\n",
265                                         length($dataIn), $file);
266                 $Errors++;
267             }
268         }
269         if ( !truncate(FH, sysseek(OUT, 0, 1)) ) {
270             printf("Error: Can't truncate %s to %d\n",
271                                         $file, sysseek(OUT, 0, 1));
272             $Errors++;
273         }
274         close(OUT);
275         close(FH);
276         unlink("$file.__z");
277     } else {
278         if ( !sysseek(FH, 0, 0) ) {
279             print("Error: Can't seek $file to 0\n");
280             $Errors++;
281         }
282         if ( syswrite(FH, $dataOut) != length($dataOut) ) {
283             printf("Error: Can't write %d bytes to %s\n",
284                                         length($dataOut), $file);
285             $Errors++;
286         }
287         $FileCompressSz += length($dataOut);
288         if ( !truncate(FH, length($dataOut)) ) {
289             printf("Error: Can't truncate %s to %d\n", $file, length($dataOut));
290             $Errors++;
291         }
292         close(FH);
293     }
294     if ( $TestMode ) {
295         if ( $ReadCheck ) {
296             checkRead($file, $newFile);
297         }
298         unlink($newFile);
299     } else {
300         rename($file, $newFile);
301         my $atime = $s[8] =~ /(.*)/ && $1;
302         my $mtime = $s[9] =~ /(.*)/ && $1;
303         utime($atime, $mtime, $newFile);
304     }
305     (my $dir = $file) =~ s{/[^/]*$}{};
306     $FileCnt++;
307     if ( $SubDirCurr ne "" && $SubDirCurr ne $dir ) {
308         $SubDirDone++;
309         $SubDirCurr = $dir;
310         reportStats();
311     } elsif ( $SubDirCurr eq "" ) {
312         $SubDirCurr = $dir;
313     }
314 }
315
316 sub reportStats
317 {
318     print("stats: $SubDirDone $SubDirCnt $FileCnt $FileOrigSz"
319                 . " $FileCompressSz $Errors\n");
320 }
321
322 sub checkRead
323 {
324     my($file, $cfile) = @_;
325     return if ( !-f $file || !-f $cfile );
326     my $f = BackupPC::FileZIO->open($cfile, 0, $Compress)
327                                 || die("can't open $cfile for read\n");
328     my($n, $nd, $r, $d, $d0);
329     local(*FH);
330
331     if ( !open(FH, "<", $file) ) {
332         print("can't open $file for check\n");
333         $Errors++;
334         $f->close();
335         return;
336     }
337     binmode(FH);
338     #print("comparing $file to $cfile\n");
339     while ( 1 ) {
340         $n = 1 + int(rand($CompMaxRead) + rand(100));
341         $r = $f->read(\$d, $n);
342         sysread(FH, $d0, $n);
343         if ( $d ne $d0 ) {
344             print("Botch read data on $cfile\n");
345         }
346         last if ( length($d) == 0 );
347     }
348     if ( ($r = $f->read(\$d, 100)) != 0 || ($r = $f->read(\$d, 100)) != 0 ) {
349         printf("Botch at EOF on $cfile got $r (%d,%d)\n",
350                         sysseek(FH, 0, 1), $n);
351         $Errors++;
352     }
353     $f->close;
354     close(FH);
355 }
356
357 sub checkReadLine
358 {
359     my($file, $cfile) = @_;
360     return if ( !-f $file || !-f $cfile );
361     my $f = BackupPC::FileZIO->open($cfile, 0, $Compress)
362                                 || die("can't open $cfile for read\n");
363     my($n, $nd, $r, $d, $d0);
364     local(*FH);
365
366     if ( !open(FH, "<", $file) ) {
367         print("can't open $file for check\n");
368         $Errors++;
369         $f->close();
370         return;
371     }
372     binmode(FH);
373     while ( 1 ) {
374         $d0 = <FH>;
375         $d  = $f->readLine();
376         if ( $d ne $d0 ) {
377             print("Botch read data on $cfile\n");
378         }
379         last if ( length($d) == 0 );
380     }
381     if ( ($r = $f->read(\$d, 100)) != 0 || ($r = $f->read(\$d, 100)) != 0 ) {
382         printf("Botch at EOF on $cfile got $r (%d,%d)\n",
383                         sysseek(FH, 0, 1), $n);
384         $Errors++;
385     }
386     $f->close;
387     close(FH);
388 }
389
390 sub catch_signal
391 {
392     $SigName = shift;
393 }
394
395 sub compressHostFiles
396 {
397     my($host) = @_;
398     my(@Files, @Backups, $fh, $data);
399     local(*FH);
400
401     if ( !defined($host) ) {
402         for ( my $i = 0 ; ; $i++ ) {
403             last if ( !-f "$LogDir/LOG.$i" );
404             push(@Files, "$LogDir/LOG.$i");
405         }
406     } else {
407         @Backups = $bpc->BackupInfoRead($host);
408         for ( my $i = 0 ; $i < @Backups ; $i++ ) {
409             next if ( $Backups[$i]{compress} );
410             push(@Files, "$TopDir/pc/$host/SmbLOG.$Backups[$i]{num}");
411             push(@Files, "$TopDir/pc/$host/XferLOG.$Backups[$i]{num}");
412         }
413         push(@Files, "$TopDir/pc/$host/SmbLOG.bad");
414         push(@Files, "$TopDir/pc/$host/XferLOG.bad");
415         for ( my $i = 0 ; ; $i++ ) {
416             last if ( !-f "$TopDir/pc/$host/LOG.$i" );
417             push(@Files, "$TopDir/pc/$host/LOG.$i");
418         }
419     }
420     foreach my $file ( @Files ) {
421         if ( $SigName ) {
422             print("Child got signal $SigName; quitting\n");
423             reportStats();
424             exit(0);
425         }
426         next if ( !-f $file );
427         if ( !BackupPC::FileZIO->compressCopy($file, "$file.z", undef,
428                                         $Compress, !$TestMode) ) {
429             print("compressCopy($file, $file.z, $Compress, !$TestMode)"
430                 . " failed\n");
431             $Errors++;
432         } elsif ( $TestMode ) {
433             checkReadLine($file, "$file.z") if ( $ReadCheck );
434             unlink("$file.z");
435         }
436     }
437 }
438
439 sub updateHostBackupInfo
440 {
441     my($host) = @_;
442     if ( !$TestMode ) {
443         my @Backups = $bpc->BackupInfoRead($host);
444         for ( my $i = 0 ; $i < @Backups ; $i++ ) {
445             $Backups[$i]{compress} = $Compress;
446         }
447         $bpc->BackupInfoWrite($host, @Backups);
448     }
449 }
450
451 my @Dirs = split(//, "0123456789abcdef");
452 my @Hosts = sort(keys(%{$bpc->HostInfoRead()}));
453 my $FDread;
454 my @Jobs;
455
456 #
457 # First make sure there are no existing compressed backups
458 #
459 my(%compHosts, $compCnt);
460 for ( my $j = 0 ; $j < @Hosts ; $j++ ) {
461     my $host = $Hosts[$j];
462     my @Backups = $bpc->BackupInfoRead($host);
463     for ( my $i = 0 ; $i < @Backups ; $i++ ) {
464         next if ( !$Backups[$i]{compress} );
465         $compHosts{$host}++;
466         $compCnt++;
467     }
468 }
469 if ( $compCnt ) {
470     my $compHostStr = join("\n  + ", sort(keys(%compHosts)));
471     print STDERR <<EOF;
472 BackupPC_compressPool: there are $compCnt compressed backups.
473 BackupPC_compressPool can only be run when there are no existing
474 compressed backups. The following hosts have compressed backups:
475
476   + $compHostStr
477
478 If you really want to run BackupPC_compressPool you will need to remove
479 all the existing compressed backups (and /home/pcbackup/data/cpool).
480 Think carefully before you do this. Otherwise, you can just let new
481 compressed backups run and the old uncompressed backups and pool will
482 steadily expire.
483 EOF
484     exit(0);
485 }
486
487 #
488 # Next spawn $nChild children that actually do all the work.
489 #
490 for ( my $i = 0 ; $i < $nChild ; $i++ ) {
491     local(*CHILD);
492     my $pid;
493     if ( !defined($pid = open(CHILD, "-|")) ) {
494         print("Can't fork\n");
495         next;
496     }
497     my $nDirs  = @Dirs  / ($nChild - $i);
498     my $nHosts = @Hosts / ($nChild - $i);
499     if ( !$pid ) {
500         #
501         # This is the child.
502         # First process each of the hosts (compress per-pc log files etc).
503         #
504         for ( my $j = 0 ; $j < $nHosts ; $j++ ) {
505             compressHostFiles($Hosts[$j]);
506         }
507         #
508         # Count the total number of directories so we can estimate the
509         # completion time.  We ignore empty directories by reading each
510         # directory and making sure it has at least 3 entries (ie, ".",
511         # ".." and a file).
512         #
513         for ( my $j = 0 ; $j < $nDirs ; $j++ ) {
514             my $thisDir = $Dirs[$j];
515             next if ( !-d "$PoolDir/$thisDir" );
516             foreach my $dir ( <$PoolDir/$thisDir/*/*> ) {
517                 next if ( !opendir(DIR, $dir) );
518                 my @files = readdir(DIR);
519                 closedir(DIR);
520                 $SubDirCnt++ if ( @files > 2 );
521             }
522         }
523         #
524         # Now process each of the directories
525         #
526         for ( my $j = 0 ; $j < $nDirs ; $j++ ) {
527             my $thisDir = shift(@Dirs);
528             next if ( !-d "$PoolDir/$thisDir" );
529             find({wanted => sub { doCompress($File::Find::name); },
530                                    no_chdir => 1}, "$PoolDir/$thisDir");
531         }
532         #
533         # Last, update the backup info file for each of the hosts
534         #
535         for ( my $j = 0 ; $j < $nHosts ; $j++ ) {
536             updateHostBackupInfo($Hosts[$j]);
537         }
538         $SubDirDone = $SubDirCnt;
539         reportStats();
540         exit(0);
541     }
542     #
543     # This is the parent.  Peel off $nDirs directories, $nHosts hosts,
544     # and continue
545     #
546     $Jobs[$i]{fh}  = *CHILD;
547     $Jobs[$i]{pid} = $pid;
548     vec($FDread, fileno($Jobs[$i]{fh}), 1) = 1;
549     splice(@Dirs,  0, $nDirs);
550     splice(@Hosts, 0, $nHosts);
551 }
552
553 #
554 # compress the main log files (in the parents)
555 #
556 compressHostFiles(undef);
557
558 #
559 # Now wait for all the children to report results and finish up
560 #
561 my $TimeStart = time;
562 my $DonePct   = 0;
563 my $GotSignal = "";
564 while ( $FDread !~ /^\0*$/ ) {
565     my $ein = $FDread;
566     select(my $rout = $FDread, undef, $ein, undef);
567     if ( $SigName ne $GotSignal ) {
568         print("Got signal $SigName; waiting for $nChild children to cleanup\n");
569         $GotSignal = $SigName;
570     }
571     for ( my $i = 0 ; $i < $nChild ; $i++ ) {
572         next if ( !vec($rout, fileno($Jobs[$i]{fh}), 1) );
573         my $data;
574         if ( sysread($Jobs[$i]{fh}, $data, 1024) <= 0 ) {
575             vec($FDread, fileno($Jobs[$i]{fh}), 1) = 0;
576             close($Jobs[$i]{fh});
577             next;
578         }
579         $Jobs[$i]{mesg} .= $data;
580         while ( $Jobs[$i]{mesg} =~ /(.*?)[\n\r]+(.*)/s ) {
581             my $mesg = $1;
582             $Jobs[$i]{mesg} = $2;
583             if ( $mesg =~ /^stats: (\d+) (\d+) (\d+) (\d+) (\d+) (\d+)/ ) {
584                 $Jobs[$i]{SubDirDone}     = $1;
585                 $Jobs[$i]{SubDirCnt}      = $2;
586                 $Jobs[$i]{FileCnt}        = $3;
587                 $Jobs[$i]{FileOrigSz}     = $4;
588                 $Jobs[$i]{FileCompressSz} = $5;
589                 $Jobs[$i]{Errors}         = $6;
590                 $SubDirDone = $SubDirCnt = $FileCnt = $FileOrigSz = 0;
591                 $FileCompressSz = $Errors = 0;
592                 my $numReports = 0;
593                 for ( my $j = 0 ; $j < $nChild ; $j++ ) {
594                     next if ( !defined($Jobs[$j]{SubDirDone}) );
595                     $SubDirDone     += $Jobs[$j]{SubDirDone};
596                     $SubDirCnt      += $Jobs[$j]{SubDirCnt};
597                     $FileCnt        += $Jobs[$j]{FileCnt};
598                     $FileOrigSz     += $Jobs[$j]{FileOrigSz};
599                     $FileCompressSz += $Jobs[$j]{FileCompressSz};
600                     $Errors         += $Jobs[$j]{Errors};
601                     $numReports++;
602                 }
603                 $SubDirCnt  ||= 1;
604                 $FileOrigSz ||= 1;
605                 my $pctDone = 100 * $SubDirDone / $SubDirCnt;
606                 if ( $numReports == $nChild && $pctDone >= $DonePct + 1 ) {
607                     $DonePct = int($pctDone);
608                     my $estSecLeft = 1.2 * (time - $TimeStart)
609                                          * (100 / $pctDone - 1);
610                     my $timeStamp = $bpc->timeStamp;
611                     printf("%sDone %2.0f%% (%d of %d dirs, %d files,"
612                             . " %.2fGB raw, %.1f%% reduce, %d errors)\n",
613                                 $timeStamp,
614                                 $pctDone, $SubDirDone, $SubDirCnt, $FileCnt,
615                                 $FileOrigSz / (1024 * 1024 * 1000),
616                                 100 * (1 - $FileCompressSz / $FileOrigSz));
617                     printf("%s    Est complete in %.1f hours (around %s)\n",
618                                 $timeStamp, $estSecLeft / 3600,
619                                 $bpc->timeStamp(time + $estSecLeft, 1))
620                                             if ( $DonePct < 100 );
621                 }
622             } else {
623                 print($mesg, "\n");
624             }
625         }
626     }
627 }
628 if ( $Errors ) {
629     print("Finished with $Errors errors!!!!\n");
630     exit(1);
631 }