bin/BackupPC_tarExtract

   1 #!/bin/perl -T
   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  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 1.6.0_CVS, released 10 Dec 2002.
  31 #
  32 # See http://backuppc.sourceforge.net.
  33 #
  34 #========================================================================
  35
  36 use strict;
  37 use lib "/usr/local/BackupPC/lib";
  38 use BackupPC::Lib;
  39 use BackupPC::Attrib qw(:all);
  40 use BackupPC::FileZIO;
  41 use BackupPC::PoolWrite;
  42 use File::Path;
  43
  44 die("BackupPC::Lib->new failed\n") if ( !(my $bpc = BackupPC::Lib->new) );
  45 my $TopDir = $bpc->TopDir();
  46 my $BinDir = $bpc->BinDir();
  47 my %Conf   = $bpc->Conf();
  48
  49 if ( @ARGV != 3 ) {
  50     print("usage: $0 <host> <shareName> <compressLevel>\n");
  51     exit(1);
  52 }
  53 if ( $ARGV[0] !~ /^([\w\.-]+)$/ ) {
  54     print("$0: bad host name '$ARGV[0]'\n");
  55     exit(1);
  56 }
  57 my $host = $1;
  58 if ( $ARGV[1] !~ /^([\w\s\.\/\$-]+)$/ ) {
  59     print("$0: bad share name '$ARGV[1]'\n");
  60     exit(1);
  61 }
  62 my $ShareNameUM = $1;
  63 my $ShareName = $bpc->fileNameEltMangle($ShareNameUM);
  64 if ( $ARGV[2] !~ /^(\d+)$/ ) {
  65     print("$0: bad compress level '$ARGV[2]'\n");
  66     exit(1);
  67 }
  68 my $Compress = $1;
  69
  70 #
  71 # This constant and the line of code below that uses it is borrowed
  72 # from Archive::Tar.  Thanks to Calle Dybedahl and Stephen Zander.
  73 # See www.cpan.org.
  74 #
  75 # Archive::Tar is Copyright 1997 Calle Dybedahl. All rights reserved.
  76 #                 Copyright 1998 Stephen Zander. All rights reserved.
  77 #
  78 my $tar_unpack_header
  79     = 'A100 A8 A8 A8 A12 A12 A8 A1 A100 A6 A2 A32 A32 A8 A8 A155 x12';
  80 my $tar_header_length = 512;
  81
  82 my $BufSize  = 1048576;     # 1MB or 2^20
  83 my $MaxFiles = 20;
  84 my $Errors   = 0;
  85 my $OutDir   = "$TopDir/pc/$host/new";
  86 my %Attrib   = ();
  87
  88 my $ExistFileCnt      = 0;
  89 my $ExistFileSize     = 0;
  90 my $ExistFileCompSize = 0;
  91 my $TotalFileCnt      = 0;
  92 my $TotalFileSize     = 0;
  93
  94 sub TarRead
  95 {
  96     my($fh, $totBytes) = @_;
  97     my($numBytes, $newBytes, $data);
  98
  99     $data = "\0" x $totBytes;
 100     while ( $numBytes < $totBytes ) {
 101         $newBytes = sysread($fh,
 102                         substr($data, $numBytes, $totBytes - $numBytes),
 103                         $totBytes - $numBytes);
 104         if ( $newBytes <= 0 ) {
 105             print(STDERR "Unexpected end of tar archive (tot = $totBytes,"
 106                    . " num = $numBytes, posn = " . sysseek($fh, 0, 1) . ")\n");
 107             $Errors++;
 108             return;
 109         }
 110         $numBytes += $newBytes;
 111     }
 112     return $data;
 113 }
 114
 115 sub TarReadHeader
 116 {
 117     my($fh) = @_;
 118
 119     return $1 if ( TarRead($fh, $tar_header_length) =~ /(.*)/s );
 120     return;
 121 }
 122
 123 sub TarFlush
 124 {
 125     my($fh, $size) = @_;
 126
 127     if ( $size % $tar_header_length ) {
 128         TarRead($fh, $tar_header_length - ($size % $tar_header_length));
 129     }
 130 }
 131
 132 sub TarReadFileInfo
 133 {
 134     my($fh) = @_;
 135     my($head, $longName, $longLink);
 136     my($name, $mode, $uid, $gid, $size, $mtime, $chksum, $type,
 137        $linkname, $magic, $version, $uname, $gname, $devmajor,
 138        $devminor, $prefix);
 139
 140     while ( 1 ) {
 141         $head = TarReadHeader($fh);
 142         return if ( $head eq "" || $head eq "\0" x $tar_header_length );
 143         ($name,         # string
 144             $mode,      # octal number
 145             $uid,       # octal number
 146             $gid,       # octal number
 147             $size,      # octal number
 148             $mtime,     # octal number
 149             $chksum,    # octal number
 150             $type,      # character
 151             $linkname,  # string
 152             $magic,     # string
 153             $version,   # two bytes
 154             $uname,     # string
 155             $gname,     # string
 156             $devmajor,  # octal number
 157             $devminor,  # octal number
 158             $prefix) = unpack($tar_unpack_header, $head);
 159
 160         $mode     = oct $mode;
 161         $uid      = oct $uid;
 162         $gid      = oct $gid;
 163         $size     =~ s/^6/2/;       # fix bug in smbclient for >=2GB files
 164         $size     =~ s/^7/3/;       # fix bug in smbclient for >=2GB files
 165         $size     = oct $size;
 166         $mtime    = oct $mtime;
 167         $chksum   = oct $chksum;
 168         $devmajor = oct $devmajor;
 169         $devminor = oct $devminor;
 170         $name     = "$prefix/$name" if $prefix;
 171         $prefix   = "";
 172         substr ($head, 148, 8) = "        ";
 173         if (unpack ("%16C*", $head) != $chksum) {
 174            print(STDERR "$name: checksum error at "
 175                         . sysseek($fh, 0, 1) , "\n");
 176            $Errors++;
 177         }
 178         if ( $type eq "L" ) {
 179             $longName = TarRead($fh, $size) || return;
 180             # remove trailing NULL
 181             $longName = substr($longName, 0, $size - 1);
 182             TarFlush($fh, $size);
 183             next;
 184         } elsif ( $type eq "K" ) {
 185             $longLink = TarRead($fh, $size) || return;
 186             # remove trailing NULL
 187             $longLink = substr($longLink, 0, $size - 1);
 188             TarFlush($fh, $size);
 189             next;
 190         }
 191         $name     = $longName if ( defined($longName) );
 192         $linkname = $longLink if ( defined($longLink) );
 193         $name     =~ s{^\./+}{};
 194         $name     =~ s{/+$}{};
 195         $name     =~ s{//+}{/}g;
 196         return {
 197             name       => $name,
 198             mangleName => $bpc->fileNameMangle($name),
 199             mode       => $mode,
 200             uid        => $uid,
 201             gid        => $gid,
 202             size       => $size,
 203             mtime      => $mtime,
 204             type       => $type,
 205             linkname   => $linkname,
 206             devmajor   => $devmajor,
 207             devminor   => $devminor,
 208         };
 209     }
 210 }
 211
 212 sub TarReadFile
 213 {
 214     my($fh) = @_;
 215     my $f = TarReadFileInfo($fh) || return;
 216     my($dir, $file);
 217
 218     if ( $f->{name} eq "" ) {
 219         # top-level dir
 220         $dir = "";
 221         $file = $ShareNameUM;
 222     } else {
 223         ($file = $f->{name}) =~ s{.*?([^/]*)$}{$1};         # unmangled file
 224         if ( ($dir = $f->{mangleName}) =~ m{(.*)/.*} ) {
 225             $dir = "$ShareName/$1";
 226         } else {
 227             $dir = $ShareName;
 228         }
 229     }
 230     if ( !defined($Attrib{$dir}) ) {
 231         foreach my $d ( keys(%Attrib) ) {
 232             next if ( $dir =~ m{^\Q$d/} );
 233             attributeWrite($d);
 234         }
 235         $Attrib{$dir} = BackupPC::Attrib->new({ compress => $Compress });
 236         if ( -f $Attrib{$dir}->fileName("$OutDir/$dir")
 237                     && !$Attrib{$dir}->read("$OutDir/$dir") ) {
 238             printf(STDERR "Unable to read attribute file %s\n",
 239                                 $Attrib{$dir}->fileName("$OutDir/$dir"));
 240             $Errors++;
 241         }
 242     }
 243     if ( $f->{type} == BPC_FTYPE_DIR ) {
 244         #
 245         # Directory
 246         #
 247         mkpath("$OutDir/$ShareName/$f->{mangleName}", 0, 0777)
 248                             if ( !-d "$OutDir/$ShareName/$f->{mangleName}" );
 249     } elsif ( $f->{type} == BPC_FTYPE_FILE ) {
 250         #
 251         # Regular file
 252         #
 253         my($nRead);
 254         #print("Reading $f->{name}, $f->{size} bytes, type $f->{type}\n");
 255         my $poolWrite = BackupPC::PoolWrite->new($bpc,
 256                                          "$OutDir/$ShareName/$f->{mangleName}",
 257                                          $f->{size}, $Compress);
 258         while ( $nRead < $f->{size} ) {
 259             my $thisRead = $f->{size} - $nRead < $BufSize
 260                                 ? $f->{size} - $nRead : $BufSize;
 261             my $data = TarRead($fh, $thisRead);
 262             if ( $data eq "" ) {
 263                 print(STDERR "Unexpected end of tar archive during read\n");
 264                 $Errors++;
 265                 return;
 266             }
 267             $poolWrite->write(\$data);
 268             $nRead += $thisRead;
 269         }
 270         processClose($poolWrite, "$ShareName/$f->{mangleName}", $f->{size});
 271         TarFlush($fh, $f->{size});
 272     } elsif ( $f->{type} == BPC_FTYPE_HARDLINK ) {
 273         #
 274         # Hardlink to another file.  GNU tar is clever about files
 275         # that are hardlinks to each other.  The first link will be
 276         # sent as a regular file.  The additional links will be sent
 277         # as this type.  We store the hardlink just like a symlink:
 278         # the link name (path of the linked-to file) is stored in
 279         # a plain file.
 280         #
 281         $f->{size} = length($f->{linkname});
 282         my $poolWrite = BackupPC::PoolWrite->new($bpc,
 283                                          "$OutDir/$ShareName/$f->{mangleName}",
 284                                          $f->{size}, $Compress);
 285         $poolWrite->write(\$f->{linkname});
 286         processClose($poolWrite, "$ShareName/$f->{mangleName}", $f->{size});
 287     } elsif ( $f->{type} == BPC_FTYPE_SYMLINK ) {
 288         #
 289         # Symbolic link: write the value of the link to a plain file,
 290         # that we pool as usual (ie: we don't create a symlink).
 291         # The attributes remember the original file type.
 292         # We also change the size to reflect the size of the link
 293         # contents.
 294         #
 295         $f->{size} = length($f->{linkname});
 296         my $poolWrite = BackupPC::PoolWrite->new($bpc,
 297                                          "$OutDir/$ShareName/$f->{mangleName}",
 298                                          $f->{size}, $Compress);
 299         $poolWrite->write(\$f->{linkname});
 300         processClose($poolWrite, "$ShareName/$f->{mangleName}", $f->{size});
 301     } elsif ( $f->{type} == BPC_FTYPE_CHARDEV
 302            || $f->{type} == BPC_FTYPE_BLOCKDEV
 303            || $f->{type} == BPC_FTYPE_FIFO ) {
 304         #
 305         # Special files: for char and block special we write the
 306         # major and minor numbers to a plain file, that we pool
 307         # as usual.  For a pipe file we create an empty file.
 308         # The attributes remember the original file type.
 309         #
 310         my $data;
 311         if ( $f->{type} == BPC_FTYPE_FIFO ) {
 312             $data = "";
 313         } else {
 314             $data = "$f->{devmajor},$f->{devminor}";
 315         }
 316         my $poolWrite = BackupPC::PoolWrite->new($bpc,
 317                                          "$OutDir/$ShareName/$f->{mangleName}",
 318                                          length($data), $Compress);
 319         $poolWrite->write(\$data);
 320         $f->{size} = length($data);
 321         processClose($poolWrite, "$ShareName/$f->{mangleName}", length($data));
 322     } else {
 323         print("Got unknown type $f->{type} for $f->{name}\n");
 324         $Errors++;
 325     }
 326     $Attrib{$dir}->set($file, {
 327                             type  => $f->{type},
 328                             mode  => $f->{mode},
 329                             uid   => $f->{uid},
 330                             gid   => $f->{gid},
 331                             size  => $f->{size},
 332                             mtime => $f->{mtime},
 333                        });
 334     return 1;
 335 }
 336
 337 sub attributeWrite
 338 {
 339     my($d) = @_;
 340     my($poolWrite);
 341
 342     return if ( !defined($Attrib{$d}) );
 343     if ( $Attrib{$d}->fileCount ) {
 344         my $data = $Attrib{$d}->writeData;
 345         my $fileName = $Attrib{$d}->fileName("$OutDir/$d");
 346         my $poolWrite = BackupPC::PoolWrite->new($bpc, $fileName,
 347                                          length($data), $Compress);
 348         $poolWrite->write(\$data);
 349         processClose($poolWrite, $Attrib{$d}->fileName($d), length($data));
 350     }
 351     delete($Attrib{$d});
 352 }
 353
 354 sub processClose
 355 {
 356     my($poolWrite, $fileName, $origSize) = @_;
 357     my($exists, $digest, $outSize, $errs) = $poolWrite->close;
 358
 359     if ( @$errs ) {
 360         print(STDERR join("", @$errs));
 361         $Errors += @$errs;
 362     }
 363     $TotalFileCnt++;
 364     $TotalFileSize += $origSize;
 365     if ( $exists ) {
 366         $ExistFileCnt++;
 367         $ExistFileSize     += $origSize;
 368         $ExistFileCompSize += $outSize;
 369     } elsif ( $outSize > 0 ) {
 370         print(NEW_FILES "$digest $origSize $fileName\n");
 371     }
 372 }
 373
 374 mkpath("$OutDir/$ShareName", 0, 0777);
 375 open(NEW_FILES, ">>$TopDir/pc/$host/NewFileList")
 376                  || die("can't open $TopDir/pc/$host/NewFileList");
 377 1 while ( TarReadFile(*STDIN) );
 378 1 while ( sysread(STDIN, my $discard, 1024) );
 379
 380 #
 381 # Flush out remaining attributes.
 382 #
 383 foreach my $d ( keys(%Attrib) ) {
 384     attributeWrite($d);
 385 }
 386 close(NEW_FILES);
 387
 388 #
 389 # Report results to BackupPC_dump
 390 #
 391 print("Done: $Errors errors, $ExistFileCnt filesExist,"
 392     . " $ExistFileSize sizeExist, $ExistFileCompSize sizeExistComp,"
 393     . " $TotalFileCnt filesTotal, $TotalFileSize sizeTotal\n");