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-2007  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 3.1.0, released 25 Nov 2007.
  31 #
  32 # See http://backuppc.sourceforge.net.
  33 #
  34 #========================================================================
  35
  36 use strict;
  37 no  utf8;
  38 use lib "/usr/local/BackupPC/lib";
  39 use Encode qw/from_to/;
  40 use BackupPC::Lib;
  41 use BackupPC::Attrib qw(:all);
  42 use BackupPC::FileZIO;
  43 use BackupPC::PoolWrite;
  44 use File::Path;
  45
  46 use constant S_IFMT       => 0170000;   # type of file
  47
  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();
  52
  53 if ( @ARGV != 3 ) {
  54     print("usage: $0 <client> <shareName> <compressLevel>\n");
  55     exit(1);
  56 }
  57 if ( $ARGV[0] !~ /^([\w\.\s-]+)$/ ) {
  58     print("$0: bad client name '$ARGV[0]'\n");
  59     exit(1);
  60 }
  61 my $client = $1;
  62 if ( $ARGV[1] =~ m{(^|/)\.\.(/|$)} ) {
  63     print("$0: bad share name '$ARGV[1]'\n");
  64     exit(1);
  65 }
  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");
  70     exit(1);
  71 }
  72 my $Compress = $1;
  73 my $Abort = 0;
  74 my $AbortReason;
  75
  76 #
  77 # Re-read config file, so we can include the PC-specific config
  78 #
  79 if ( defined(my $error = $bpc->ConfigRead($client)) ) {
  80     print("BackupPC_tarExtract: Can't read PC's config file: $error\n");
  81     exit(1);
  82 }
  83 %Conf = $bpc->Conf();
  84
  85 #
  86 # Catch various signals
  87 #
  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;
  95
  96 #
  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.
  99 # See www.cpan.org.
 100 #
 101 # Archive::Tar is Copyright 1997 Calle Dybedahl. All rights reserved.
 102 #                 Copyright 1998 Stephen Zander. All rights reserved.
 103 #
 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;
 107
 108 my $BufSize  = 1048576;     # 1MB or 2^20
 109 my $MaxFiles = 20;
 110 my $Errors   = 0;
 111 my $OutDir   = "$TopDir/pc/$client/new";
 112 my %Attrib   = ();
 113
 114 my $ExistFileCnt      = 0;
 115 my $ExistFileSize     = 0;
 116 my $ExistFileCompSize = 0;
 117 my $TotalFileCnt      = 0;
 118 my $TotalFileSize     = 0;
 119 my $TarReadHdrCnt     = 0;
 120
 121 sub TarRead
 122 {
 123     my($fh, $totBytes) = @_;
 124     my($numBytes, $newBytes, $data);
 125
 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");
 136             $Abort = 1;
 137             $AbortReason = "Unexpected end of tar archive";
 138             $Errors++;
 139             return;
 140         }
 141         $numBytes += $newBytes;
 142     }
 143     return $data;
 144 }
 145
 146 sub TarReadHeader
 147 {
 148     my($fh) = @_;
 149
 150     $TarReadHdrCnt++;
 151     return $1 if ( TarRead($fh, $tar_header_length) =~ /(.*)/s );
 152     return;
 153 }
 154
 155 sub TarFlush
 156 {
 157     my($fh, $size) = @_;
 158
 159     if ( $size % $tar_header_length ) {
 160         TarRead($fh, $tar_header_length - ($size % $tar_header_length));
 161     }
 162 }
 163
 164 sub TarReadFileInfo
 165 {
 166     my($fh) = @_;
 167     my($head, $longName, $longLink);
 168     my($name, $mode, $uid, $gid, $size, $mtime, $chksum, $type,
 169        $linkname, $magic, $version, $uname, $gname, $devmajor,
 170        $devminor, $prefix);
 171
 172     while ( 1 ) {
 173         $head = TarReadHeader($fh);
 174         return if ( $Abort || $head eq ""
 175                            || $head eq "\0" x $tar_header_length );
 176         ($name,         # string
 177             $mode,      # octal number
 178             $uid,       # octal number
 179             $gid,       # octal number
 180             $size,      # octal number
 181             $mtime,     # octal number
 182             $chksum,    # octal number
 183             $type,      # character
 184             $linkname,  # string
 185             $magic,     # string
 186             $version,   # two bytes
 187             $uname,     # string
 188             $gname,     # string
 189             $devmajor,  # octal number
 190             $devminor,  # octal number
 191             $prefix) = unpack($tar_unpack_header, $head);
 192
 193         $mode     = oct $mode;
 194         $uid      = oct $uid;
 195         $gid      = oct $gid;
 196         if ( ord($size) == 128 ) {
 197             #
 198             # GNU tar extension: for >=8GB files the size is stored
 199             # in big endian binary.
 200             #
 201             $size = 65536 * 65536 * unpack("N", substr($size, 4, 4))
 202                                   + unpack("N", substr($size, 8, 4));
 203         } else {
 204             #
 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).
 210             #
 211             # $size =~ s/^6/2/;       # fix bug in smbclient for >=2GB files
 212             # $size =~ s/^7/3/;       # fix bug in smbclient for >=2GB files
 213             #
 214             # To avoid integer overflow in case we are in the 4GB - 8GB
 215             # range, we do the conversion in two parts.
 216             #
 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));
 221             } else {
 222                 $size = oct($size);
 223             }
 224         }
 225         $mtime    = oct $mtime;
 226         $chksum   = oct $chksum;
 227         $devmajor = oct $devmajor;
 228         $devminor = oct $devminor;
 229         $name     = "$prefix/$name" if $prefix;
 230         $prefix   = "";
 231         substr ($head, 148, 8) = "        ";
 232         if (unpack ("%16C*", $head) != $chksum) {
 233            print("$name: checksum error at "
 234                         . sysseek($fh, 0, 1) , "\n");
 235            $Errors++;
 236         }
 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);
 242             next;
 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);
 248             next;
 249         }
 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) );
 254
 255         #
 256         # Map client charset encodings to utf8
 257         #
 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");
 262         }
 263         # printf("File now $name (hex: %s)\n", unpack("H*", $name));
 264
 265         $name     =~ s{^\./+}{};
 266         $name     =~ s{/+\.?$}{};
 267         $name     =~ s{//+}{/}g;
 268         return {
 269             name       => $name,
 270             mangleName => $bpc->fileNameMangle($name),
 271             mode       => $mode,
 272             uid        => $uid,
 273             gid        => $gid,
 274             size       => $size,
 275             mtime      => $mtime,
 276             type       => $type,
 277             linkname   => $linkname,
 278             devmajor   => $devmajor,
 279             devminor   => $devminor,
 280         };
 281     }
 282 }
 283
 284 sub TarReadFile
 285 {
 286     my($fh) = @_;
 287     my $f = TarReadFileInfo($fh) || return;
 288     my($dir, $file);
 289
 290     if ( $f->{name} eq "" ) {
 291         # top-level dir
 292         $dir = "";
 293         $file = $ShareNameUM;
 294     } else {
 295         ($file = $f->{name}) =~ s{.*?([^/]*)$}{$1};         # unmangled file
 296         if ( ($dir = $f->{mangleName}) =~ m{(.*)/.*} ) {
 297             $dir = "$ShareName/$1";
 298         } else {
 299             $dir = $ShareName;
 300         }
 301     }
 302     if ( !defined($Attrib{$dir}) ) {
 303         foreach my $d ( keys(%Attrib) ) {
 304             next if ( $dir =~ m{^\Q$d/} );
 305             attributeWrite($d);
 306         }
 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"));
 312             $Errors++;
 313         }
 314     }
 315     if ( $f->{type} == BPC_FTYPE_DIR ) {
 316         #
 317         # Directory
 318         #
 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 ) {
 323         #
 324         # Regular file
 325         #
 326         my($nRead);
 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);
 336             if ( $data eq "" ) {
 337                 if ( !$Abort ) {
 338                     print("Unexpected end of tar archive during read\n");
 339                     $AbortReason = "Unexpected end of tar archive";
 340                     $Errors++;
 341                 }
 342                 $poolWrite->abort;
 343                 $Abort = 1;
 344                 unlink("$OutDir/$ShareName/$f->{mangleName}");
 345                 print("Removing partial file $f->{name}\n");
 346                 return;
 347             }
 348             $poolWrite->write(\$data);
 349             $nRead += $thisRead;
 350         }
 351         my $exist = processClose($poolWrite, "$ShareName/$f->{mangleName}",
 352                                  $f->{size});
 353         logFileAction($exist ? "pool" : "create", $f)
 354                                  if ( $Conf{XferLogLevel} >= 1 );
 355         TarFlush($fh, $f->{size});
 356     } elsif ( $f->{type} == BPC_FTYPE_HARDLINK ) {
 357         #
 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
 363         # a plain file.
 364         #
 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}",
 372                                  $f->{size});
 373         logFileAction($exist ? "pool" : "create", $f)
 374                                  if ( $Conf{XferLogLevel} >= 1 );
 375     } elsif ( $f->{type} == BPC_FTYPE_SYMLINK ) {
 376         #
 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
 381         # contents.
 382         #
 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}",
 390                                  $f->{size});
 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 ) {
 396         #
 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.
 401         #
 402         my $data;
 403         if ( $f->{type} == BPC_FTYPE_FIFO ) {
 404             $data = "";
 405         } else {
 406             $data = "$f->{devmajor},$f->{devminor}";
 407         }
 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}",
 415                                  length($data));
 416         logFileAction($exist ? "pool" : "create", $f)
 417                                  if ( $Conf{XferLogLevel} >= 1 );
 418     } else {
 419         print("Got unknown type $f->{type} for $f->{name}\n");
 420         $Errors++;
 421     }
 422     $Attrib{$dir}->set($file, {
 423                             type  => $f->{type},
 424                             mode  => $f->{mode},
 425                             uid   => $f->{uid},
 426                             gid   => $f->{gid},
 427                             size  => $f->{size},
 428                             mtime => $f->{mtime},
 429                        });
 430     return 1;
 431 }
 432
 433 sub attributeWrite
 434 {
 435     my($d) = @_;
 436     my($poolWrite);
 437
 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);
 446     }
 447     delete($Attrib{$d});
 448 }
 449
 450 sub processClose
 451 {
 452     my($poolWrite, $fileName, $origSize, $noStats) = @_;
 453     my($exists, $digest, $outSize, $errs) = $poolWrite->close;
 454
 455     if ( @$errs ) {
 456         print(join("", @$errs));
 457         $Errors += @$errs;
 458     }
 459     if ( !$noStats ) {
 460         $TotalFileCnt++;
 461         $TotalFileSize += $origSize;
 462     }
 463     if ( $exists ) {
 464         if ( !$noStats ) {
 465             $ExistFileCnt++;
 466             $ExistFileSize     += $origSize;
 467             $ExistFileCompSize += $outSize;
 468         }
 469     } elsif ( $outSize > 0 ) {
 470         print(NEW_FILES "$digest $origSize $fileName\n");
 471     }
 472     return $exists && $origSize > 0;
 473 }
 474
 475 #
 476 # Generate a log file message for a completed file
 477 #
 478 sub logFileAction
 479 {
 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 );
 487
 488     printf("  %-6s %1s%4o %9s %11.0f %s\n",
 489                                 $action,
 490                                 $type,
 491                                 $f->{mode} & 07777,
 492                                 $owner,
 493                                 $f->{size},
 494                                 $name);
 495 }
 496
 497 #
 498 # Create the parent directory of $file if necessary
 499 #
 500 sub pathCreate
 501 {
 502     my($dir, $fullPath, $f) = @_;
 503
 504     #
 505     # Get parent directory of each of $dir and $fullPath
 506     #
 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,
 519                             mode  => 0755,
 520                             uid   => $f->{uid},
 521                             gid   => $f->{gid},
 522                             size  => 0,
 523                             mtime => 0,
 524                        });
 525 }
 526
 527 sub catch_signal
 528 {
 529     my $sigName = shift;
 530
 531     #
 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.
 536     #
 537     print("BackupPC_tarExtract: got signal $sigName\n");
 538     if ( !$Abort ) {
 539         $Abort++;
 540         $AbortReason = "received signal $sigName";
 541         return;
 542     }
 543
 544     #
 545     # This is a second signal: time to clean up.
 546     #
 547     print("BackupPC_tarExtract: quitting on second signal $sigName\n");
 548     close(NEW_FILES);
 549     exit(1)
 550 }
 551
 552 mkpath("$OutDir/$ShareName", 0, 0777);
 553 open(NEW_FILES, ">>", "$TopDir/pc/$client/NewFileList")
 554                  || die("can't open $TopDir/pc/$client/NewFileList");
 555 binmode(NEW_FILES);
 556 binmode(STDIN);
 557 1 while ( !$Abort && TarReadFile(*STDIN) );
 558 1 while ( !$Abort && sysread(STDIN, my $discard, 1024) );
 559
 560 #
 561 # Flush out remaining attributes.
 562 #
 563 foreach my $d ( keys(%Attrib) ) {
 564     attributeWrite($d);
 565 }
 566 close(NEW_FILES);
 567
 568 if ( $Abort ) {
 569     print("BackupPC_tarExtact aborting ($AbortReason)\n");
 570 }
 571
 572 #
 573 # Report results to BackupPC_dump
 574 #
 575 print("Done: $Errors errors, $ExistFileCnt filesExist,"
 576     . " $ExistFileSize sizeExist, $ExistFileCompSize sizeExistComp,"
 577     . " $TotalFileCnt filesTotal, $TotalFileSize sizeTotal\n");