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.0beta2, released 11 Nov 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     # Default type - we'll update later if it is a symlink, hardlink etc
 179     #
 180     $hdr->{type}     = -d _ ? BPC_FTYPE_DIR
 181                      : -f _ ? BPC_FTYPE_FILE
 182                      : -1;
 183     $hdr->{fullPath} = $File::Find::name;
 184     $hdr->{inode}    = $s[1];
 185     $hdr->{nlink}    = $s[3];
 186     $hdr->{size}     = $s[7];
 187     $hdr->{devmajor} = $s[6] >> 8;
 188     $hdr->{devminor} = $s[6] & 0xff;
 189     $hdr->{uid}      = $s[4];
 190     $hdr->{gid}      = $s[5];
 191     $hdr->{mode}     = $s[2];
 192     $hdr->{mtime}    = $s[9];
 193     $hdr->{compress} = 1;
 194
 195     if ( $hdr->{fullPath} !~ m{\Q$TopDir\E/pc/(.*)} ) {
 196         print STDERR "Can't extract TopDir ($TopDir) from"
 197                    . " $hdr->{fullPath}\n";
 198         $ErrorCnt++;
 199         return;
 200     }
 201     $hdr->{relPath}  = $1;
 202     if ( $hdr->{relPath} =~ m{(.*)/(.*)} ) {
 203         $hdr->{name} = $2;
 204     } else {
 205         $hdr->{name} = $hdr->{relPath};
 206     }
 207
 208     if ( $hdr->{relPath} =~ m{(.*?)/} ) {
 209         my $clientName = $1;
 210         if ( $ClientName ne $clientName ) {
 211             $ClientName    = $clientName;
 212             $ClientBackups = [ $bpc->BackupInfoRead($ClientName) ];
 213             #print STDERR "Setting Client to $ClientName\n";
 214         }
 215         if ( $hdr->{relPath} =~ m{(.*?)/(\d+)/}
 216                  || $hdr->{relPath} =~ m{(.*?)/(\d+)$} ) {
 217             my $backupNum = $2;
 218             if ( $ClientBkupNum != $backupNum ) {
 219                 my $i;
 220                 $ClientBkupNum = $backupNum;
 221                 # print STDERR "Setting ClientBkupNum to $ClientBkupNum\n";
 222                 for ( $i = 0 ; $i < @$ClientBackups ; $i++ ) {
 223                     if ( $ClientBackups->[$i]{num} == $ClientBkupNum ) {
 224                         $ClientBkupCompress = $ClientBackups->[$i]{compress};
 225                         $ClientBkupMangle   = $ClientBackups->[$i]{mangle};
 226                         # print STDERR "Setting $ClientBkupNum compress to $ClientBkupCompress, mangle to $ClientBkupMangle\n";
 227                         last;
 228                     }
 229                 }
 230             }
 231             $hdr->{compress} = $ClientBkupCompress;
 232             if ( $hdr->{type} == BPC_FTYPE_FILE && $hdr->{name} =~ /^f/ ) {
 233                 (my $dir = $hdr->{fullPath}) =~ s{(.*)/.*}{$1};
 234                 if ( $ClientDir ne $dir ) {
 235                     $ClientDir = $dir;
 236                     $ClientDirAttr = BackupPC::Attrib->new(
 237                                           { compress => $ClientBkupCompress }
 238                                      );
 239                     if ( -f $ClientDirAttr->fileName($dir)
 240                                 && !$ClientDirAttr->read($dir) ) {
 241                         print STDERR "Can't read attrib file in $dir\n";
 242                         $ErrorCnt++;
 243                     }
 244                 }
 245                 my $name = $hdr->{name};
 246                 $name = $bpc->fileNameUnmangle($name) if ( $ClientBkupMangle );
 247                 my $attr = $ClientDirAttr->get($name);
 248                 if ( defined($attr) ) {
 249                     $hdr->{type}     = $attr->{type};
 250                     $hdr->{realSize} = $attr->{size}
 251                                 if ( $attr->{type} == BPC_FTYPE_FILE );
 252                 }
 253                 #print STDERR "$hdr->{fullPath} has type $hdr->{type} and real size $hdr->{realSize}\n";
 254             }
 255         }
 256     } else {
 257         $hdr->{compress} = 0;
 258         $hdr->{realSize} = $hdr->{size};
 259     }
 260
 261     #print STDERR "$File::Find::name\n";
 262
 263     TarWriteFile($hdr, $fh);
 264 }
 265
 266 sub UidLookup
 267 {
 268     my($uid) = @_;
 269
 270     $UidCache{$uid} = (getpwuid($uid))[0] if ( !exists($UidCache{$uid}) );
 271     return $UidCache{$uid};
 272 }
 273
 274 sub GidLookup
 275 {
 276     my($gid) = @_;
 277
 278     $GidCache{$gid} = (getgrgid($gid))[0] if ( !exists($GidCache{$gid}) );
 279     return $GidCache{$gid};
 280 }
 281
 282 sub TarWrite
 283 {
 284     my($fh, $dataRef) = @_;
 285
 286     if ( !defined($dataRef) ) {
 287         #
 288         # do flush by padding to a full $WriteBufSz
 289         #
 290         my $data = "\0" x ($WriteBufSz - length($WriteBuf));
 291         $dataRef = \$data;
 292     }
 293     if ( length($WriteBuf) + length($$dataRef) < $WriteBufSz ) {
 294         #
 295         # just buffer and return
 296         #
 297         $WriteBuf .= $$dataRef;
 298         return;
 299     }
 300     my $done = $WriteBufSz - length($WriteBuf);
 301     if ( (my $n = syswrite($fh, $WriteBuf . substr($$dataRef, 0, $done)))
 302                                 != $WriteBufSz ) {
 303         print(STDERR "Unable to write to output file ($!) ($n vs $WriteBufSz)\n");
 304         exit(1);
 305     }
 306     while ( $done + $WriteBufSz <= length($$dataRef) ) {
 307         if ( (my $n = syswrite($fh, substr($$dataRef, $done, $WriteBufSz)))
 308                             != $WriteBufSz ) {
 309             print(STDERR "Unable to write to output file ($!) ($n v $WriteBufSz)\n");
 310             exit(1);
 311         }
 312         $done += $WriteBufSz;
 313     }
 314     $WriteBuf = substr($$dataRef, $done);
 315 }
 316
 317 sub TarWritePad
 318 {
 319     my($fh, $size) = @_;
 320
 321     if ( $size % $tar_header_length ) {
 322         my $data = "\0" x ($tar_header_length - ($size % $tar_header_length));
 323         TarWrite($fh, \$data);
 324     }
 325 }
 326
 327 sub TarWriteHeader
 328 {
 329     my($fh, $hdr) = @_;
 330
 331     $hdr->{uname} = UidLookup($hdr->{uid}) if ( !defined($hdr->{uname}) );
 332     $hdr->{gname} = GidLookup($hdr->{gid}) if ( !defined($hdr->{gname}) );
 333     my $devmajor = defined($hdr->{devmajor}) ? sprintf("%07o", $hdr->{devmajor})
 334                                              : "";
 335     my $devminor = defined($hdr->{devminor}) ? sprintf("%07o", $hdr->{devminor})
 336                                              : "";
 337     my $sizeStr;
 338     if ( $hdr->{size} >= 2 * 65536 * 65536 ) {
 339         #
 340         # GNU extension for files >= 8GB: send size in big-endian binary
 341         #
 342         $sizeStr = pack("c4 N N", 0x80, 0, 0, 0,
 343                                   $hdr->{size} / (65536 * 65536),
 344                                   $hdr->{size} % (65536 * 65536));
 345     } elsif ( $hdr->{size} >= 1 * 65536 * 65536 ) {
 346         #
 347         # sprintf octal only handles up to 2^32 - 1
 348         #
 349         $sizeStr = sprintf("%03o", $hdr->{size} / (1 << 24))
 350                  . sprintf("%08o", $hdr->{size} % (1 << 24));
 351     } else {
 352         $sizeStr = sprintf("%011o", $hdr->{size});
 353     }
 354     my $data = pack($tar_pack_header,
 355                      substr($hdr->{name}, 0, 99),
 356                      sprintf("%07o", $hdr->{mode}),
 357                      sprintf("%07o", $hdr->{uid}),
 358                      sprintf("%07o", $hdr->{gid}),
 359                      $sizeStr,
 360                      sprintf("%011o", $hdr->{mtime}),
 361                      "",        #checksum field - space padded by pack("A8")
 362                      $hdr->{type},
 363                      substr($hdr->{linkname}, 0, 99),
 364                      $hdr->{magic} || 'ustar ',
 365                      $hdr->{version} || ' ',
 366                      $hdr->{uname},
 367                      $hdr->{gname},
 368                      $devmajor,
 369                      $devminor,
 370                      ""         # prefix is empty
 371                  );
 372     substr($data, 148, 7) = sprintf("%06o\0", unpack("%16C*",$data));
 373     TarWrite($fh, \$data);
 374 }
 375
 376 sub TarWriteFileInfo
 377 {
 378     my($fh, $hdr) = @_;
 379
 380     #
 381     # Handle long link names (symbolic links)
 382     #
 383     if ( length($hdr->{linkname}) > 99 ) {
 384         my %h;
 385         my $data = $hdr->{linkname} . "\0";
 386         $h{name} = "././\@LongLink";
 387         $h{type} = "K";
 388         $h{size} = length($data);
 389         TarWriteHeader($fh, \%h);
 390         TarWrite($fh, \$data);
 391         TarWritePad($fh, length($data));
 392     }
 393     #
 394     # Handle long file names
 395     #
 396     if ( length($hdr->{name}) > 99 ) {
 397         my %h;
 398         my $data = $hdr->{name} . "\0";
 399         $h{name} = "././\@LongLink";
 400         $h{type} = "L";
 401         $h{size} = length($data);
 402         TarWriteHeader($fh, \%h);
 403         TarWrite($fh, \$data);
 404         TarWritePad($fh, length($data));
 405     }
 406     TarWriteHeader($fh, $hdr);
 407 }
 408
 409 my $Attr;
 410 my $AttrDir;
 411
 412 sub TarWriteFile
 413 {
 414     my($hdr, $fh) = @_;
 415
 416     my $tarPath = $hdr->{relPath};
 417
 418     $tarPath =~ s{//+}{/}g;
 419     $tarPath = "./" . $tarPath if ( $tarPath !~ /^\.\// );
 420     $tarPath =~ s{//+}{/}g;
 421     $hdr->{name} = $tarPath;
 422
 423     if ( $hdr->{type} == BPC_FTYPE_DIR ) {
 424         #
 425         # Directory: just write the header
 426         #
 427         $hdr->{name} .= "/" if ( $hdr->{name} !~ m{/$} );
 428         TarWriteFileInfo($fh, $hdr);
 429         $DirCnt++;
 430     } elsif ( $hdr->{type} == BPC_FTYPE_FILE
 431             || $hdr->{type} == BPC_FTYPE_HARDLINK
 432             || $hdr->{type} == BPC_FTYPE_SYMLINK
 433             || $hdr->{type} == BPC_FTYPE_CHARDEV
 434             || $hdr->{type} == BPC_FTYPE_BLOCKDEV
 435             || $hdr->{type} == BPC_FTYPE_FIFO
 436             || $hdr->{type} == BPC_FTYPE_SOCKET ) {
 437         #
 438         # Underlying file is a regular file: write the header and file
 439         #
 440         my($data, $dataMD5, $size, $linkName);
 441
 442         if ( defined($Inode2Path{$hdr->{inode}}) ) {
 443             $linkName = $Inode2Path{$hdr->{inode}};
 444             #print STDERR "Got cache hit for $linkName\n";
 445         } else {
 446             my $f = BackupPC::FileZIO->open($hdr->{fullPath}, 0,
 447                                             $hdr->{compress});
 448             if ( !defined($f) ) {
 449                 print(STDERR "Unable to open file $hdr->{fullPath}\n");
 450                 $ErrorCnt++;
 451                 return;
 452             }
 453             #
 454             # Try to find the hardlink it points to by computing
 455             # the pool file digest.
 456             #
 457             $f->read(\$dataMD5, $BufSize);
 458             if ( !defined($hdr->{realSize}) ) {
 459                 #
 460                 # Need to get the real size
 461                 #
 462                 $size = length($dataMD5);
 463                 while ( $f->read(\$data, $BufSize) > 0 ) {
 464                     $size += length($data);
 465                 }
 466                 $hdr->{realSize} = $size;
 467             }
 468             $f->close();
 469             my $md5 = Digest::MD5->new;
 470             my $len = length($dataMD5);
 471             if ( $hdr->{realSize} < 1048576
 472                         && length($dataMD5) != $hdr->{realSize} ) {
 473                 print(STDERR "File $hdr->{fullPath} has bad size"
 474                             . " (expect $hdr->{realSize}, got $len)\n");
 475             } else {
 476                 my $digest = $bpc->Buffer2MD5($md5, $hdr->{realSize},
 477                                               \$dataMD5);
 478                 my $path = $bpc->MD52Path($digest, $hdr->{compress});
 479                 my $i = -1;
 480
 481                 # print(STDERR "Looking up $hdr->{fullPath} at $path\n");
 482                 while ( 1 ) {
 483                     my $testPath = $path;
 484                     $testPath .= "_$i" if ( $i >= 0 );
 485                     last if ( !-f $testPath );
 486                     my $inode = (stat(_))[1];
 487                     if ( $inode == $hdr->{inode} ) {
 488                         #
 489                         # Found it!  Just emit a tar hardlink
 490                         #
 491                         $testPath =~ s{\Q$TopDir\E}{..};
 492                         $linkName = $testPath;
 493                         last;
 494                     }
 495                     $i++;
 496                 }
 497             }
 498         }
 499         if ( defined($linkName) ) {
 500             $hdr->{type}     = BPC_FTYPE_HARDLINK;
 501             $hdr->{linkname} = $linkName;
 502             TarWriteFileInfo($fh, $hdr);
 503             $HLinkCnt++;
 504             #print STDERR "$hdr->{relPath} matches $testPath\n";
 505             if ( !$opts{c} && $hdr->{nlink} > 2 ) {
 506                 #
 507                 # add it to the cache if there are more
 508                 # than 2 links (pool + current file),
 509                 # since there are more to go
 510                 #
 511                 $Inode2Path{$hdr->{inode}} = $linkName;
 512             }
 513             return;
 514         }
 515         $size = 0;
 516         if ( $hdr->{nlink} > 1 ) {
 517             print STDERR "Can't find $hdr->{relPath} in pool, will copy file\n";
 518             $ErrorCnt++;
 519         }
 520         $hdr->{type} = BPC_FTYPE_FILE;
 521
 522         my $f = BackupPC::FileZIO->open($hdr->{fullPath}, 0, 0);
 523         if ( !defined($f) ) {
 524             print(STDERR "Unable to open file $hdr->{fullPath}\n");
 525             $ErrorCnt++;
 526             return;
 527         }
 528         TarWriteFileInfo($fh, $hdr);
 529         while ( $f->read(\$data, $BufSize) > 0 ) {
 530             if ( $size + length($data) > $hdr->{size} ) {
 531                 print(STDERR "Error: truncating $hdr->{fullPath} to"
 532                            . " $hdr->{size} bytes\n");
 533                 $data = substr($data, 0, $hdr->{size} - $size);
 534                 $ErrorCnt++;
 535             }
 536             TarWrite($fh, \$data);
 537             $size += length($data);
 538         }
 539         $f->close;
 540         if ( $size != $hdr->{size} ) {
 541             print(STDERR "Error: padding $hdr->{fullPath} to $hdr->{size}"
 542                        . " bytes from $size bytes\n");
 543             $ErrorCnt++;
 544             while ( $size < $hdr->{size} ) {
 545                 my $len = $hdr->{size} - $size;
 546                 $len = $BufSize if ( $len > $BufSize );
 547                 $data = "\0" x $len;
 548                 TarWrite($fh, \$data);
 549                 $size += $len;
 550             }
 551         }
 552         TarWritePad($fh, $size);
 553         $FileCnt++;
 554         $ByteCnt += $size;
 555     } else {
 556         print(STDERR "Got unknown type $hdr->{type} for $hdr->{name}\n");
 557         $ErrorCnt++;
 558     }
 559 }