2 #============================================================= -*-perl-*-
4 # BackupPC_tarExtract: extract data from a dump
9 # Craig Barratt <cbarratt@users.sourceforge.net>
12 # Copyright (C) 2001-2009 Craig Barratt
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.
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.
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
28 #========================================================================
30 # Version 3.2.0, released 31 Jul 2010.
32 # See http://backuppc.sourceforge.net.
34 #========================================================================
38 use lib "/usr/local/BackupPC/lib";
39 use Encode qw/from_to/;
41 use BackupPC::Attrib qw(:all);
42 use BackupPC::FileZIO;
43 use BackupPC::PoolWrite;
46 use constant S_IFMT => 0170000; # type of file
48 die("BackupPC::Lib->new failed\n") if ( !(my $bpc = BackupPC::Lib->new) );
49 my $TopDir = $bpc->TopDir();
50 my $BinDir = $bpc->BinDir();
51 my %Conf = $bpc->Conf();
54 print("usage: $0 <client> <shareName> <compressLevel>\n");
57 if ( $ARGV[0] !~ /^([\w\.\s-]+)$/ ) {
58 print("$0: bad client name '$ARGV[0]'\n");
62 if ( $ARGV[1] =~ m{(^|/)\.\.(/|$)} ) {
63 print("$0: bad share name '$ARGV[1]'\n");
66 my $ShareNameUM = $1 if ( $ARGV[1] =~ /(.*)/ );
67 my $ShareName = $bpc->fileNameEltMangle($ShareNameUM);
68 if ( $ARGV[2] !~ /^(\d+)$/ ) {
69 print("$0: bad compress level '$ARGV[2]'\n");
77 # Re-read config file, so we can include the PC-specific config
79 if ( defined(my $error = $bpc->ConfigRead($client)) ) {
80 print("BackupPC_tarExtract: Can't read PC's config file: $error\n");
86 # Catch various signals
88 $SIG{INT} = \&catch_signal;
89 $SIG{ALRM} = \&catch_signal;
90 $SIG{TERM} = \&catch_signal;
91 $SIG{PIPE} = \&catch_signal;
92 $SIG{STOP} = \&catch_signal;
93 $SIG{TSTP} = \&catch_signal;
94 $SIG{TTIN} = \&catch_signal;
97 # This constant and the line of code below that uses it is borrowed
98 # from Archive::Tar. Thanks to Calle Dybedahl and Stephen Zander.
101 # Archive::Tar is Copyright 1997 Calle Dybedahl. All rights reserved.
102 # Copyright 1998 Stephen Zander. All rights reserved.
104 my $tar_unpack_header
105 = 'Z100 A8 A8 A8 a12 A12 A8 A1 Z100 A6 A2 Z32 Z32 A8 A8 A155 x12';
106 my $tar_header_length = 512;
108 my $BufSize = 1048576; # 1MB or 2^20
111 my $OutDir = "$TopDir/pc/$client/new";
114 my $ExistFileCnt = 0;
115 my $ExistFileSize = 0;
116 my $ExistFileCompSize = 0;
117 my $TotalFileCnt = 0;
118 my $TotalFileSize = 0;
119 my $TarReadHdrCnt = 0;
123 my($fh, $totBytes) = @_;
124 my($numBytes, $newBytes, $data);
126 $data = "\0" x $totBytes;
127 while ( $numBytes < $totBytes ) {
128 return if ( $Abort );
129 $newBytes = sysread($fh,
130 substr($data, $numBytes, $totBytes - $numBytes),
131 $totBytes - $numBytes);
132 if ( $newBytes <= 0 ) {
133 return if ( $TarReadHdrCnt == 1 ); # empty tar file ok
134 print("Unexpected end of tar archive (tot = $totBytes,"
135 . " num = $numBytes, posn = " . sysseek($fh, 0, 1) . ")\n");
137 $AbortReason = "Unexpected end of tar archive";
141 $numBytes += $newBytes;
151 return $1 if ( TarRead($fh, $tar_header_length) =~ /(.*)/s );
159 if ( $size % $tar_header_length ) {
160 TarRead($fh, $tar_header_length - ($size % $tar_header_length));
167 my($head, $longName, $longLink);
168 my($name, $mode, $uid, $gid, $size, $mtime, $chksum, $type,
169 $linkname, $magic, $version, $uname, $gname, $devmajor,
173 $head = TarReadHeader($fh);
174 return if ( $Abort || $head eq ""
175 || $head eq "\0" x $tar_header_length );
177 $mode, # octal number
180 $size, # octal number
181 $mtime, # octal number
182 $chksum, # octal number
186 $version, # two bytes
189 $devmajor, # octal number
190 $devminor, # octal number
191 $prefix) = unpack($tar_unpack_header, $head);
196 if ( ord($size) == 128 ) {
198 # GNU tar extension: for >=8GB files the size is stored
199 # in big endian binary.
201 $size = 65536 * 65536 * unpack("N", substr($size, 4, 4))
202 + unpack("N", substr($size, 8, 4));
205 # We used to have a patch here for smbclient 2.2.x. For file
206 # sizes between 2 and 4GB it sent the wrong size. But since
207 # samba 3.0.0 has been released we no longer support this
208 # patch since valid files could have sizes that start with
209 # 6 or 7 in octal (eg: 6-8GB files).
211 # $size =~ s/^6/2/; # fix bug in smbclient for >=2GB files
212 # $size =~ s/^7/3/; # fix bug in smbclient for >=2GB files
214 # To avoid integer overflow in case we are in the 4GB - 8GB
215 # range, we do the conversion in two parts.
217 if ( $size =~ /([0-9]{9,})/ ) {
218 my $len = length($1);
219 $size = oct(substr($1, 0, $len - 8)) * (1 << 24)
220 + oct(substr($1, $len - 8));
226 $chksum = oct $chksum;
227 $devmajor = oct $devmajor;
228 $devminor = oct $devminor;
229 $name = "$prefix/$name" if $prefix;
231 substr ($head, 148, 8) = " ";
232 if (unpack ("%16C*", $head) != $chksum) {
233 print("$name: checksum error at "
234 . sysseek($fh, 0, 1) , "\n");
237 if ( $type eq "L" ) {
238 $longName = TarRead($fh, $size) || return;
239 # remove trailing NULL
240 $longName = substr($longName, 0, $size - 1);
241 TarFlush($fh, $size);
243 } elsif ( $type eq "K" ) {
244 $longLink = TarRead($fh, $size) || return;
245 # remove trailing NULL
246 $longLink = substr($longLink, 0, $size - 1);
247 TarFlush($fh, $size);
250 printf("Got file '%s', mode 0%o, size %g, type %d\n",
251 $name, $mode, $size, $type) if ( $Conf{XferLogLevel} >= 3 );
252 $name = $longName if ( defined($longName) );
253 $linkname = $longLink if ( defined($longLink) );
256 # Map client charset encodings to utf8
258 # printf("File $name (hex: %s)\n", unpack("H*", $name));
259 if ( $Conf{ClientCharset} ne "" ) {
260 from_to($name, $Conf{ClientCharset}, "utf8");
261 from_to($linkname, $Conf{ClientCharset}, "utf8");
263 # printf("File now $name (hex: %s)\n", unpack("H*", $name));
266 $name =~ s{/+\.?$}{};
270 mangleName => $bpc->fileNameMangle($name),
277 linkname => $linkname,
278 devmajor => $devmajor,
279 devminor => $devminor,
287 my $f = TarReadFileInfo($fh) || return;
290 if ( $f->{name} eq "" ) {
293 $file = $ShareNameUM;
295 ($file = $f->{name}) =~ s{.*?([^/]*)$}{$1}; # unmangled file
296 if ( ($dir = $f->{mangleName}) =~ m{(.*)/.*} ) {
297 $dir = "$ShareName/$1";
302 if ( !defined($Attrib{$dir}) ) {
303 foreach my $d ( keys(%Attrib) ) {
304 next if ( $dir =~ m{^\Q$d/} );
307 $Attrib{$dir} = BackupPC::Attrib->new({ compress => $Compress });
308 if ( -f $Attrib{$dir}->fileName("$OutDir/$dir")
309 && !$Attrib{$dir}->read("$OutDir/$dir") ) {
310 printf("Unable to read attribute file %s\n",
311 $Attrib{$dir}->fileName("$OutDir/$dir"));
315 if ( $f->{type} == BPC_FTYPE_DIR ) {
319 logFileAction("create", $f) if ( $Conf{XferLogLevel} >= 1 );
320 mkpath("$OutDir/$ShareName/$f->{mangleName}", 0, 0777)
321 if ( !-d "$OutDir/$ShareName/$f->{mangleName}" );
322 } elsif ( $f->{type} == BPC_FTYPE_FILE ) {
327 #print("Reading $f->{name}, $f->{size} bytes, type $f->{type}\n");
328 pathCreate($dir, "$OutDir/$ShareName/$f->{mangleName}", $f);
329 my $poolWrite = BackupPC::PoolWrite->new($bpc,
330 "$OutDir/$ShareName/$f->{mangleName}",
331 $f->{size}, $Compress);
332 while ( $nRead < $f->{size} ) {
333 my $thisRead = $f->{size} - $nRead < $BufSize
334 ? $f->{size} - $nRead : $BufSize;
335 my $data = TarRead($fh, $thisRead);
338 print("Unexpected end of tar archive during read\n");
339 $AbortReason = "Unexpected end of tar archive";
344 unlink("$OutDir/$ShareName/$f->{mangleName}");
345 print("Removing partial file $f->{name}\n");
348 $poolWrite->write(\$data);
351 my $exist = processClose($poolWrite, "$ShareName/$f->{mangleName}",
353 logFileAction($exist ? "pool" : "create", $f)
354 if ( $Conf{XferLogLevel} >= 1 );
355 TarFlush($fh, $f->{size});
356 } elsif ( $f->{type} == BPC_FTYPE_HARDLINK ) {
358 # Hardlink to another file. GNU tar is clever about files
359 # that are hardlinks to each other. The first link will be
360 # sent as a regular file. The additional links will be sent
361 # as this type. We store the hardlink just like a symlink:
362 # the link name (path of the linked-to file) is stored in
365 $f->{size} = length($f->{linkname});
366 pathCreate($dir, "$OutDir/$ShareName/$f->{mangleName}", $f);
367 my $poolWrite = BackupPC::PoolWrite->new($bpc,
368 "$OutDir/$ShareName/$f->{mangleName}",
369 $f->{size}, $Compress);
370 $poolWrite->write(\$f->{linkname});
371 my $exist = processClose($poolWrite, "$ShareName/$f->{mangleName}",
373 logFileAction($exist ? "pool" : "create", $f)
374 if ( $Conf{XferLogLevel} >= 1 );
375 } elsif ( $f->{type} == BPC_FTYPE_SYMLINK ) {
377 # Symbolic link: write the value of the link to a plain file,
378 # that we pool as usual (ie: we don't create a symlink).
379 # The attributes remember the original file type.
380 # We also change the size to reflect the size of the link
383 $f->{size} = length($f->{linkname});
384 pathCreate($dir, "$OutDir/$ShareName/$f->{mangleName}", $f);
385 my $poolWrite = BackupPC::PoolWrite->new($bpc,
386 "$OutDir/$ShareName/$f->{mangleName}",
387 $f->{size}, $Compress);
388 $poolWrite->write(\$f->{linkname});
389 my $exist = processClose($poolWrite, "$ShareName/$f->{mangleName}",
391 logFileAction($exist ? "pool" : "create", $f)
392 if ( $Conf{XferLogLevel} >= 1 );
393 } elsif ( $f->{type} == BPC_FTYPE_CHARDEV
394 || $f->{type} == BPC_FTYPE_BLOCKDEV
395 || $f->{type} == BPC_FTYPE_FIFO ) {
397 # Special files: for char and block special we write the
398 # major and minor numbers to a plain file, that we pool
399 # as usual. For a pipe file we create an empty file.
400 # The attributes remember the original file type.
403 if ( $f->{type} == BPC_FTYPE_FIFO ) {
406 $data = "$f->{devmajor},$f->{devminor}";
408 pathCreate($dir, "$OutDir/$ShareName/$f->{mangleName}", $f);
409 my $poolWrite = BackupPC::PoolWrite->new($bpc,
410 "$OutDir/$ShareName/$f->{mangleName}",
411 length($data), $Compress);
412 $poolWrite->write(\$data);
413 $f->{size} = length($data);
414 my $exist = processClose($poolWrite, "$ShareName/$f->{mangleName}",
416 logFileAction($exist ? "pool" : "create", $f)
417 if ( $Conf{XferLogLevel} >= 1 );
419 print("Got unknown type $f->{type} for $f->{name}\n");
422 $Attrib{$dir}->set($file, {
428 mtime => $f->{mtime},
438 return if ( !defined($Attrib{$d}) );
439 if ( $Attrib{$d}->fileCount ) {
440 my $data = $Attrib{$d}->writeData;
441 my $fileName = $Attrib{$d}->fileName("$OutDir/$d");
442 my $poolWrite = BackupPC::PoolWrite->new($bpc, $fileName,
443 length($data), $Compress);
444 $poolWrite->write(\$data);
445 processClose($poolWrite, $Attrib{$d}->fileName($d), length($data), 1);
452 my($poolWrite, $fileName, $origSize, $noStats) = @_;
453 my($exists, $digest, $outSize, $errs) = $poolWrite->close;
456 print(join("", @$errs));
461 $TotalFileSize += $origSize;
466 $ExistFileSize += $origSize;
467 $ExistFileCompSize += $outSize;
469 } elsif ( $outSize > 0 ) {
470 print(NEW_FILES "$digest $origSize $fileName\n");
472 return $exists && $origSize > 0;
476 # Generate a log file message for a completed file
480 my($action, $f) = @_;
481 my $owner = "$f->{uid}/$f->{gid}";
482 my $name = $f->{name};
483 $name = "." if ( $name eq "" );
484 my $type = (("", "p", "c", "", "d", "", "b", "", "", "", "l", "", "s"))
485 [($f->{mode} & S_IFMT) >> 12];
486 $type = "h" if ( $f->{type} == BPC_FTYPE_HARDLINK );
488 printf(" %-6s %1s%4o %9s %11.0f %s\n",
498 # Create the parent directory of $file if necessary
502 my($dir, $fullPath, $f) = @_;
505 # Get parent directory of each of $dir and $fullPath
507 # print("pathCreate: dir = $dir, fullPath = $fullPath\n");
508 $dir =~ s{/([^/]*)$}{};
509 my $file = $bpc->fileNameUnmangle($1);
510 $fullPath =~ s{/[^/]*$}{};
511 return if ( -d $fullPath || $file eq "" );
512 unlink($fullPath) if ( -e $fullPath );
513 mkpath($fullPath, 0, 0777);
514 $Attrib{$dir} = BackupPC::Attrib->new({ compress => $Compress })
515 if ( !defined($Attrib{$dir}) );
516 # print("pathCreate: adding file = $file to dir = $dir\n");
517 $Attrib{$dir}->set($file, {
518 type => BPC_FTYPE_DIR,
532 # The first time we receive a signal we try to gracefully
533 # abort the backup. This allows us to keep a partial dump
534 # with the in-progress file deleted and attribute caches
535 # flushed to disk etc.
537 print("BackupPC_tarExtract: got signal $sigName\n");
540 $AbortReason = "received signal $sigName";
545 # This is a second signal: time to clean up.
547 print("BackupPC_tarExtract: quitting on second signal $sigName\n");
552 mkpath("$OutDir/$ShareName", 0, 0777);
553 open(NEW_FILES, ">>", "$TopDir/pc/$client/NewFileList")
554 || die("can't open $TopDir/pc/$client/NewFileList");
557 1 while ( !$Abort && TarReadFile(*STDIN) );
558 1 while ( !$Abort && sysread(STDIN, my $discard, 1024) );
561 # Flush out remaining attributes.
563 foreach my $d ( keys(%Attrib) ) {
569 print("BackupPC_tarExtact aborting ($AbortReason)\n");
573 # Report results to BackupPC_dump
575 print("Done: $Errors errors, $ExistFileCnt filesExist,"
576 . " $ExistFileSize sizeExist, $ExistFileCompSize sizeExistComp,"
577 . " $TotalFileCnt filesTotal, $TotalFileSize sizeTotal\n");