Minor changes to lib/BackupPC/Xfer/RsyncDigest.pm and bin/BackupPC_nightly
[BackupPC.git] / bin / BackupPC_nightly
1 #!/bin/perl
2 #============================================================= -*-perl-*-
3 #
4 # BackupPC_nightly: Nightly cleanup & statistics script.
5 #
6 # DESCRIPTION
7 #
8 #   BackupPC_nightly performs several administrative tasks:
9 #
10 #      - monthly aging of per-PC log files (only with -m option)
11 #
12 #      - pruning files from pool no longer used (ie: those with only one
13 #        hard link).
14 #
15 #      - sending email to users and administrators (only with -m option)
16 #
17 #   Usage: BackupPC_nightly [-m] poolRangeStart poolRangeEnd
18 #
19 #   Flags:
20 #
21 #     -m   Do monthly aging of per-PC log files and sending of email.
22 #          Otherise, BackupPC_nightly just does pool pruning.
23 #          Since several BackupPC_nightly processes might run
24 #          concurrently, just the first one is given the -m flag
25 #          by BackupPC.
26 #
27 #   The poolRangeStart and poolRangeEnd arguments are integers from 0 to 255.
28 #   These specify which parts of the pool to process.  There are 256 2nd-level
29 #   directories in the pool (0/0, 0/1, ..., f/e, f/f).  BackupPC_nightly
30 #   processes the given subset of this list (0 means 0/0, 255 means f/f).
31 #   Therefore, arguments of 0 255 process the entire pool, 0 127 does
32 #   the first half (ie: 0/0 through 7/f), 127 255 does the other half
33 #   (eg: 8/0 through f/f) and 0 15 does just the first 1/16 of the pool
34 #   (ie: 0/0 through 0/f).
35 #
36 # AUTHOR
37 #   Craig Barratt  <cbarratt@users.sourceforge.net>
38 #
39 # COPYRIGHT
40 #   Copyright (C) 2001-2004  Craig Barratt
41 #
42 #   This program is free software; you can redistribute it and/or modify
43 #   it under the terms of the GNU General Public License as published by
44 #   the Free Software Foundation; either version 2 of the License, or
45 #   (at your option) any later version.
46 #
47 #   This program is distributed in the hope that it will be useful,
48 #   but WITHOUT ANY WARRANTY; without even the implied warranty of
49 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
50 #   GNU General Public License for more details.
51 #
52 #   You should have received a copy of the GNU General Public License
53 #   along with this program; if not, write to the Free Software
54 #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
55 #
56 #========================================================================
57 #
58 # Version 3.0.0beta3, released 3 Dec 2006.
59 #
60 # See http://backuppc.sourceforge.net.
61 #
62 #========================================================================
63
64 use strict;
65 no  utf8;
66 use lib "/usr/local/BackupPC/lib";
67 use BackupPC::Lib;
68 use BackupPC::FileZIO;
69 use Getopt::Std;
70
71 use File::Find;
72 use File::Path;
73 use Data::Dumper;
74
75 die("BackupPC::Lib->new failed\n") if ( !(my $bpc = BackupPC::Lib->new) );
76 my $TopDir = $bpc->TopDir();
77 my $BinDir = $bpc->BinDir();
78 my %Conf   = $bpc->Conf();
79 my(%Status, %Info, %Jobs, @BgQueue, @UserQueue, @CmdQueue);
80
81 #
82 # We delete unused pool files (link count 1) in sorted inode
83 # order by gathering batches.  We delete the first half of
84 # each batch (ie: $PendingDeleteMax / 2 at a time).
85 #
86 my @PendingDelete;
87 my $PendingDeleteMax = 10240;
88
89 $bpc->ChildInit();
90
91 my %opts;
92 if ( !getopts("m", \%opts) || @ARGV != 2 ) {
93     print("usage: $0 [-m] poolRangeStart poolRangeEnd\n");
94     exit(1);
95 }
96 if ( $ARGV[0] !~ /^(\d+)$/ || $1 > 255 ) {
97     print("$0: bad poolRangeStart '$ARGV[0]'\n");
98     exit(1);
99 }
100 my $poolRangeStart = $1;
101 if ( $ARGV[1] !~ /^(\d+)$/ || $1 > 255 ) {
102     print("$0: bad poolRangeEnd '$ARGV[1]'\n");
103     exit(1);
104 }
105 my $poolRangeEnd = $1;
106
107 if ( $opts{m} ) {
108     my $err = $bpc->ServerConnect($Conf{ServerHost}, $Conf{ServerPort});
109     if ( $err ) {
110         print("Can't connect to server ($err)\n");
111         exit(1);
112     }
113     my $reply = $bpc->ServerMesg("status hosts");
114     $reply = $1 if ( $reply =~ /(.*)/s );
115     eval($reply);
116 }
117
118 ###########################################################################
119 # Get statistics on the pool, and remove files that have only one link.
120 ###########################################################################
121
122 my $fileCnt;       # total number of files
123 my $dirCnt;        # total number of directories
124 my $blkCnt;        # total block size of files
125 my $fileCntRm;     # total number of removed files
126 my $blkCntRm;      # total block size of removed files
127 my $blkCnt2;       # total block size of files with just 2 links
128                    # (ie: files that only occur once among all backups)
129 my $fileCntRep;    # total number of file names containing "_", ie: files
130                    # that have repeated md5 checksums
131 my $fileRepMax;    # worse case number of files that have repeated checksums
132                    # (ie: max(nnn+1) for all names xxxxxxxxxxxxxxxx_nnn)
133 my $fileLinkMax;   # maximum number of hardlinks on a pool file
134 my $fileLinkTotal; # total number of hardlinks on entire pool
135 my $fileCntRename; # number of renamed files (to keep file numbering
136                    # contiguous)
137 my %FixList;       # list of paths that need to be renamed to avoid
138                    # new holes
139 my @hexChars = qw(0 1 2 3 4 5 6 7 8 9 a b c d e f);
140
141 for my $pool ( qw(pool cpool) ) {
142     for ( my $i = $poolRangeStart ; $i <= $poolRangeEnd ; $i++ ) {
143         my $dir        = "$hexChars[int($i / 16)]/$hexChars[$i % 16]";
144         # print("Doing $pool/$dir\n") if ( ($i % 16) == 0 );
145         $fileCnt       = 0;
146         $dirCnt        = 0;
147         $blkCnt        = 0;
148         $fileCntRm     = 0;
149         $blkCntRm      = 0;
150         $blkCnt2       = 0;
151         $fileCntRep    = 0;
152         $fileRepMax    = 0;
153         $fileLinkMax   = 0;
154         $fileCntRename = 0;
155         %FixList       = ();
156         find({wanted => \&GetPoolStats}, "$TopDir/$pool/$dir")
157                                             if ( -d "$TopDir/$pool/$dir" );
158         my $kb   = $blkCnt / 2;
159         my $kbRm = $blkCntRm / 2;
160         my $kb2  = $blkCnt2 / 2;
161
162         #
163         # Main BackupPC_nightly counts the top-level directory
164         #
165         $dirCnt++ if ( $opts{m} && -d "$TopDir/$pool" && $i == 0 );
166
167         #
168         # Also count the next level directories
169         #
170         $dirCnt++ if ( ($i % 16) == 0
171                        && -d "$TopDir/$pool/$hexChars[int($i / 16)]" );
172
173         #
174         # We need to process all pending deletes before we do the
175         # renames
176         #
177         if ( @PendingDelete ) {
178             sleep(1);
179             processPendingDeletes(1);
180         }
181
182         #
183         # Now make sure that files with repeated checksums are still
184         # sequentially numbered
185         #
186         foreach my $name ( sort(keys(%FixList)) ) {
187             my $rmCnt = $FixList{$name} + 1;
188             my $new = -1;
189             for ( my $old = -1 ; ; $old++ ) {
190                 my $oldName = $name;
191                 $oldName .= "_$old" if ( $old >= 0 );
192                 if ( !-f $oldName ) {
193                     #
194                     # We know we are done when we have missed at least
195                     # the number of files that were removed from this
196                     # base name, plus a couple just to be sure
197                     #
198                     last if ( $rmCnt-- <= 0 );
199                     next;
200                 }
201                 my $newName = $name;
202                 $newName .= "_$new" if ( $new >= 0 );
203                 $new++;
204                 next if ( $oldName eq $newName );
205                 rename($oldName, $newName);
206                 $fileCntRename++;
207             }
208         }
209         print("BackupPC_stats $i = $pool,$fileCnt,$dirCnt,$kb,$kb2,$kbRm,"
210                               . "$fileCntRm,$fileCntRep,$fileRepMax,"
211                               . "$fileCntRename,$fileLinkMax,$fileLinkTotal\n");
212     }
213 }
214
215 sleep(1);
216 processPendingDeletes(1);
217
218 ###########################################################################
219 # Tell BackupPC that it is now ok to start running BackupPC_dump
220 # commands.  We are guaranteed that no BackupPC_link commands will
221 # run since only a single CmdQueue command runs at a time, and
222 # that means we are safe.  As of 3.x this is irrelevant since
223 # BackupPC_dump runs independent of BackupPC_dump.
224 ###########################################################################
225 printf("BackupPC_nightly lock_off\n");
226
227 ###########################################################################
228 # Send email and generation of backupInfo files for each backup
229 ###########################################################################
230 if ( $opts{m} ) {
231     print("log BackupPC_nightly now running BackupPC_sendEmail\n");
232     system("$BinDir/BackupPC_sendEmail");
233     doBackupInfoUpdate();
234 }
235
236 #
237 # Update the backupInfo files based on the backups file.
238 # We do this just once a week (on Sun) since it is only
239 # needed for old backups with BackupPC <= 2.1.2.
240 #
241 sub doBackupInfoUpdate
242 {
243     my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
244     return if ( $wday != 0 );
245
246     foreach my $host ( sort(keys(%{$bpc->HostInfoRead()})) ) {
247         my @Backups = $bpc->BackupInfoRead($host);
248
249         for ( my $i = 0 ; $i < @Backups ; $i++ ) {
250             #
251             # BackupPC::Storage->backupInfoWrite won't overwrite
252             # an existing file
253             #
254             BackupPC::Storage->backupInfoWrite("$TopDir/pc/$host",
255                                                $Backups[$i]{num},
256                                                $Backups[$i]);
257         }
258     }
259 }
260
261 sub GetPoolStats
262 {
263     my($inode, $nlinks, $nblocks) = (lstat($_))[1, 3, 12];
264  
265     if ( -d _ ) {
266         $dirCnt++;
267         return;
268     } elsif ( ! -f _ ) {
269         return;
270     }
271     if ( $nlinks == 1 ) {
272         $blkCntRm += $nblocks;
273         $fileCntRm++;
274         #
275         # Save the files for later batch deletion.
276         #
277         # This is so we can remove them in inode order, and additionally
278         # reduce any remaining chance of race condition of linking to
279         # pool files vs removing pool files.  (Other aspects of the
280         # design should eliminate race conditions.)
281         #
282         my $fullPath = $File::Find::name;
283         push(@PendingDelete, {
284                     inode => $inode,
285                     path  => $fullPath
286                 }
287         );
288         if ( @PendingDelete > $PendingDeleteMax ) {
289             processPendingDeletes(0);
290         }
291         #
292         # We must keep repeated files numbered sequential (ie: files
293         # that have the same checksum are appended with _0, _1 etc).
294         # There are two cases: we remove the base file xxxx, but xxxx_0
295         # exists, or we remove any file of the form xxxx_nnn.  We remember
296         # the base name and fix it up later (not in the middle of find).
297         #
298         $fullPath =~ s/_\d+$//;
299         $FixList{$fullPath}++;
300     } else {
301         if ( /_(\d+)$/ ) {
302             $fileRepMax = $1 + 1 if ( $fileRepMax <= $1 );
303             $fileCntRep++;
304         }
305         $fileCnt += 1;
306         $blkCnt  += $nblocks;
307         $blkCnt2 += $nblocks if ( $nlinks == 2 );
308         $fileLinkMax = $nlinks if ( $fileLinkMax < $nlinks );
309         $fileLinkTotal += $nlinks - 1;
310     }
311 }
312
313 sub processPendingDeletes
314 {
315     my($doAll) = @_;
316     my @delete;
317
318     if ( !$doAll ) {
319         @delete = splice(@PendingDelete, 0, $PendingDeleteMax / 2);
320     } else {
321         @delete = @PendingDelete;
322         @PendingDelete = ();
323     }
324     for my $f ( sort({ $a->{inode} <=> $b->{inode} } @delete) ) {
325         my($nlinks) = (lstat($f->{path}))[3];
326
327         next if ( $nlinks != 1 );
328         # print("Deleting $f->{path} ($f->{inode})\n");
329         unlink($f->{path});
330     }
331 }