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

Contents of /upstream/2.1.0/bin/BackupPC_tarExtract

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations)
Wed Jun 22 19:12:04 2005 UTC (16 years, 11 months ago) by dpavlin
File size: 16915 byte(s)
import of version 2.1.0

1 #!/bin/perl
2 #============================================================= -*-perl-*-
3 #
4 # BackupPC_tarExtract: extract data from a dump
5 #
6 # DESCRIPTION
7 #
8 # AUTHOR
9 # Craig Barratt <cbarratt@users.sourceforge.net>
10 #
11 # COPYRIGHT
12 # Copyright (C) 2001-2003 Craig Barratt
13 #
14 # This program is free software; you can redistribute it and/or modify
15 # it under the terms of the GNU General Public License as published by
16 # the Free Software Foundation; either version 2 of the License, or
17 # (at your option) any later version.
18 #
19 # This program is distributed in the hope that it will be useful,
20 # but WITHOUT ANY WARRANTY; without even the implied warranty of
21 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 # GNU General Public License for more details.
23 #
24 # You should have received a copy of the GNU General Public License
25 # along with this program; if not, write to the Free Software
26 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
27 #
28 #========================================================================
29 #
30 # Version 2.1.0, released 20 Jun 2004.
31 #
32 # See http://backuppc.sourceforge.net.
33 #
34 #========================================================================
35
36 use strict;
37 no utf8;
38 use lib "__INSTALLDIR__/lib";
39 use BackupPC::Lib;
40 use BackupPC::Attrib qw(:all);
41 use BackupPC::FileZIO;
42 use BackupPC::PoolWrite;
43 use File::Path;
44
45 use constant S_IFMT => 0170000; # type of file
46
47 die("BackupPC::Lib->new failed\n") if ( !(my $bpc = BackupPC::Lib->new) );
48 my $TopDir = $bpc->TopDir();
49 my $BinDir = $bpc->BinDir();
50 my %Conf = $bpc->Conf();
51
52 if ( @ARGV != 3 ) {
53 print("usage: $0 <client> <shareName> <compressLevel>\n");
54 exit(1);
55 }
56 if ( $ARGV[0] !~ /^([\w\.\s-]+)$/ ) {
57 print("$0: bad client name '$ARGV[0]'\n");
58 exit(1);
59 }
60 my $client = $1;
61 if ( $ARGV[1] !~ /^([\w\s\.\/\$-]+)$/ ) {
62 print("$0: bad share name '$ARGV[1]'\n");
63 exit(1);
64 }
65 my $ShareNameUM = $1;
66 my $ShareName = $bpc->fileNameEltMangle($ShareNameUM);
67 if ( $ARGV[2] !~ /^(\d+)$/ ) {
68 print("$0: bad compress level '$ARGV[2]'\n");
69 exit(1);
70 }
71 my $Compress = $1;
72 my $Abort = 0;
73 my $AbortReason;
74
75 #
76 # Re-read config file, so we can include the PC-specific config
77 #
78 if ( defined(my $error = $bpc->ConfigRead($client)) ) {
79 print("BackupPC_tarExtract: Can't read PC's config file: $error\n");
80 exit(1);
81 }
82 %Conf = $bpc->Conf();
83
84 #
85 # Catch various signals
86 #
87 $SIG{INT} = \&catch_signal;
88 $SIG{ALRM} = \&catch_signal;
89 $SIG{TERM} = \&catch_signal;
90 $SIG{PIPE} = \&catch_signal;
91 $SIG{STOP} = \&catch_signal;
92 $SIG{TSTP} = \&catch_signal;
93 $SIG{TTIN} = \&catch_signal;
94
95 #
96 # This constant and the line of code below that uses it is borrowed
97 # from Archive::Tar. Thanks to Calle Dybedahl and Stephen Zander.
98 # See www.cpan.org.
99 #
100 # Archive::Tar is Copyright 1997 Calle Dybedahl. All rights reserved.
101 # Copyright 1998 Stephen Zander. All rights reserved.
102 #
103 my $tar_unpack_header
104 = 'Z100 A8 A8 A8 A12 A12 A8 A1 Z100 A6 A2 Z32 Z32 A8 A8 A155 x12';
105 my $tar_header_length = 512;
106
107 my $BufSize = 1048576; # 1MB or 2^20
108 my $MaxFiles = 20;
109 my $Errors = 0;
110 my $OutDir = "$TopDir/pc/$client/new";
111 my %Attrib = ();
112
113 my $ExistFileCnt = 0;
114 my $ExistFileSize = 0;
115 my $ExistFileCompSize = 0;
116 my $TotalFileCnt = 0;
117 my $TotalFileSize = 0;
118 my $TarReadHdrCnt = 0;
119
120 sub TarRead
121 {
122 my($fh, $totBytes) = @_;
123 my($numBytes, $newBytes, $data);
124
125 $data = "\0" x $totBytes;
126 while ( $numBytes < $totBytes ) {
127 return if ( $Abort );
128 $newBytes = sysread($fh,
129 substr($data, $numBytes, $totBytes - $numBytes),
130 $totBytes - $numBytes);
131 if ( $newBytes <= 0 ) {
132 return if ( $TarReadHdrCnt == 1 ); # empty tar file ok
133 print("Unexpected end of tar archive (tot = $totBytes,"
134 . " num = $numBytes, posn = " . sysseek($fh, 0, 1) . ")\n");
135 $Abort = 1;
136 $AbortReason = "Unexpected end of tar archive";
137 $Errors++;
138 return;
139 }
140 $numBytes += $newBytes;
141 }
142 return $data;
143 }
144
145 sub TarReadHeader
146 {
147 my($fh) = @_;
148
149 $TarReadHdrCnt++;
150 return $1 if ( TarRead($fh, $tar_header_length) =~ /(.*)/s );
151 return;
152 }
153
154 sub TarFlush
155 {
156 my($fh, $size) = @_;
157
158 if ( $size % $tar_header_length ) {
159 TarRead($fh, $tar_header_length - ($size % $tar_header_length));
160 }
161 }
162
163 sub TarReadFileInfo
164 {
165 my($fh) = @_;
166 my($head, $longName, $longLink);
167 my($name, $mode, $uid, $gid, $size, $mtime, $chksum, $type,
168 $linkname, $magic, $version, $uname, $gname, $devmajor,
169 $devminor, $prefix);
170
171 while ( 1 ) {
172 $head = TarReadHeader($fh);
173 return if ( $Abort || $head eq ""
174 || $head eq "\0" x $tar_header_length );
175 ($name, # string
176 $mode, # octal number
177 $uid, # octal number
178 $gid, # octal number
179 $size, # octal number
180 $mtime, # octal number
181 $chksum, # octal number
182 $type, # character
183 $linkname, # string
184 $magic, # string
185 $version, # two bytes
186 $uname, # string
187 $gname, # string
188 $devmajor, # octal number
189 $devminor, # octal number
190 $prefix) = unpack($tar_unpack_header, $head);
191
192 $mode = oct $mode;
193 $uid = oct $uid;
194 $gid = oct $gid;
195 if ( ord($size) == 128 ) {
196 #
197 # GNU tar extension: for >=8GB files the size is stored
198 # in big endian binary.
199 #
200 $size = 65536 * 65536 * unpack("N", substr($size, 4, 4))
201 + unpack("N", substr($size, 8, 4));
202 } else {
203 #
204 # We used to have a patch here for smbclient 2.2.x. For file
205 # sizes between 2 and 4GB it sent the wrong size. But since
206 # samba 3.0.0 has been released we no longer support this
207 # patch since valid files could have sizes that start with
208 # 6 or 7 in octal (eg: 6-8GB files).
209 #
210 # $size =~ s/^6/2/; # fix bug in smbclient for >=2GB files
211 # $size =~ s/^7/3/; # fix bug in smbclient for >=2GB files
212 #
213 # To avoid integer overflow in case we are in the 4GB - 8GB
214 # range, we do the conversion in two parts.
215 #
216 if ( $size =~ /([0-9]{9,})/ ) {
217 my $len = length($1);
218 $size = oct(substr($1, 0, $len - 8)) * (1 << 24)
219 + oct(substr($1, $len - 8));
220 } else {
221 $size = oct($size);
222 }
223 }
224 $mtime = oct $mtime;
225 $chksum = oct $chksum;
226 $devmajor = oct $devmajor;
227 $devminor = oct $devminor;
228 $name = "$prefix/$name" if $prefix;
229 $prefix = "";
230 substr ($head, 148, 8) = " ";
231 if (unpack ("%16C*", $head) != $chksum) {
232 print("$name: checksum error at "
233 . sysseek($fh, 0, 1) , "\n");
234 $Errors++;
235 }
236 if ( $type eq "L" ) {
237 $longName = TarRead($fh, $size) || return;
238 # remove trailing NULL
239 $longName = substr($longName, 0, $size - 1);
240 TarFlush($fh, $size);
241 next;
242 } elsif ( $type eq "K" ) {
243 $longLink = TarRead($fh, $size) || return;
244 # remove trailing NULL
245 $longLink = substr($longLink, 0, $size - 1);
246 TarFlush($fh, $size);
247 next;
248 }
249 printf("Got file '%s', mode 0%o, size %g, type %d\n",
250 $name, $mode, $size, $type) if ( $Conf{XferLogLevel} >= 3 );
251 $name = $longName if ( defined($longName) );
252 $linkname = $longLink if ( defined($longLink) );
253 $name =~ s{^\./+}{};
254 $name =~ s{/+$}{};
255 $name =~ s{//+}{/}g;
256 return {
257 name => $name,
258 mangleName => $bpc->fileNameMangle($name),
259 mode => $mode,
260 uid => $uid,
261 gid => $gid,
262 size => $size,
263 mtime => $mtime,
264 type => $type,
265 linkname => $linkname,
266 devmajor => $devmajor,
267 devminor => $devminor,
268 };
269 }
270 }
271
272 sub TarReadFile
273 {
274 my($fh) = @_;
275 my $f = TarReadFileInfo($fh) || return;
276 my($dir, $file);
277
278 if ( $f->{name} eq "" ) {
279 # top-level dir
280 $dir = "";
281 $file = $ShareNameUM;
282 } else {
283 ($file = $f->{name}) =~ s{.*?([^/]*)$}{$1}; # unmangled file
284 if ( ($dir = $f->{mangleName}) =~ m{(.*)/.*} ) {
285 $dir = "$ShareName/$1";
286 } else {
287 $dir = $ShareName;
288 }
289 }
290 if ( !defined($Attrib{$dir}) ) {
291 foreach my $d ( keys(%Attrib) ) {
292 next if ( $dir =~ m{^\Q$d/} );
293 attributeWrite($d);
294 }
295 $Attrib{$dir} = BackupPC::Attrib->new({ compress => $Compress });
296 if ( -f $Attrib{$dir}->fileName("$OutDir/$dir")
297 && !$Attrib{$dir}->read("$OutDir/$dir") ) {
298 printf("Unable to read attribute file %s\n",
299 $Attrib{$dir}->fileName("$OutDir/$dir"));
300 $Errors++;
301 }
302 }
303 if ( $f->{type} == BPC_FTYPE_DIR ) {
304 #
305 # Directory
306 #
307 logFileAction("create", $f) if ( $Conf{XferLogLevel} >= 1 );
308 mkpath("$OutDir/$ShareName/$f->{mangleName}", 0, 0777)
309 if ( !-d "$OutDir/$ShareName/$f->{mangleName}" );
310 } elsif ( $f->{type} == BPC_FTYPE_FILE ) {
311 #
312 # Regular file
313 #
314 my($nRead);
315 #print("Reading $f->{name}, $f->{size} bytes, type $f->{type}\n");
316 my $poolWrite = BackupPC::PoolWrite->new($bpc,
317 "$OutDir/$ShareName/$f->{mangleName}",
318 $f->{size}, $Compress);
319 while ( $nRead < $f->{size} ) {
320 my $thisRead = $f->{size} - $nRead < $BufSize
321 ? $f->{size} - $nRead : $BufSize;
322 my $data = TarRead($fh, $thisRead);
323 if ( $data eq "" ) {
324 if ( !$Abort ) {
325 print("Unexpected end of tar archive during read\n");
326 $AbortReason = "Unexpected end of tar archive";
327 $Errors++;
328 }
329 $poolWrite->abort;
330 $Abort = 1;
331 unlink("$OutDir/$ShareName/$f->{mangleName}");
332 print("Removing partial file $f->{name}\n");
333 return;
334 }
335 $poolWrite->write(\$data);
336 $nRead += $thisRead;
337 }
338 my $exist = processClose($poolWrite, "$ShareName/$f->{mangleName}",
339 $f->{size});
340 logFileAction($exist ? "pool" : "create", $f)
341 if ( $Conf{XferLogLevel} >= 1 );
342 TarFlush($fh, $f->{size});
343 } elsif ( $f->{type} == BPC_FTYPE_HARDLINK ) {
344 #
345 # Hardlink to another file. GNU tar is clever about files
346 # that are hardlinks to each other. The first link will be
347 # sent as a regular file. The additional links will be sent
348 # as this type. We store the hardlink just like a symlink:
349 # the link name (path of the linked-to file) is stored in
350 # a plain file.
351 #
352 $f->{size} = length($f->{linkname});
353 my $poolWrite = BackupPC::PoolWrite->new($bpc,
354 "$OutDir/$ShareName/$f->{mangleName}",
355 $f->{size}, $Compress);
356 $poolWrite->write(\$f->{linkname});
357 my $exist = processClose($poolWrite, "$ShareName/$f->{mangleName}",
358 $f->{size});
359 logFileAction($exist ? "pool" : "create", $f)
360 if ( $Conf{XferLogLevel} >= 1 );
361 } elsif ( $f->{type} == BPC_FTYPE_SYMLINK ) {
362 #
363 # Symbolic link: write the value of the link to a plain file,
364 # that we pool as usual (ie: we don't create a symlink).
365 # The attributes remember the original file type.
366 # We also change the size to reflect the size of the link
367 # contents.
368 #
369 $f->{size} = length($f->{linkname});
370 my $poolWrite = BackupPC::PoolWrite->new($bpc,
371 "$OutDir/$ShareName/$f->{mangleName}",
372 $f->{size}, $Compress);
373 $poolWrite->write(\$f->{linkname});
374 my $exist = processClose($poolWrite, "$ShareName/$f->{mangleName}",
375 $f->{size});
376 logFileAction($exist ? "pool" : "create", $f)
377 if ( $Conf{XferLogLevel} >= 1 );
378 } elsif ( $f->{type} == BPC_FTYPE_CHARDEV
379 || $f->{type} == BPC_FTYPE_BLOCKDEV
380 || $f->{type} == BPC_FTYPE_FIFO ) {
381 #
382 # Special files: for char and block special we write the
383 # major and minor numbers to a plain file, that we pool
384 # as usual. For a pipe file we create an empty file.
385 # The attributes remember the original file type.
386 #
387 my $data;
388 if ( $f->{type} == BPC_FTYPE_FIFO ) {
389 $data = "";
390 } else {
391 $data = "$f->{devmajor},$f->{devminor}";
392 }
393 my $poolWrite = BackupPC::PoolWrite->new($bpc,
394 "$OutDir/$ShareName/$f->{mangleName}",
395 length($data), $Compress);
396 $poolWrite->write(\$data);
397 $f->{size} = length($data);
398 my $exist = processClose($poolWrite, "$ShareName/$f->{mangleName}",
399 length($data));
400 logFileAction($exist ? "pool" : "create", $f)
401 if ( $Conf{XferLogLevel} >= 1 );
402 } else {
403 print("Got unknown type $f->{type} for $f->{name}\n");
404 $Errors++;
405 }
406 $Attrib{$dir}->set($file, {
407 type => $f->{type},
408 mode => $f->{mode},
409 uid => $f->{uid},
410 gid => $f->{gid},
411 size => $f->{size},
412 mtime => $f->{mtime},
413 });
414 return 1;
415 }
416
417 sub attributeWrite
418 {
419 my($d) = @_;
420 my($poolWrite);
421
422 return if ( !defined($Attrib{$d}) );
423 if ( $Attrib{$d}->fileCount ) {
424 my $data = $Attrib{$d}->writeData;
425 my $fileName = $Attrib{$d}->fileName("$OutDir/$d");
426 my $poolWrite = BackupPC::PoolWrite->new($bpc, $fileName,
427 length($data), $Compress);
428 $poolWrite->write(\$data);
429 processClose($poolWrite, $Attrib{$d}->fileName($d), length($data), 1);
430 }
431 delete($Attrib{$d});
432 }
433
434 sub processClose
435 {
436 my($poolWrite, $fileName, $origSize, $noStats) = @_;
437 my($exists, $digest, $outSize, $errs) = $poolWrite->close;
438
439 if ( @$errs ) {
440 print(join("", @$errs));
441 $Errors += @$errs;
442 }
443 if ( !$noStats ) {
444 $TotalFileCnt++;
445 $TotalFileSize += $origSize;
446 }
447 if ( $exists ) {
448 if ( !$noStats ) {
449 $ExistFileCnt++;
450 $ExistFileSize += $origSize;
451 $ExistFileCompSize += $outSize;
452 }
453 } elsif ( $outSize > 0 ) {
454 print(NEW_FILES "$digest $origSize $fileName\n");
455 }
456 return $exists && $origSize > 0;
457 }
458
459 #
460 # Generate a log file message for a completed file
461 #
462 sub logFileAction
463 {
464 my($action, $f) = @_;
465 my $owner = "$f->{uid}/$f->{gid}";
466 my $name = $f->{name};
467 $name = "." if ( $name eq "" );
468 my $type = (("", "p", "c", "", "d", "", "b", "", "", "", "l", "", "s"))
469 [($f->{mode} & S_IFMT) >> 12];
470 $type = "h" if ( $f->{type} == BPC_FTYPE_HARDLINK );
471
472 printf(" %-6s %1s%4o %9s %11.0f %s\n",
473 $action,
474 $type,
475 $f->{mode} & 07777,
476 $owner,
477 $f->{size},
478 $name);
479 }
480
481 sub catch_signal
482 {
483 my $sigName = shift;
484
485 #
486 # The first time we receive a signal we try to gracefully
487 # abort the backup. This allows us to keep a partial dump
488 # with the in-progress file deleted and attribute caches
489 # flushed to disk etc.
490 #
491 print("BackupPC_tarExtract: got signal $sigName\n");
492 if ( !$Abort ) {
493 $Abort++;
494 $AbortReason = "received signal $sigName";
495 return;
496 }
497
498 #
499 # This is a second signal: time to clean up.
500 #
501 print("BackupPC_tarExtract: quitting on second signal $sigName\n");
502 close(NEW_FILES);
503 exit(1)
504 }
505
506 mkpath("$OutDir/$ShareName", 0, 0777);
507 open(NEW_FILES, ">>", "$TopDir/pc/$client/NewFileList")
508 || die("can't open $TopDir/pc/$client/NewFileList");
509 binmode(NEW_FILES);
510 binmode(STDIN);
511 1 while ( !$Abort && TarReadFile(*STDIN) );
512 1 while ( !$Abort && sysread(STDIN, my $discard, 1024) );
513
514 #
515 # Flush out remaining attributes.
516 #
517 foreach my $d ( keys(%Attrib) ) {
518 attributeWrite($d);
519 }
520 close(NEW_FILES);
521
522 if ( $Abort ) {
523 print("BackupPC_tarExtact aborting ($AbortReason)\n");
524 }
525
526 #
527 # Report results to BackupPC_dump
528 #
529 print("Done: $Errors errors, $ExistFileCnt filesExist,"
530 . " $ExistFileSize sizeExist, $ExistFileCompSize sizeExistComp,"
531 . " $TotalFileCnt filesTotal, $TotalFileSize sizeTotal\n");

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26