lib/BackupPC/Xfer/Ftp.pm

   1 #============================================================= -*-perl-*-
   2 #
   3 # BackupPC::Xfer::Ftp package
   4 #
   5 # DESCRIPTION
   6 #
   7 #   This library defines a BackupPC::Xfer::Ftp class for transferring
   8 #   data from a FTP client.
   9 #
  10 # AUTHOR
  11 #   Paul Mantz <pcmantz@zmanda.com>
  12 #
  13 # COPYRIGHT
  14 #   (C) 2008, Zmanda Inc.
  15 #
  16 #   This program is free software; you can redistribute it and/or
  17 #   modify it under the terms of the GNU General Public License as
  18 #   published by the Free Software Foundation; either version 2 of the
  19 #   License, or (at your option) any later version.
  20 #
  21 #   This program is distributed in the hope that it will be useful,
  22 #   but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  24 #   General Public License for more details.
  25 #
  26 #   You should have received a copy of the GNU General Public License
  27 #   along with this program; if not, write to the Free Software
  28 #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  29 #   02111-1307 USA
  30 #
  31 #
  32 #========================================================================
  33 #
  34 # Unreleased, planned release in 3.2 (or 3.1.1)
  35 #
  36 # See http://backuppc.sourceforge.net.
  37 #
  38 #========================================================================
  39
  40
  41 package BackupPC::Xfer::Ftp;
  42
  43 use strict;
  44
  45 use BackupPC::View;
  46 use BackupPC::Attrib qw(:all);
  47
  48 use Encode qw/from_to encode/;
  49 use File::Listing qw/parse_dir/;
  50 use File::Path;
  51 use Data::Dumper;
  52 use base qw(BackupPC::Xfer::Protocol);
  53
  54 use vars qw( $FTPLibOK $FTPLibErr $ARCLibOK );
  55
  56 use constant S_IFMT => 0170000;
  57
  58 BEGIN {
  59
  60     $FTPLibOK = 1;
  61     $ARCLibOK = 0;
  62
  63     #
  64     # clear eval error variable
  65     #
  66     my @FTPLibs = qw( Net::FTP Net::FTP::RetrHandle );
  67
  68     foreach my $module ( @FTPLibs ) {
  69
  70         undef $@;
  71         eval "use $module;";
  72
  73         if ( $@ ) {
  74             $FTPLibOK = 0;
  75             $FTPLibErr = "module $module doesn't exist: $@";
  76             last;
  77         }
  78     }
  79
  80     eval "use Net::FTP::AutoReconnect;";
  81     $ARCLibOK = (defined($@)) ? 1 : 0;
  82 };
  83
  84 ##############################################################################
  85 # Constructor
  86 ##############################################################################
  87
  88
  89 #
  90 #   usage:
  91 #     $xfer = new BackupPC::Xfer::Ftp( $bpc, %args );
  92 #
  93 # new() is your default class constructor.  it also calls the
  94 # constructor for Protocol as well.
  95 #
  96 sub new
  97 {
  98     my ( $class, $bpc, $args ) = @_;
  99     $args ||= {};
 100
 101     my $t = BackupPC::Xfer::Protocol->new(
 102         $bpc,
 103         {
 104            ftp   => undef,
 105            stats => {
 106                errorCnt          => 0,
 107                TotalFileCnt      => 0,
 108                TotalFileSize     => 0,
 109                ExistFileCnt      => 0,
 110                ExistFileSize     => 0,
 111                ExistFileCompSize => 0,
 112            },
 113            %$args,
 114         } );
 115     return bless( $t, $class );
 116 }
 117
 118
 119 ##############################################################################
 120 # Methods
 121 ##############################################################################
 122
 123 #
 124 #   usage:
 125 #     $xfer->start();
 126 #
 127 # start() is called to configure and initiate a dump or restore,
 128 # depending on the configured options.
 129 #
 130 sub start
 131 {
 132     my ($t) = @_;
 133
 134     my $bpc  = $t->{bpc};
 135     my $conf = $t->{conf};
 136
 137     my ( @fileList, $logMsg, $incrDate, $args, $dumpText );
 138
 139     #
 140     # initialize the statistics returned by getStats()
 141     #
 142     foreach ( qw/byteCnt fileCnt xferErrCnt xferBadShareCnt
 143                  xferBadFileCnt xferOK hostAbort hostError
 144                  lastOutputLine/ )
 145     {
 146         $t->{$_} = 0;
 147     }
 148
 149     #
 150     # Net::FTP::RetrHandle is necessary.
 151     #
 152     if ( !$FTPLibOK ) {
 153         $t->{_errStr} = "Error: FTP transfer selected but module"
 154           . " Net::FTP::RetrHandle is not installed.";
 155         $t->{xferErrCnt}++;
 156         return;
 157     }
 158
 159     #
 160     # standardize the file include/exclude settings if necessary
 161     #
 162     unless ( $t->{type} eq 'restore' ) {
 163         $bpc->backupFileConfFix( $conf, "FtpShareName" );
 164         $t->loadInclExclRegexps("FtpShareName");
 165     }
 166
 167     #
 168     # Convert the encoding type of the names if at all possible
 169     #
 170     from_to( $args->{shareName}, "utf8", $conf->{ClientCharset} )
 171                                 if ( $conf->{ClientCharset} ne "" );
 172
 173     #
 174     # Collect FTP configuration arguments and translate them for
 175     # passing to the FTP module.
 176     #
 177     unless ( $args = $t->getFTPArgs() ) {
 178         return;
 179     }
 180
 181     #
 182     # Create the Net::FTP::AutoReconnect or Net::FTP object.
 183     #
 184     undef $@;
 185     eval {
 186         $t->{ftp} = ($ARCLibOK) ? Net::FTP::AutoReconnect->new(%$args)
 187                                 : Net::FTP->new(%$args);
 188     };
 189     if ($@) {
 190         $t->{_errStr} = "Can't open connection to $args->{host}: $!";
 191         $t->{xferErrCnt}++;
 192         return;
 193     }
 194
 195     #
 196     # Log in to the ftp server and set appropriate path information.
 197     #
 198     undef $@;
 199     eval { $t->{ftp}->login( $conf->{FtpUserName}, $conf->{FtpPasswd} ); };
 200     if ( $@ ) {
 201         $t->{_errStr} = "Can't login to $args->{host}: $!";
 202         $t->{xferErrCnt}++;
 203         return;
 204     }
 205
 206     undef $@;
 207     eval { $t->{ftp}->binary(); };
 208     if ($@) {
 209         $t->{_errStr} =
 210           "Can't enable binary transfer mode to $args->{host}: $!";
 211         $t->{xferErrCnt}++;
 212         return;
 213     }
 214
 215     undef $@;
 216     eval { $t->{shareName} =~ m/^\.?$/ || $t->{ftp}->cwd( $t->{shareName} ); };
 217     if ($@) {
 218         $t->{_errStr} =
 219             "Can't change working directory to $t->{shareName}: $!";
 220         $t->{xferErrCnt}++;
 221         return;
 222     }
 223
 224     undef $@;
 225     eval { $t->{sharePath} = $t->{ftp}->pwd(); };
 226     if ($@) {
 227         $t->{_errStr} =
 228             "Can't retrieve full working directory of $t->{shareName}: $!";
 229         $t->{xferErrCnt}++;
 230         return;
 231     }
 232
 233     #
 234     # log the beginning of action based on type
 235     #
 236     if ( $t->{type} eq 'restore' ) {
 237         $logMsg = "ftp restore for host $t->{host} started on directory "
 238           . "$t->{shareName}\n";
 239
 240     } elsif ( $t->{type} eq 'full' ) {
 241         $logMsg = "ftp full backup for host $t->{host} started on directory "
 242           . "$t->{shareName}\n";
 243
 244     } elsif ( $t->{type} eq 'incr' ) {
 245         $incrDate = $bpc->timeStamp( $t->{incrBaseTime} - 3600, 1 );
 246         $logMsg = "ftp incremental backup for $t->{host} started back to "
 247           . "$incrDate (backup #$t->{incrBaseBkupNum}) for directory "
 248           . "$t->{shareName}\n";
 249     }
 250     $t->logWrite($logMsg, 1);
 251
 252     #
 253     # call the recursive function based on the type of action
 254     #
 255     if ( $t->{type} eq 'restore' ) {
 256
 257         $t->restore();
 258         $logMsg = "Restore of $t->{host} complete";
 259
 260     } elsif ( $t->{type} eq 'incr' ) {
 261
 262         $t->backup();
 263         $logMsg = "Incremental backup of $t->{host} complete";
 264
 265     } elsif ( $t->{type} eq 'full' ) {
 266
 267         $t->backup();
 268         $logMsg = "Full backup of $t->{host} complete";
 269     }
 270
 271     delete $t->{_errStr};
 272     return $logMsg;
 273 }
 274
 275
 276 #
 277 #
 278 #
 279 sub run
 280 {
 281     my ($t) = @_;
 282     my $stats = $t->{stats};
 283
 284     my ( $tarErrs,      $nFilesExist, $sizeExist,
 285          $sizeExistCom, $nFilesTotal, $sizeTotal );
 286
 287     #
 288     # TODO: replace the $stats array with variables at the top level,
 289     # ones returned by $getStats.  They should be identical.
 290     #
 291     $tarErrs      = 0;
 292     $nFilesExist  = $stats->{ExistFileCnt};
 293     $sizeExist    = $stats->{ExistFileSize};
 294     $sizeExistCom = $stats->{ExistFileCompSize};
 295     $nFilesTotal  = $stats->{TotalFileCnt};
 296     $sizeTotal    = $stats->{TotalFileSize};
 297
 298     if ( $t->{type} eq "restore" ) {
 299         return ( $t->{fileCnt}, $t->{byteCnt}, 0, 0 );
 300
 301     } else {
 302         return ( $tarErrs,      $nFilesExist, $sizeExist,
 303                  $sizeExistCom, $nFilesTotal, $sizeTotal );
 304     }
 305 }
 306
 307
 308 #
 309 #   usage:
 310 #     $t->restore();
 311 #
 312 # TODO: finish or scuttle this function.  It is not necessary for a
 313 # release.
 314 #
 315 sub restore
 316 {
 317     my $t = @_;
 318
 319     my $bpc = $t->{bpc};
 320     my $fileList = $t->{fileList};
 321
 322     my ($path, $fileName, $fileAttr, $fileType );
 323
 324     #print STDERR "BackupPC::Xfer::Ftp->restore()";
 325
 326     #
 327     # Prepare the view object
 328     #
 329     $t->{view} = BackupPC::View->new( $bpc, $t->{bkupSrcHost},
 330                                       $t->{backups} );
 331     my $view = $t->{view};
 332
 333   SCAN: foreach my $f ( @$fileList ) {
 334
 335         #print STDERR "restoring $f...\n";
 336
 337         $f =~ /(.*)\/([^\/]*)/;
 338         $path     = $1;
 339         $fileName = $2;
 340
 341         $view->dirCache($path);
 342
 343         $fileAttr = $view->fileAttrib($fileName);
 344         $fileType = fileType2Text( $fileAttr->{type} );
 345
 346         if ( $fileType eq "dir") {
 347             $t->restoreDir($fileName, $fileAttr);
 348
 349         } elsif ( $fileType eq "file" ) {
 350             $t->restoreFile($fileName, $fileAttr);
 351
 352         } elsif ( $fileType eq "symlink" ) {
 353             #
 354             # ignore
 355             #
 356         } else {
 357             #
 358             # ignore
 359             #
 360         }
 361     } # end SCAN
 362 }
 363
 364
 365 sub restoreDir
 366 {
 367     my ( $t, $dirName, $dirAttr ) = @_;
 368
 369     my $ftp    = $t->{ftp};
 370     my $bpc    = $t->{bpc};
 371     my $conf   = $t->{conf};
 372     my $view   = $t->{view};
 373     my $TopDir = $bpc->TopDir();
 374
 375     my $path    = "$dirAttr->{relPath}/$dirName";
 376     my $dirList = $view->dirAttrib( -1, $t->{shareName}, $path );
 377
 378     my ( $fileName, $fileAttr, $fileType );
 379
 380     #print STDERR "BackupPC::Xfer::Ftp->restore($dirName)\n";
 381
 382     #
 383     # Create the remote directory
 384     #
 385     undef $@;
 386     eval { $ftp->mkdir( $path, 1 ); };
 387     if ($@) {
 388         $t->logFileAction( "fail", $dirName, $dirAttr );
 389         return;
 390     }
 391
 392  SCAN: while ( ($fileName, $fileAttr ) = each %$dirList ) {
 393
 394         $fileType = fileType2Text( $fileAttr->{type} );
 395
 396         if ( $fileType eq "dir" ) {
 397             if ( $t->restoreDir( $fileName, $fileAttr ) ) {
 398                 $t->logWrite( "restored: $path/$fileName\n", 5 );
 399             } else {
 400                 $t->logWrite( "restore failed: $path/$fileName\n", 3 );
 401             }
 402
 403         } elsif ( $fileType eq "file" ) {
 404             $t->restoreFile( $fileName, $fileAttr );
 405
 406         } elsif ( $fileType eq "hardlink" ) {
 407             #
 408             # Hardlinks cannot be restored.  however, if we have the
 409             # target file in the pool, we can restore that.
 410             #
 411             $t->restoreFile( $fileName, $fileAttr );
 412
 413             next SCAN;
 414
 415         } elsif ( $fileType eq "symlink" ) {
 416             #
 417             # Symlinks cannot be restored
 418             #
 419             next SCAN;
 420
 421         } else {
 422             #
 423             # Ignore all other types (devices, doors, etc)
 424             #
 425             next SCAN;
 426         }
 427     }
 428 }
 429
 430
 431 sub restoreFile
 432 {
 433     my ($t, $fileName, $fileAttr ) = @_;
 434
 435     my $conf = $t->{conf};
 436     my $ftp  = $t->{ftp};
 437
 438     my $poolFile = $fileAttr->{fullPath};
 439     my $fileDest = ( $conf->{ClientCharset} ne "" )
 440                  ? from_to( "$fileAttr->{relPath}/$fileName",
 441                             "utf8", $conf->{ClientCharset} )
 442                  : "$fileAttr->{relPath}/$fileName";
 443
 444     #print STDERR "BackupPC::Xfer::Ftp->restoreFile($fileName)\n";
 445
 446     undef $@;
 447     eval {
 448         if ( $ftp->put( $poolFile, $fileDest ) ) {
 449             $t->logFileAction( "restore", $fileName, $fileAttr );
 450         } else {
 451             $t->logFileAction( "fail", $fileName, $fileAttr );
 452         }
 453     };
 454     if ($@) {
 455         $t->logFileAction( "fail", $fileName, $fileAttr );
 456     }
 457 }
 458
 459
 460 #
 461 #  usage:
 462 #   $t->backup($path);
 463 #
 464 # $t->backup() is a recursive function that takes a path as an
 465 # argument, and performs a backup on that folder consistent with the
 466 # configuration parameters.  $path is considered rooted at
 467 # $t->{shareName}, so no $ftp->cwd() command is necessary.
 468 #
 469 sub backup
 470 {
 471     my ($t) =  @_;
 472
 473     my $ftp    = $t->{ftp};
 474     my $bpc    = $t->{bpc};
 475     my $conf   = $t->{conf};
 476     my $TopDir = $bpc->TopDir();
 477     my $OutDir = "$TopDir/pc/$t->{client}/new/"
 478       . $bpc->fileNameEltMangle( $t->{shareName} );
 479
 480     #
 481     # Prepare the view object
 482     #
 483     $t->{view} = BackupPC::View->new( $bpc, $t->{client}, $t->{backups} );
 484
 485     #
 486     # Prepare backup folder
 487     #
 488     unless ( eval { mkpath( $OutDir, 0, 0755 ); } ) {
 489         $t->{_errStr} = "can't create OutDir: $OutDir";
 490         $t->{xferErrCnt}++;
 491         return;
 492     }
 493
 494     #
 495     # determine the filetype of the shareName and back it up
 496     # appropriately.  For now, assume that $t->{shareName} is a
 497     # directory.
 498     #
 499     my $f = {
 500               relPath  => "",
 501               fullName => $t->{shareName},
 502             };
 503
 504     if ( $t->handleDir( $f, $OutDir ) ) {
 505
 506         $t->{xferOK} = 1;
 507         return 1;
 508
 509     } else {
 510
 511         $t->{xferBadShareCnt}++;
 512         return;
 513     }
 514 }
 515
 516
 517 ####################################################################################
 518 # FTP-specific functions
 519 ####################################################################################
 520
 521
 522 #
 523 # This is an encapulation of the logic necessary to grab the arguments
 524 # from %Conf and throw it in a hash pointer to be passed to the
 525 # Net::FTP object.
 526 #
 527 sub getFTPArgs
 528 {
 529     my ($t)  = @_;
 530     my $conf = $t->{conf};
 531
 532     return {
 533         Host         => $conf->{ClientNameAlias}
 534                      || $t->{hostIP}
 535                      || $t->{host},
 536         Firewall     => undef,                            # not used
 537         FirewallType => undef,                            # not used
 538         BlockSize    => $conf->{FtpBlockSize} || 10240,
 539         Port         => $conf->{FtpPort}      || 21,
 540         Timeout      => $conf->{FtpTimeout}   || 120,
 541         Debug        => 0,                                # do not touch
 542         Passive      => 1,                                # do not touch
 543         Hash         => undef,                            # do not touch
 544         LocalAddr    => "localhost",                      # do not touch
 545     };
 546 }
 547
 548
 549 #
 550 #   usage:
 551 #     $dirList = $t->remotels($path);
 552 #
 553 # remotels() returns a reference to a list of hash references that
 554 # describe the contents of each file in the directory of the path
 555 # specified.
 556 #
 557 # In the future, I would like to make this function return objects in
 558 # Attrib format.  That would be very optimal, and I could probably
 559 # release the code to CPAN.
 560 #
 561 sub remotels
 562 {
 563     my ( $t, $path ) = @_;
 564
 565     my $ftp  = $t->{ftp};
 566     my $bpc  = $t->{bpc};
 567     my $conf = $t->{conf};
 568
 569     my ( $dirContents, $remoteDir, $f );
 570
 571     undef $@;
 572     eval {
 573         $dirContents = ( $path =~ /^\.?$/ ) ? $ftp->dir()
 574                                             : $ftp->dir("$path/");
 575     };
 576     if ($@) {
 577         $t->{xferErrCnt}++;
 578         return "can't retrieve remote directory contents of $path: $!";
 579     }
 580
 581     foreach my $info ( @{parse_dir($dirContents)} ) {
 582
 583         $f = {
 584             name  => $info->[0],
 585             type  => $info->[1],
 586             size  => $info->[2],
 587             mtime => $info->[3],
 588             mode  => $info->[4],
 589         };
 590
 591         $f->{utf8name} = $f->{name};
 592         from_to( $f->{utf8name}, $conf->{ClientCharset}, "utf8" )
 593                                 if ( $conf->{ClientCharset} ne "" );
 594
 595         $f->{fullName} = "$t->{sharePath}/$path/$f->{name}";
 596         $f->{fullName} =~ s/\/+/\//g;
 597
 598         $f->{relPath} = ($path eq "") ? $f->{name} : "$path/$f->{name}";
 599         $f->{relPath} =~ s/\/+/\//g;
 600
 601         push( @$remoteDir, $f );
 602     }
 603     return $remoteDir;
 604 }
 605
 606
 607 #
 608 # ignoreFileCheck() looks at the attributes of the arguments and the
 609 # backup types, and determines if the file should be skipped in this
 610 # backup.
 611 #
 612 sub ignoreFileCheck
 613 {
 614     my ( $t, $f, $attrib ) = @_;
 615
 616     if ( $f->{name} =~ /^\.\.?$/ ) {
 617         return 1;
 618     }
 619
 620     return ( !$t->checkIncludeExclude( $f->{fullName} ) );
 621 }
 622
 623
 624 #
 625 # handleSymlink() backs up a symlink.
 626 #
 627 sub handleSymlink
 628 {
 629     my ( $t, $f, $OutDir, $attrib ) = @_;
 630
 631     my $conf = $t->{conf};
 632     my $ftp  = $t->{ftp};
 633     my ( $target, $targetDesc );
 634
 635     my $attribInfo = {
 636         type  => BPC_FTYPE_SYMLINK,
 637         mode  => $f->{mode},
 638         uid   => undef,            # unsupported
 639         gid   => undef,            # unsupported
 640         size  => 0,
 641         mtime => $f->{mtime},
 642     };
 643
 644     #
 645     # If we are following symlinks, back them up as the type of file
 646     # they point to. Otherwise, backup the symlink.
 647     #
 648     if ( $conf->{FtpFollowSymlinks} ) {
 649
 650         #
 651         # handle nested symlinks by recurring on the target until a
 652         # file or directory is found.
 653         #
 654         $f->{type} =~ /^l (.*)/;
 655         $target = $1;
 656
 657         undef $@;
 658         eval {
 659             if ( $targetDesc = $ftp->dir("$target/") ) {
 660                 $t->handleSymDir( $f, $OutDir, $attrib, $targetDesc );
 661
 662             } elsif ( $targetDesc = $ftp->dir($target) ) {
 663                 if ( $targetDesc->[4] eq 'file' ) {
 664                     $t->handleSymFile( $f, $OutDir, $attrib );
 665
 666                 } elsif ( $targetDesc->[4] =~ /l (.*)/ ) {
 667                     $t->logFileAction( "fail", $f->{utf8name}, $attribInfo );
 668                     return;
 669                 }
 670             } else {
 671                 $t->( "fail", $f );
 672                 return;
 673             }
 674         };
 675         if ($@) {
 676             $t->logFileAction( "fail", $f->{utf8name}, $attribInfo );
 677             return;
 678         }
 679
 680     } else {
 681         #
 682         # If we are not following symlinks, record them normally.
 683         #
 684         $attrib->set( $f->{utf8name}, $attribInfo );
 685         $t->logFileAction("create", $f->{utf8name}, $attribInfo);
 686     }
 687     return 1;
 688 }
 689
 690
 691 sub handleSymDir
 692 {
 693     my ($t, $fSym, $OutDir, $attrib, $targetDesc) = @_;
 694
 695     return 1;
 696  }
 697
 698
 699 sub handleSymFile
 700 {
 701     my ( $t, $fSym, $OutDir, $attrib, $targetDesc ) = @_;
 702
 703     my $bpc  = $t->{bpc};
 704     my $conf = $t->{conf};
 705
 706     my $f = {
 707         name  => $fSym->{name},
 708         type  => $targetDesc->[1],
 709         size  => $targetDesc->[2],
 710         mtime => $targetDesc->[3],
 711         mode  => $targetDesc->[4]
 712     };
 713
 714     $f->{utf8name} = $fSym->{name};
 715     from_to( $f->{utf8name}, $conf->{ClientCharset}, "utf8" )
 716                             if ( $conf->{ClientCharset} ne "" );
 717
 718     $f->{relPath}  = $fSym->{relPath};
 719     $f->{fullName} = "$t->{shareName}/$fSym->{relPath}/$fSym->{name}";
 720     $f->{fullName} =~ s/\/+/\//g;
 721
 722     #
 723     # since FTP servers follow symlinks, we can just do this:
 724     #
 725     return $t->handleFile( $f, $OutDir, $attrib );
 726 }
 727
 728
 729 #
 730 # handleDir() backs up a directory, and initiates a backup of its
 731 # contents.
 732 #
 733 sub handleDir
 734 {
 735     my ( $t, $dir, $OutDir ) = @_;
 736
 737     my $ftp   = $t->{ftp};
 738     my $bpc   = $t->{bpc};
 739     my $conf  = $t->{conf};
 740     my $view  = $t->{view};
 741     my $stats = $t->{stats};
 742
 743     my ( $exists, $digest, $outSize, $errs );
 744     my ( $poolWrite, $poolFile, $attribInfo );
 745     my ( $localDir, $remoteDir, $attrib, %expectedFiles );
 746
 747     if ( exists($dir->{utf8name})) {
 748         $OutDir .= "/" . $bpc->fileNameMangle( $dir->{utf8name} );
 749     }
 750
 751     unless ( -d $OutDir ) {
 752
 753         eval { mkpath( $OutDir, 0, 0755 ) };
 754         if ( $@ ) {
 755             $t->logFileAction( "fail", $dir->{utf8name}, $dir );
 756             return;
 757         } else {
 758             $t->logFileAction( "create", $dir->{utf8name}, $dir );
 759         }
 760     }
 761
 762     $attrib    = BackupPC::Attrib->new( { compress => $t->{compress} } );
 763     $remoteDir = $t->remotels( $dir->{relPath} );
 764
 765     if ( $t->{type} eq "incr" ) {
 766         $localDir  = $view->dirAttrib( $t->{incrBaseBkupNum},
 767                                        $t->{shareName}, $dir->{relPath} );
 768         %expectedFiles = map { $_ => 0 } sort keys %$localDir
 769     }
 770
 771     #
 772     # take care of each file in the directory
 773     #
 774  SCAN: foreach my $f ( @{$remoteDir} ) {
 775
 776         next SCAN if $t->ignoreFileCheck( $f, $attrib );
 777
 778         #
 779         # handle based on filetype
 780         #
 781         if ( $f->{type} eq 'f' ) {
 782             $t->handleFile( $f, $OutDir, $attrib );
 783
 784         } elsif ( $f->{type} eq 'd' ) {
 785
 786             $attribInfo = {
 787                 type  => BPC_FTYPE_DIR,
 788                 mode  => $f->{mode},
 789                 uid   => undef,           # unsupported
 790                 gid   => undef,           # unsupported
 791                 size  => $f->{size},
 792                 mtime => $f->{mtime},
 793             };
 794
 795             #print STDERR "$f->{utf8name}: ". Dumper($attribInfo);
 796
 797             if ( $t->handleDir($f, $OutDir) ) {
 798                 $attrib->set( $f->{utf8name}, $attribInfo);
 799             }
 800
 801         } elsif ( $f->{type} =~ /^l (.*)/ ) {
 802             $t->handleSymlink( $f, $OutDir, $attrib );
 803
 804         } else {
 805             #
 806             # do nothing
 807             #
 808         }
 809
 810         #
 811         # Mark file as seen in expected files hash
 812         #
 813         $expectedFiles{ $f->{utf8name} }++ if ( $t->{type} eq "incr" );
 814
 815     } # end foreach (@{$remoteDir})
 816
 817     #
 818     # If the backup type is incremental, mark the files that are not
 819     # present on the server as deleted.
 820     #
 821     if ( $t->{type} eq "incr" ) {
 822         while ( my ($f, $seen) = each %expectedFiles ) {
 823             $attrib->set( $f, { type => BPC_FTYPE_DELETED } )
 824                 unless ($seen);
 825         }
 826     }
 827
 828     #
 829     # print the directory attributes, now that the directory is done.
 830     #
 831     my $fileName = $attrib->fileName($OutDir);
 832     my $data     = $attrib->writeData();
 833
 834     $poolWrite = BackupPC::PoolWrite->new( $bpc, $fileName, length($data),
 835                                            $t->{compress} );
 836     $poolWrite->write( \$data );
 837     ( $exists, $digest, $outSize, $errs ) = $poolWrite->close();
 838
 839     #
 840     # Explicit success
 841     #
 842     return 1;
 843 }
 844
 845
 846 #
 847 # handleFile() backs up a file.
 848 #
 849 sub handleFile
 850 {
 851     my ( $t, $f, $OutDir, $attrib ) = @_;
 852
 853     my $bpc        = $t->{bpc};
 854     my $ftp        = $t->{ftp};
 855     my $view       = $t->{view};
 856     my $stats      = $t->{stats};
 857     my $newFilesFH = $t->{newFilesFH};
 858
 859     my ( $poolFile, $poolWrite, $data, $localSize );
 860     my ( $exists, $digest, $outSize, $errs );
 861     my ( $oldAttrib );
 862     local *FTP;
 863
 864     #
 865     # If this is an incremental backup and the file exists in a
 866     # previous backup unchanged, write the attribInfo for the file
 867     # accordingly.
 868     #
 869     if ( $t->{type} eq "incr" ) {
 870         return 1 if $t->incrFileExistCheck( $f, $attrib );
 871     }
 872
 873     my $attribInfo = {
 874         %$f,
 875         type  => BPC_FTYPE_FILE,
 876         uid   => undef,            # unsupported
 877         gid   => undef,            # unsupported
 878     };
 879     delete $attribInfo->{utf8name}; # unused value
 880
 881     #
 882     # If this is a full backup or the file has changed on the host,
 883     # back it up.
 884     #
 885     undef $@;
 886     eval { tie ( *FTP, 'Net::FTP::RetrHandle', $ftp, $f->{fullName} ); };
 887     if ( !*FTP || $@ ) {
 888         $t->logFileAction( "fail", $f->{utf8name}, $attribInfo );
 889         $t->{xferBadFileCnt}++;
 890         $stats->{errCnt}++;
 891         return;
 892     }
 893
 894     $poolFile    = $OutDir . "/" .  $bpc->fileNameMangle( $f->{name} );
 895     $poolWrite   = BackupPC::PoolWrite->new( $bpc, $poolFile, $f->{size},
 896                                            $t->{compress} );
 897
 898     $localSize = 0;
 899
 900     undef $@;
 901     eval {
 902         while (<FTP>) {
 903             $localSize += length($_);
 904             $poolWrite->write( \$_ );
 905         }
 906     };
 907     ( $exists, $digest, $outSize, $errs ) = $poolWrite->close();
 908     if ( !*FTP || $@ || @$errs ) {
 909
 910         $t->logFileAction( "fail", $f->{utf8name}, $attribInfo );
 911         unlink($poolFile);
 912         $t->{xferBadFileCnt}++;
 913         $stats->{errCnt} += scalar @$errs;
 914         return;
 915     }
 916
 917     #
 918     # this should never happen
 919     #
 920     if ( $localSize != $f->{size} ) {
 921         $t->logFileAction( "fail", $f->{utf8name}, $attribInfo );
 922         unlink($poolFile);
 923         $stats->{xferBadFileCnt}++;
 924         $stats->{errCnt}++;
 925         return;
 926     }
 927
 928     #
 929     # Perform logging
 930     #
 931     $attrib->set( $f->{utf8name}, $attribInfo );
 932     $t->logFileAction( $exists ? "pool" : "create",
 933                        $f->{utf8name}, $attribInfo );
 934
 935     my $relPoolFile = $bpc->fileNameEltMangle( $t->{shareName} )
 936                     . "/"
 937                     . $bpc->fileNameMangle($attribInfo->{relPath});
 938
 939     print $newFilesFH "$digest $f->{size} $relPoolFile\n" unless $exists;
 940
 941     #
 942     # Cumulate the stats
 943     #
 944     $stats->{TotalFileCnt}++;
 945     $stats->{ExistFileCnt}++;
 946     $stats->{ExistFileCompSize} += -s $poolFile;
 947     $stats->{ExistFileSize}     += $f->{size};
 948     $stats->{TotalFileSize}     += $f->{size};
 949
 950     $t->{byteCnt} += $localSize;
 951     $t->{fileCnt}++;
 952 }
 953
 954
 955 #
 956 # this function checks if the file has been modified on disk, and if
 957 # it has, returns.  Otherwise, it updates the attrib values.
 958 #
 959 sub incrFileExistCheck
 960 {
 961     my ($t, $f, $attrib) = @_;
 962
 963     my $view = $t->{view};
 964
 965     my $oldAttribInfo = $view->fileAttrib( $t->{incrBaseBkupNum},
 966                                        $t->{shareName}, "/" . $f->{relPath} );
 967
 968     ##$t->logWrite( "Old attrib:\n" . Dumper($oldAttribInfo), 1 );
 969     ##$t->logWrite( "New attrib:\n" . Dumper($f), 1 );
 970     ##$t->logWrite( sprintf("%s: mtime %d vs %d, size %d vs %d\n", $f->{fullName},
 971     ##              $oldAttribInfo->{mtime}, $f->{mtime},
 972     ##              $oldAttribInfo->{size}, $f->{size}), 1);
 973
 974     return ( $oldAttribInfo->{mtime} == $f->{mtime}
 975           && $oldAttribInfo->{size} == $f->{size} );
 976 }
 977
 978
 979 #
 980 # Generate a log file message for a completed file.  Taken from
 981 # BackupPC_tarExtract. $f should be an attrib object.
 982 #
 983 sub logFileAction
 984 {
 985     my ( $t, $action, $name, $attrib ) = @_;
 986
 987     my $owner = "$attrib->{uid}/$attrib->{gid}";
 988     my $type =
 989       ( ( "", "p", "c", "", "d", "", "b", "", "", "", "l", "", "s" ) )
 990       [ ( $attrib->{mode} & S_IFMT ) >> 12 ];
 991
 992     $name  = "."   if ( $name  eq "" );
 993     $owner = "-/-" if ( $owner eq "/" );
 994
 995     my $fileAction = sprintf(
 996         "  %-6s %1s%4o %9s %11.0f %s\n",
 997         $action, $type, $attrib->{mode} & 07777,
 998         $owner, $attrib->{size}, $attrib->{relPath}
 999     );
1000
1001     return $t->logWrite( $fileAction, 1 );
1002 }
1003
1004 1;