bin/BackupPC_tarPCCopy

   1 #!/bin/perl
   2 #============================================================= -*-perl-*-
   3 #
   4 # BackupPC_tarPCCopy: create a tar archive of the PC directory
   5 # for copying the entire PC data directory.  The archive will
   6 # contain hardlinks to the pool directory, which should be copied
   7 # before BackupPC_tarPCCopy is run.
   8 #
   9 # DESCRIPTION
  10 #
  11 #   Usage: BackupPC_tarPCCopy [options] files/directories...
  12 #
  13 #   Flags:
  14 #       -c      don't cache inode data (reduces memory usage at the
  15 #                                       expense of longer run time)
  16 #
  17 # AUTHOR
  18 #   Craig Barratt  <cbarratt@users.sourceforge.net>
  19 #
  20 # COPYRIGHT
  21 #   Copyright (C) 2005  Craig Barratt
  22 #
  23 #   This program is free software; you can redistribute it and/or modify
  24 #   it under the terms of the GNU General Public License as published by
  25 #   the Free Software Foundation; either version 2 of the License, or
  26 #   (at your option) any later version.
  27 #
  28 #   This program is distributed in the hope that it will be useful,
  29 #   but WITHOUT ANY WARRANTY; without even the implied warranty of
  30 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  31 #   GNU General Public License for more details.
  32 #
  33 #   You should have received a copy of the GNU General Public License
  34 #   along with this program; if not, write to the Free Software
  35 #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  36 #
  37 #========================================================================
  38 #
  39 # Version 3.0.0beta0, released 11 Jul 2006.
  40 #
  41 # See http://backuppc.sourceforge.net.
  42 #
  43 #========================================================================
  44
  45 use strict;
  46 no  utf8;
  47 use lib "/usr/local/BackupPC/lib";
  48 use File::Find;
  49 use File::Path;
  50 use Getopt::Std;
  51
  52 use BackupPC::Lib;
  53 use BackupPC::Attrib qw(:all);
  54 use BackupPC::FileZIO;
  55 use BackupPC::View;
  56
  57 use constant S_IFMT       => 0170000;   # type of file
  58
  59 die("BackupPC::Lib->new failed\n") if ( !(my $bpc = BackupPC::Lib->new) );
  60 my $TopDir = $bpc->TopDir();
  61 my $BinDir = $bpc->BinDir();
  62 my %Conf   = $bpc->Conf();
  63
  64 my %opts;
  65
  66 if ( !getopts("c", \%opts) || @ARGV < 1 ) {
  67     print STDERR <<EOF;
  68 usage: $0 [options] files/directories...
  69   Options:
  70      -c      don't cache inode data (reduces memory usage at the
  71                                      expense of longer run time)
  72 EOF
  73     exit(1);
  74 }
  75
  76 #
  77 # This constant and the line of code below that uses it are borrowed
  78 # from Archive::Tar.  Thanks to Calle Dybedahl and Stephen Zander.
  79 # See www.cpan.org.
  80 #
  81 # Archive::Tar is Copyright 1997 Calle Dybedahl. All rights reserved.
  82 #                 Copyright 1998 Stephen Zander. All rights reserved.
  83 #
  84 my $tar_pack_header
  85     = 'a100 a8 a8 a8 a12 a12 A8 a1 a100 a6 a2 a32 a32 a8 a8 a155 x12';
  86 my $tar_header_length = 512;
  87
  88 my $BufSize    = 1048576;               # 1MB or 2^20
  89 my $WriteBuf   = "";
  90 my $WriteBufSz = ($opts{b} || 20) * $tar_header_length;
  91
  92 my(%UidCache, %GidCache);
  93
  94 my($ClientName, $ClientBackups, $ClientBkupNum, $ClientDirAttr, $ClientDir);
  95
  96 my $FileCnt    = 0;
  97 my $HLinkCnt   = 0;
  98 my $ByteCnt    = 0;
  99 my $DirCnt     = 0;
 100 my $ErrorCnt   = 0;
 101 my $ClientBkupCompress = 1;
 102 my $ClientBkupMangle   = 1;
 103
 104 my %Inode2Path;
 105
 106 #
 107 # Write out all the requested files/directories
 108 #
 109 binmode(STDOUT);
 110 my $fh = *STDOUT;
 111
 112 my $argCnt = 1;
 113 my $argMax = @ARGV;
 114
 115 while ( @ARGV ) {
 116     my $path = shift(@ARGV);
 117
 118     if ( $path !~ m{^\Q$TopDir/\E} ) {
 119         print STDERR "Argument $path must be an absolute path starting with $TopDir\n";
 120         exit(1);
 121     }
 122     if ( !-d $path ) {
 123         print STDERR "Argument $path does not exist\n";
 124         exit(1);
 125     }
 126
 127     find({wanted => sub { archiveFile($fh) } }, $path);
 128
 129     #
 130     # To avoid using too much memory for the inode cache,
 131     # remove it after each top-level directory is done.
 132     #
 133     %Inode2Path = ();
 134
 135     #
 136     # Print some stats
 137     #
 138     print STDERR "Done $path ($argCnt of $argMax): $DirCnt dirs,"
 139                . " $FileCnt files, $HLinkCnt hardlinks\n";
 140
 141     $FileCnt    = 0;
 142     $HLinkCnt   = 0;
 143     $ByteCnt    = 0;
 144     $DirCnt     = 0;
 145
 146     $argCnt++;
 147 }
 148
 149 #
 150 # Finish with two null 512 byte headers, and then round out a full
 151 # block.
 152 #
 153 my $data = "\0" x ($tar_header_length * 2);
 154 TarWrite($fh, \$data);
 155 TarWrite($fh, undef);
 156
 157 if ( $ErrorCnt ) {
 158     #
 159     # Got errors so exit with a non-zero status
 160     #
 161     print STDERR "Got $ErrorCnt warnings/errors\n";
 162     exit(1);
 163 }
 164 exit(0);
 165
 166 ###########################################################################
 167 # Subroutines
 168 ###########################################################################
 169
 170 sub archiveFile
 171 {
 172     my($fh) = @_;
 173     my($hdr);
 174
 175     my @s = stat($_);
 176
 177     #
 178     # We just handle directories and files; no symlinks or
 179     # char/block special files.
 180     #
 181     $hdr->{type}     = -d _ ? BPC_FTYPE_DIR
 182                      : -f _ ? BPC_FTYPE_FILE
 183                      : -1;
 184     $hdr->{fullPath} = $File::Find::name;
 185     $hdr->{inode}    = $s[1];
 186     $hdr->{nlink}    = $s[3];
 187     $hdr->{size}     = $s[7];
 188     $hdr->{devmajor} = $s[6] >> 8;
 189     $hdr->{devminor} = $s[6] & 0xff;
 190     $hdr->{uid}      = $s[4];
 191     $hdr->{gid}      = $s[5];
 192     $hdr->{mode}     = $s[2];
 193     $hdr->{mtime}    = $s[9];
 194     $hdr->{compress} = 1;
 195
 196     if ( $hdr->{fullPath} !~ m{\Q$TopDir\E/pc/(.*)} ) {
 197         print STDERR "Can't extract TopDir ($TopDir) from"
 198                    . " $hdr->{fullPath}\n";
 199         $ErrorCnt++;
 200         return;
 201     }
 202     $hdr->{relPath}  = $1;
 203     if ( $hdr->{relPath} =~ m{(.*)/(.*)} ) {
 204         $hdr->{name} = $2;
 205     } else {
 206         $hdr->{name} = $hdr->{relPath};
 207     }
 208
 209     if ( $hdr->{relPath} =~ m{(.*?)/} ) {
 210         my $clientName = $1;
 211         if ( $ClientName ne $clientName ) {
 212             $ClientName    = $clientName;
 213             $ClientBackups = [ $bpc->BackupInfoRead($ClientName) ];
 214             #print STDERR "Setting Client to $ClientName\n";
 215         }
 216         if ( $hdr->{relPath} =~ m{(.*?)/(\d+)/}
 217                  || $hdr->{relPath} =~ m{(.*?)/(\d+)$} ) {
 218             my $backupNum = $2;
 219             if ( $ClientBkupNum != $backupNum ) {
 220                 my $i;
 221                 $ClientBkupNum = $backupNum;
 222                 # print STDERR "Setting ClientBkupNum to $ClientBkupNum\n";
 223                 for ( $i = 0 ; $i < @$ClientBackups ; $i++ ) {
 224                     if ( $ClientBackups->[$i]{num} == $ClientBkupNum ) {
 225                         $ClientBkupCompress = $ClientBackups->[$i]{compress};
 226                         $ClientBkupMangle   = $ClientBackups->[$i]{mangle};
 227                         # print STDERR "Setting $ClientBkupNum compress to $ClientBkupCompress, mangle to $ClientBkupMangle\n";
 228                         last;
 229                     }
 230                 }
 231             }
 232             $hdr->{compress} = $ClientBkupCompress;
 233             if ( $hdr->{type} == BPC_FTYPE_FILE && $hdr->{nlink} > 1
 234                     && $hdr->{name} =~ /^f/ ) {
 235                 (my $dir = $hdr->{fullPath}) =~ s{(.*)/.*}{$1};
 236                 if ( $ClientDir ne $dir ) {
 237                     $ClientDir = $dir;
 238                     $ClientDirAttr = BackupPC::Attrib->new(
 239                                           { compress => $ClientBkupCompress }
 240                                      );
 241                     if ( -f $ClientDirAttr->fileName($dir)
 242                                 && !$ClientDirAttr->read($dir) ) {
 243                         print STDERR "Can't read attrib file in $dir\n";
 244                         $ErrorCnt++;
 245                     }
 246                 }
 247                 my $name = $hdr->{name};
 248                 $name = $bpc->fileNameUnmangle($name) if ( $ClientBkupMangle );
 249                 my $attr = $ClientDirAttr->get($name);
 250                 $hdr->{realSize} = $attr->{size} if ( defined($attr) );
 251                 #print STDERR "$hdr->{fullPath} has real size $hdr->{realSize}\n";
 252             }
 253         }
 254     } else {
 255         $hdr->{compress} = 0;
 256         $hdr->{realSize} = $hdr->{size};
 257     }
 258
 259     #print STDERR "$File::Find::name\n";
 260
 261     TarWriteFile($hdr, $fh);
 262 }
 263
 264 sub UidLookup
 265 {
 266     my($uid) = @_;
 267
 268     $UidCache{$uid} = (getpwuid($uid))[0] if ( !exists($UidCache{$uid}) );
 269     return $UidCache{$uid};
 270 }
 271
 272 sub GidLookup
 273 {
 274     my($gid) = @_;
 275
 276     $GidCache{$gid} = (getgrgid($gid))[0] if ( !exists($GidCache{$gid}) );
 277     return $GidCache{$gid};
 278 }
 279
 280 sub TarWrite
 281 {
 282     my($fh, $dataRef) = @_;
 283
 284     if ( !defined($dataRef) ) {
 285         #
 286         # do flush by padding to a full $WriteBufSz
 287         #
 288         my $data = "\0" x ($WriteBufSz - length($WriteBuf));
 289         $dataRef = \$data;
 290     }
 291     if ( length($WriteBuf) + length($$dataRef) < $WriteBufSz ) {
 292         #
 293         # just buffer and return
 294         #
 295         $WriteBuf .= $$dataRef;
 296         return;
 297     }
 298     my $done = $WriteBufSz - length($WriteBuf);
 299     if ( (my $n = syswrite($fh, $WriteBuf . substr($$dataRef, 0, $done)))
 300                                 != $WriteBufSz ) {
 301         print(STDERR "Unable to write to output file ($!) ($n vs $WriteBufSz)\n");
 302         exit(1);
 303     }
 304     while ( $done + $WriteBufSz <= length($$dataRef) ) {
 305         if ( (my $n = syswrite($fh, substr($$dataRef, $done, $WriteBufSz)))
 306                             != $WriteBufSz ) {
 307             print(STDERR "Unable to write to output file ($!) ($n v $WriteBufSz)\n");
 308             exit(1);
 309         }
 310         $done += $WriteBufSz;
 311     }
 312     $WriteBuf = substr($$dataRef, $done);
 313 }
 314
 315 sub TarWritePad
 316 {
 317     my($fh, $size) = @_;
 318
 319     if ( $size % $tar_header_length ) {
 320         my $data = "\0" x ($tar_header_length - ($size % $tar_header_length));
 321         TarWrite($fh, \$data);
 322     }
 323 }
 324
 325 sub TarWriteHeader
 326 {
 327     my($fh, $hdr) = @_;
 328
 329     $hdr->{uname} = UidLookup($hdr->{uid}) if ( !defined($hdr->{uname}) );
 330     $hdr->{gname} = GidLookup($hdr->{gid}) if ( !defined($hdr->{gname}) );
 331     my $devmajor = defined($hdr->{devmajor}) ? sprintf("%07o", $hdr->{devmajor})
 332                                              : "";
 333     my $devminor = defined($hdr->{devminor}) ? sprintf("%07o", $hdr->{devminor})
 334                                              : "";
 335     my $sizeStr;
 336     if ( $hdr->{size} >= 2 * 65536 * 65536 ) {
 337         #
 338         # GNU extension for files >= 8GB: send size in big-endian binary
 339         #
 340         $sizeStr = pack("c4 N N", 0x80, 0, 0, 0,
 341                                   $hdr->{size} / (65536 * 65536),
 342                                   $hdr->{size} % (65536 * 65536));
 343     } elsif ( $hdr->{size} >= 1 * 65536 * 65536 ) {
 344         #
 345         # sprintf octal only handles up to 2^32 - 1
 346         #
 347         $sizeStr = sprintf("%03o", $hdr->{size} / (1 << 24))
 348                  . sprintf("%08o", $hdr->{size} % (1 << 24));
 349     } else {
 350         $sizeStr = sprintf("%011o", $hdr->{size});
 351     }
 352     my $data = pack($tar_pack_header,
 353                      substr($hdr->{name}, 0, 99),
 354                      sprintf("%07o", $hdr->{mode}),
 355                      sprintf("%07o", $hdr->{uid}),
 356                      sprintf("%07o", $hdr->{gid}),
 357                      $sizeStr,
 358                      sprintf("%011o", $hdr->{mtime}),
 359                      "",        #checksum field - space padded by pack("A8")
 360                      $hdr->{type},
 361                      substr($hdr->{linkname}, 0, 99),
 362                      $hdr->{magic} || 'ustar ',
 363                      $hdr->{version} || ' ',
 364                      $hdr->{uname},
 365                      $hdr->{gname},
 366                      $devmajor,
 367                      $devminor,
 368                      ""         # prefix is empty
 369                  );
 370     substr($data, 148, 7) = sprintf("%06o\0", unpack("%16C*",$data));
 371     TarWrite($fh, \$data);
 372 }
 373
 374 sub TarWriteFileInfo
 375 {
 376     my($fh, $hdr) = @_;
 377
 378     #
 379     # Handle long link names (symbolic links)
 380     #
 381     if ( length($hdr->{linkname}) > 99 ) {
 382         my %h;
 383         my $data = $hdr->{linkname} . "\0";
 384         $h{name} = "././\@LongLink";
 385         $h{type} = "K";
 386         $h{size} = length($data);
 387         TarWriteHeader($fh, \%h);
 388         TarWrite($fh, \$data);
 389         TarWritePad($fh, length($data));
 390     }
 391     #
 392     # Handle long file names
 393     #
 394     if ( length($hdr->{name}) > 99 ) {
 395         my %h;
 396         my $data = $hdr->{name} . "\0";
 397         $h{name} = "././\@LongLink";
 398         $h{type} = "L";
 399         $h{size} = length($data);
 400         TarWriteHeader($fh, \%h);
 401         TarWrite($fh, \$data);
 402         TarWritePad($fh, length($data));
 403     }
 404     TarWriteHeader($fh, $hdr);
 405 }
 406
 407 my $Attr;
 408 my $AttrDir;
 409
 410 sub TarWriteFile
 411 {
 412     my($hdr, $fh) = @_;
 413
 414     my $tarPath = $hdr->{relPath};
 415
 416     $tarPath =~ s{//+}{/}g;
 417     $tarPath = "./" . $tarPath if ( $tarPath !~ /^\.\// );
 418     $tarPath =~ s{//+}{/}g;
 419     $hdr->{name} = $tarPath;
 420
 421     if ( $hdr->{type} == BPC_FTYPE_DIR ) {
 422         #
 423         # Directory: just write the header
 424         #
 425         $hdr->{name} .= "/" if ( $hdr->{name} !~ m{/$} );
 426         TarWriteFileInfo($fh, $hdr);
 427         $DirCnt++;
 428     } elsif ( $hdr->{type} == BPC_FTYPE_FILE ) {
 429         #
 430         # Regular file: write the header and file
 431         #
 432         my($data, $dataMD5, $size, $linkName);
 433
 434         if ( $hdr->{type} == BPC_FTYPE_FILE && $hdr->{nlink} > 1 ) {
 435             if ( defined($Inode2Path{$hdr->{inode}}) ) {
 436                 $linkName = $Inode2Path{$hdr->{inode}};
 437                 #print STDERR "Got cache hit for $linkName\n";
 438             } else {
 439                 my $f = BackupPC::FileZIO->open($hdr->{fullPath}, 0,
 440                                                 $hdr->{compress});
 441                 if ( !defined($f) ) {
 442                     print(STDERR "Unable to open file $hdr->{fullPath}\n");
 443                     $ErrorCnt++;
 444                     return;
 445                 }
 446                 #
 447                 # Try to find the hardlink it points to by computing
 448                 # the pool file digest.
 449                 #
 450                 $f->read(\$dataMD5, $BufSize);
 451                 if ( !defined($hdr->{realSize}) ) {
 452                     #
 453                     # Need to get the real size
 454                     #
 455                     $size = length($dataMD5);
 456                     while ( $f->read(\$data, $BufSize) > 0 ) {
 457                         $size += length($data);
 458                     }
 459                     $hdr->{realSize} = $size;
 460                 }
 461                 $f->close();
 462                 my $md5 = Digest::MD5->new;
 463                 my $len = length($dataMD5);
 464                 $hdr->{realSize} = $len if ( $hdr->{type} != BPC_FTYPE_FILE );
 465                 if ( $hdr->{realSize} < 1048576
 466                             && length($dataMD5) != $hdr->{realSize} ) {
 467                     print(STDERR "File $hdr->{fullPath} has bad size"
 468                                 . " (expect $hdr->{realSize}, got $len)\n");
 469                 } else {
 470                     my $digest = $bpc->Buffer2MD5($md5, $hdr->{realSize},
 471                                                   \$dataMD5);
 472                     my $path = $bpc->MD52Path($digest, $hdr->{compress});
 473                     my $i = -1;
 474
 475                     # print(STDERR "Looking up $hdr->{fullPath} at $path\n");
 476                     while ( 1 ) {
 477                         my $testPath = $path;
 478                         $testPath .= "_$i" if ( $i >= 0 );
 479                         last if ( !-f $testPath );
 480                         my $inode = (stat(_))[1];
 481                         if ( $inode == $hdr->{inode} ) {
 482                             #
 483                             # Found it!  Just emit a tar hardlink
 484                             #
 485                             $testPath =~ s{\Q$TopDir\E}{..};
 486                             $linkName = $testPath;
 487                             last;
 488                         }
 489                         $i++;
 490                     }
 491                 }
 492             }
 493             if ( defined($linkName) ) {
 494                 $hdr->{type}     = BPC_FTYPE_HARDLINK;
 495                 $hdr->{linkname} = $linkName;
 496                 TarWriteFileInfo($fh, $hdr);
 497                 $HLinkCnt++;
 498                 #print STDERR "$hdr->{relPath} matches $testPath\n";
 499                 if ( !$opts{c} && $hdr->{nlink} > 2 ) {
 500                     #
 501                     # add it to the cache if there are more
 502                     # than 2 links (pool + current file),
 503                     # since there are more to go
 504                     #
 505                     $Inode2Path{$hdr->{inode}} = $linkName;
 506                 }
 507                 return;
 508             }
 509             $size = 0;
 510             print STDERR "Can't find $hdr->{relPath} in pool, will copy file\n";
 511             $ErrorCnt++;
 512         }
 513
 514         my $f = BackupPC::FileZIO->open($hdr->{fullPath}, 0, 0);
 515         if ( !defined($f) ) {
 516             print(STDERR "Unable to open file $hdr->{fullPath}\n");
 517             $ErrorCnt++;
 518             return;
 519         }
 520         TarWriteFileInfo($fh, $hdr);
 521         while ( $f->read(\$data, $BufSize) > 0 ) {
 522             if ( $size + length($data) > $hdr->{size} ) {
 523                 print(STDERR "Error: truncating $hdr->{fullPath} to"
 524                            . " $hdr->{size} bytes\n");
 525                 $data = substr($data, 0, $hdr->{size} - $size);
 526                 $ErrorCnt++;
 527             }
 528             TarWrite($fh, \$data);
 529             $size += length($data);
 530         }
 531         $f->close;
 532         if ( $size != $hdr->{size} ) {
 533             print(STDERR "Error: padding $hdr->{fullPath} to $hdr->{size}"
 534                        . " bytes from $size bytes\n");
 535             $ErrorCnt++;
 536             while ( $size < $hdr->{size} ) {
 537                 my $len = $hdr->{size} - $size;
 538                 $len = $BufSize if ( $len > $BufSize );
 539                 $data = "\0" x $len;
 540                 TarWrite($fh, \$data);
 541                 $size += $len;
 542             }
 543         }
 544         TarWritePad($fh, $size);
 545         $FileCnt++;
 546         $ByteCnt += $size;
 547     } else {
 548         print(STDERR "Got unknown type $hdr->{type} for $hdr->{name}\n");
 549         $ErrorCnt++;
 550     }
 551 }