/[BackupPC]/trunk/bin/BackupPC_incPartsUpdate
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /trunk/bin/BackupPC_incPartsUpdate

Parent Directory Parent Directory | Revision Log Revision Log


Revision 293 - (hide annotations)
Thu Jan 26 00:40:37 2006 UTC (18 years, 4 months ago) by dpavlin
File size: 9962 byte(s)
added option to limit single host (-h) and POD documentation

1 dpavlin 157 #!/usr/local/bin/perl -w
2    
3     use strict;
4     use lib "__INSTALLDIR__/lib";
5    
6     use DBI;
7     use BackupPC::Lib;
8     use BackupPC::View;
9 dpavlin 214 use BackupPC::Attrib qw/:all/;
10 dpavlin 157 use Data::Dumper;
11     use Time::HiRes qw/time/;
12     use POSIX qw/strftime/;
13     use Cwd qw/abs_path/;
14 dpavlin 201 use File::Which;
15 dpavlin 215 use Archive::Tar::Streamed;
16 dpavlin 214 use Algorithm::Diff;
17     use Getopt::Std;
18 dpavlin 264 use File::Slurp;
19 dpavlin 289 use File::Pid;
20 dpavlin 157
21 dpavlin 293 =head1 NAME
22    
23     BackupPC_incPartsUpdate
24    
25     =head1 DESCRIPTION
26    
27     Create C<.tar.gz> increments on disk calling C<BackupPC_tarIncCreate>.
28    
29     Following options are supported (but all are optional):
30    
31     =over 4
32    
33     =item -h hostname
34    
35     Update parts for just single C<hostname>
36    
37     =item -c
38    
39     Force check for tar archives which exist on disk
40    
41     =item -d
42    
43     Turn debugging output
44    
45     =back
46    
47     =cut
48    
49     my %opt;
50     getopts("cdh:", \%opt );
51    
52     my $debug = $opt{d};
53     my $check = $opt{c} && print STDERR "NOTICE: tar archive check forced\n";
54    
55 dpavlin 289 my $pid_path = abs_path($0);
56     $pid_path =~ s/\W+/_/g;
57    
58     my $pidfile = new File::Pid({
59     file => "/tmp/$pid_path",
60     });
61    
62     if (my $pid = $pidfile->running ) {
63     die "$0 already running: $pid\n";
64     } elsif ($pidfile->pid ne $$) {
65     $pidfile->remove;
66     $pidfile = new File::Pid;
67     }
68    
69     print STDERR "$0 using pid ",$pidfile->pid," file ",$pidfile->file,"\n";
70     $pidfile->write;
71    
72 dpavlin 230 my $bpc = BackupPC::Lib->new || die "can't create BackupPC::Lib";
73     my %Conf = $bpc->Conf();
74    
75     use BackupPC::SearchLib;
76     %BackupPC::SearchLib::Conf = %Conf;
77    
78 dpavlin 157 my $path = abs_path($0);
79     $path =~ s#/[^/]+$#/#;
80     my $tarIncCreate = $path .= 'BackupPC_tarIncCreate';
81    
82     die "can't find $tarIncCreate: $!\n" unless (-x $tarIncCreate);
83    
84 dpavlin 201 my $bin;
85 dpavlin 254 foreach my $c (qw/gzip md5sum/) {
86 dpavlin 201 $bin->{$c} = which($c) || die "$0 needs $c, install it\n";
87     }
88    
89 dpavlin 157 $|=1;
90    
91     my $start_t = time();
92    
93     my $t_fmt = '%Y-%m-%d %H:%M:%S';
94    
95     my $dsn = $Conf{SearchDSN} || die "Need SearchDSN in config.pl\n";
96     my $user = $Conf{SearchUser} || '';
97    
98     my $dbh = DBI->connect($dsn, $user, "", { RaiseError => 1, AutoCommit => 0 });
99    
100     my $tar_dir = $Conf{InstallDir}.'/'.$Conf{GzipTempDir};
101    
102     die "problem with $tar_dir, check GzipTempDir in configuration\n" unless (-d $tar_dir && -w $tar_dir);
103    
104     #---- subs ----
105    
106     sub fmt_time {
107     my $t = shift || return;
108     my $out = "";
109     my ($ss,$mm,$hh) = gmtime($t);
110     $out .= "${hh}h" if ($hh);
111     $out .= sprintf("%02d:%02d", $mm,$ss);
112     return $out;
113     }
114    
115     sub curr_time {
116     return strftime($t_fmt,localtime());
117     }
118    
119 dpavlin 264 my $hsn_cache;
120    
121     sub get_backup_id($$$) {
122     my ($host, $share, $num) = @_;
123    
124     my $key = "$host $share $num";
125     return $hsn_cache->{$key} if ($hsn_cache->{$key});
126    
127     my $sth = $dbh->prepare(qq{
128     SELECT
129     backups.id
130     FROM backups
131     INNER JOIN shares ON backups.shareID=shares.ID
132     INNER JOIN hosts ON backups.hostID = hosts.ID
133     where hosts.name = ? and shares.name = ? and backups.num = ?
134     });
135     $sth->execute($host, $share, $num);
136     my ($id) = $sth->fetchrow_array;
137    
138     $hsn_cache->{"$host $share $num"} = $id;
139    
140     print STDERR "# $host $share $num == $id\n" if ($opt{d});
141    
142     return $id;
143     }
144    
145    
146 dpavlin 214 sub tar_check($$$$) {
147     my ($host,$share,$num,$filename) = @_;
148    
149 dpavlin 270 my $t = time();
150     print curr_time, " check $host:$share#$num -> $filename";
151    
152 dpavlin 281 # depending on expected returned value this is used like:
153     # my $uncompress_size = get_gzip_size('/full/path/to.gz');
154     # my ($compress_size, $uncompress_size) = get_gzip_size('/path.gz');
155     sub get_gzip_size($) {
156     my $filename = shift;
157     die "file $filename problem: $!" unless (-r $filename);
158     open(my $gzip, $bin->{gzip}." -l $filename |") || die "can't gzip -l $filename: $!";
159     my $line = <$gzip>;
160     chomp($line);
161     $line = <$gzip> if ($line =~ /^\s+compressed/);
162    
163     my ($comp, $uncomp) = (0,0);
164    
165     if ($line =~ m/^\s+(\d+)\s+(\d+)\s+\d+\.\d+/) {
166     if (wantarray) {
167     return [ $1, $2 ];
168     } else {
169     return $2;
170     }
171     } else {
172     die "can't find size in line: $line";
173     }
174     }
175    
176 dpavlin 264 sub check_part {
177     my ($host, $share, $num, $part_nr, $tar_size, $size, $md5, $items) = @_;
178     my $backup_id = get_backup_id($host, $share, $num);
179     my $sth_md5 = $dbh->prepare(qq{
180     select
181     id, tar_size, size, md5, items
182     from backup_parts
183     where backup_id = ? and part_nr = ?
184     });
185    
186     $sth_md5->execute($backup_id, $part_nr);
187    
188     if (my $row = $sth_md5->fetchrow_hashref) {
189     return if (
190 dpavlin 265 $row->{tar_size} >= $tar_size &&
191 dpavlin 264 $row->{size} == $size &&
192     $row->{md5} eq $md5 &&
193     $row->{items} == $items
194     );
195 dpavlin 270 print ", deleting invalid backup_parts $row->{id}";
196 dpavlin 264 $dbh->do(qq{ delete from backup_parts where id = $row->{id} });
197     }
198 dpavlin 270 print ", inserting new";
199 dpavlin 264 my $sth_insert = $dbh->prepare(qq{
200     insert into backup_parts (
201     backup_id,
202     part_nr,
203     tar_size,
204     size,
205     md5,
206     items
207     ) values (?,?,?,?,?,?)
208     });
209    
210     $sth_insert->execute($backup_id, $part_nr, $tar_size, $size, $md5, $items);
211     $dbh->commit;
212     }
213    
214 dpavlin 254 my @tar_parts;
215    
216     if (-d "$tar_dir/$filename") {
217 dpavlin 270 print ", multi-part";
218 dpavlin 254 opendir(my $dir, "$tar_dir/$filename") || die "can't readdir $tar_dir/$filename: $!";
219     @tar_parts = map { my $p = $_; $p =~ s#^#${filename}/#; $p } grep { !/^\./ && !/md5/ && -f "$tar_dir/$filename/$_" } readdir($dir);
220     closedir($dir);
221     } else {
222     push @tar_parts, "${filename}.tar.gz";
223 dpavlin 214 }
224    
225 dpavlin 256 print " [parts: ",join(", ", @tar_parts),"]" if ($opt{d});
226    
227     my $same = 1;
228 dpavlin 254 my @tar_files;
229 dpavlin 214
230 dpavlin 264 my $backup_part;
231    
232 dpavlin 268 print " reading" if ($opt{d});
233 dpavlin 254
234     foreach my $tarfilename (@tar_parts) {
235    
236 dpavlin 270 print "\n\t- $tarfilename";
237 dpavlin 254
238 dpavlin 281 my $path = "$tar_dir/$tarfilename";
239 dpavlin 269
240 dpavlin 281 my $size = (stat( $path ))[7] || die "can't stat $path: $!";
241    
242 dpavlin 269 if ($size > $Conf{MaxArchiveSize}) {
243 dpavlin 274 print ", part bigger than media $size > $Conf{MaxArchiveSize}\n";
244     return 0;
245 dpavlin 254 }
246    
247 dpavlin 270 print ", $size bytes";
248    
249 dpavlin 264
250 dpavlin 281 open(my $fh, "gzip -cd $path |") or die "can't open $path: $!";
251 dpavlin 254 binmode($fh);
252     my $tar = Archive::Tar::Streamed->new($fh);
253    
254 dpavlin 281 my $tar_size_inarc = 0;
255 dpavlin 264 my $items = 0;
256 dpavlin 256
257 dpavlin 254 while(my $entry = $tar->next) {
258     push @tar_files, $entry->name;
259 dpavlin 264 $items++;
260 dpavlin 281 $tar_size_inarc += $entry->size;
261 dpavlin 269
262 dpavlin 281 if ($tar_size_inarc > $Conf{MaxArchiveFileSize}) {
263     print ", part $tarfilename is too big $tar_size_inarc > $Conf{MaxArchiveFileSize}\n";
264 dpavlin 274 return 0;
265 dpavlin 269 }
266    
267 dpavlin 254 }
268 dpavlin 256
269 dpavlin 281 close($fh);
270    
271 dpavlin 270 print ", $items items";
272    
273 dpavlin 281 if ($tar_size_inarc == 0 && $items == 0) {
274 dpavlin 279 print ", EMPTY tar\n";
275    
276     my $backup_id = get_backup_id($host, $share, $num);
277    
278     my $sth_inc_deleted = $dbh->prepare(qq{
279     update backups set
280     inc_deleted = true
281     where id = ?
282     });
283     $sth_inc_deleted->execute($backup_id);
284 dpavlin 280
285     $dbh->commit;
286    
287     return 1;
288 dpavlin 279 }
289    
290 dpavlin 281 my $tar_size = get_gzip_size( $path );
291 dpavlin 279
292 dpavlin 281 # real tar size is bigger because of padding
293     if ($tar_size_inarc > $tar_size) {
294 dpavlin 282 print ", size of files in tar ($tar_size_inarc) bigger than whole tar ($tar_size)!\n";
295 dpavlin 281 return 0;
296     }
297 dpavlin 280
298 dpavlin 269 #
299     # check if md5 exists, and if not, create one
300     #
301    
302     my $md5_path = $path;
303     $md5_path =~ s/\.tar\.gz$/.md5/ || die "can't create md5 filename from $md5_path";
304     if (! -e $md5_path || -z $md5_path) {
305     print ", creating md5";
306     system( $bin->{md5sum} . " $path > $md5_path") == 0 or die "can't create md5 $path: $!";
307 dpavlin 270 } else {
308     ## FIXME check if existing md5 is valid
309 dpavlin 256 }
310 dpavlin 264
311 dpavlin 269 my $md5 = read_file( $md5_path ) || die "can't read md5sum file $md5_path: $!";
312     $md5 =~ s#\s.*$##;
313    
314     # extract part number from filename
315     my $part_nr = 1;
316     $part_nr = $1 if ($tarfilename =~ m#/(\d+)\.tar\.gz#);
317    
318     #
319     # finally, check if backup_parts table in database is valid
320     #
321    
322 dpavlin 264 check_part($host, $share, $num, $part_nr, $tar_size, $size, $md5, $items);
323 dpavlin 215 }
324 dpavlin 254
325 dpavlin 256 # short-cut and exit;
326     return $same unless($same);
327    
328 dpavlin 215 @tar_files = sort @tar_files;
329 dpavlin 270 print "\n\t",($#tar_files + 1), " tar files";
330 dpavlin 214
331     my $sth = $dbh->prepare(qq{
332     SELECT path,type
333     FROM files
334     JOIN shares on shares.id = shareid
335     JOIN hosts on hosts.id = shares.hostid
336     WHERE hosts.name = ? and shares.name = ? and backupnum = ?
337     });
338     $sth->execute($host, $share, $num);
339     my @db_files;
340     while( my $row = $sth->fetchrow_hashref ) {
341    
342     my $path = $row->{'path'} || die "no path?";
343     $path =~ s#^/#./#;
344     $path .= '/' if ($row->{'type'} == BPC_FTYPE_DIR);
345     push @db_files, $path;
346     }
347    
348 dpavlin 270 print " ",($#db_files + 1), " database files, diff";
349 dpavlin 214
350     @db_files = sort @db_files;
351    
352     if ($#tar_files != $#db_files) {
353     $same = 0;
354 dpavlin 270 print " NUMBER";
355 dpavlin 214 } else {
356     my $diff = Algorithm::Diff->new(\@tar_files, \@db_files);
357     while ( $diff->Next() ) {
358     next if $diff->Same();
359     $same = 0;
360     print "< $_\n" for $diff->Items(1);
361     print "> $_\n" for $diff->Items(2);
362     }
363     }
364    
365 dpavlin 270 print " ",($same ? 'ok' : 'DIFFERENT'),
366     ", dur: ",fmt_time(time() - $t), "\n";
367 dpavlin 214
368     return $same;
369     }
370    
371    
372 dpavlin 157 #----- main
373    
374     my $sth = $dbh->prepare( qq{
375    
376     select
377 dpavlin 158 backups.id as backup_id,
378 dpavlin 157 hosts.name as host,
379     shares.name as share,
380 dpavlin 192 backups.num as num,
381 dpavlin 196 inc_size,
382     parts
383 dpavlin 157 from backups
384     join shares on backups.hostid = shares.hostid
385     and shares.id = backups.shareid
386     join hosts on shares.hostid = hosts.id
387 dpavlin 192 where not inc_deleted
388 dpavlin 157 order by backups.date
389    
390     } );
391    
392 dpavlin 213 $sth->execute();
393     my $num_backups = $sth->rows;
394     my $curr_backup = 1;
395    
396 dpavlin 293 if ($opt{h}) {
397     warn "making increments just for host $opt{h}\n";
398     }
399    
400 dpavlin 157 while (my $row = $sth->fetchrow_hashref) {
401 dpavlin 271
402 dpavlin 293 if ($opt{h} && $row->{host} ne $opt{h}) {
403     warn "skipped $row->{host}\n" if ($debug);
404     next;
405     }
406    
407 dpavlin 271 $curr_backup++;
408    
409 dpavlin 157 my $tar_file = BackupPC::SearchLib::getGzipName($row->{'host'}, $row->{'share'}, $row->{'num'});
410 dpavlin 192
411 dpavlin 194 # this will return -1 if file doesn't exist
412     my $size = BackupPC::SearchLib::get_tgz_size_by_name($tar_file);
413 dpavlin 192
414 dpavlin 253 print "# size: $size backup.size: ", $row->{inc_size},"\n" if ($opt{d});
415    
416 dpavlin 266 if ( $row->{'inc_size'} != -1 && $size != -1 && $row->{'inc_size'} >= $size) {
417 dpavlin 256 if ($check) {
418     tar_check($row->{'host'}, $row->{'share'}, $row->{'num'}, $tar_file) && next;
419     } else {
420     next;
421     }
422 dpavlin 253 }
423    
424 dpavlin 271 print curr_time, " creating $curr_backup/$num_backups ", $row->{'host'}, ":", $row->{'share'}, " #", $row->{'num'}, " -> $tar_file";
425 dpavlin 157
426     my $t = time();
427    
428 dpavlin 194 # re-create archive?
429 dpavlin 254 my $cmd = qq{ $tarIncCreate -h "$row->{'host'}" -s "$row->{'share'}" -n $row->{'num'} -f };
430 dpavlin 253 print STDERR "## $cmd\n" if ($debug);
431 dpavlin 157
432 dpavlin 253 if (system($cmd) != 0) {
433     print STDERR " FAILED";
434 dpavlin 194 }
435 dpavlin 157
436 dpavlin 194 print ", dur: ",fmt_time(time() - $t), "\n";
437 dpavlin 158
438     $dbh->commit;
439    
440 dpavlin 157 }
441    
442     undef $sth;
443     $dbh->disconnect;

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26