bin/BackupPC_tarExtract

   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");