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     $args = $t->getFTPArgs();
 178
 179     #
 180     # Create the Net::FTP::AutoReconnect or Net::FTP object.
 181     #
 182     unless ( $t->{ftp} = ($ARCLibOK) ? Net::FTP::AutoReconnect->new(%$args)
 183                                      : Net::FTP->new(%$args) )
 184     {
 185         $t->{_errStr} = "Can't open connection to $args->{Host}";
 186         $t->{xferErrCnt}++;
 187         return;
 188     }
 189
 190     #
 191     # Log in to the ftp server and set appropriate path information.
 192     #
 193     unless ( $t->{ftp}->login( $conf->{FtpUserName}, $conf->{FtpPasswd} ) ) {
 194         $t->{_errStr} = "Can't login to $args->{Host}";
 195         $t->{xferErrCnt}++;
 196         return;
 197     }
 198
 199     unless ( $t->{ftp}->binary() ) {
 200         $t->{_errStr} = "Can't enable binary transfer mode to $args->{Host}";
 201         $t->{xferErrCnt}++;
 202         return;
 203     }
 204
 205     unless (    ( $t->{shareName} =~ m/^\.?$/ )
 206              || ( $t->{ftp}->cwd( $t->{shareName} ) ) )
 207     {
 208         $t->{_errStr} = "Can't change working directory to $t->{shareName}";
 209         $t->{xferErrCnt}++;
 210         return;
 211     }
 212
 213     unless  ( $t->{sharePath} = $t->{ftp}->pwd() ) {
 214         $t->{_errStr} = "Can't retrieve full working directory of $t->{shareName}";
 215         $t->{xferErrCnt}++;
 216         return;
 217     }
 218
 219     #
 220     # log the beginning of action based on type
 221     #
 222     if ( $t->{type} eq 'restore' ) {
 223         $logMsg = "restore started on directory $t->{shareName}";
 224
 225     } elsif ( $t->{type} eq 'full' ) {
 226         $logMsg = "full backup started on directory $t->{shareName}";
 227
 228     } elsif ( $t->{type} eq 'incr' ) {
 229
 230         $incrDate = $bpc->timeStamp( $t->{incrBaseTime} - 3600, 1 );
 231         $logMsg = "incremental backup started back to $incrDate" .
 232             " (backup #$t->{incrBaseBkupNum}) for directory" . "
 233             $t->{shareName}";
 234     }
 235
 236     #
 237     # call the recursive function based on the type of action
 238     #
 239     if ( $t->{type} eq 'restore' ) {
 240
 241         $t->restore();
 242         $logMsg = "Restore of $args->{Host} complete";
 243
 244     } elsif ( $t->{type} eq 'incr' ) {
 245
 246         $t->backup();
 247         $logMsg = "Incremental backup of $args->{Host} complete";
 248
 249     } elsif ( $t->{type} eq 'full' ) {
 250
 251         $t->backup();
 252         $logMsg = "Full backup of $args->{Host} complete";
 253     }
 254
 255     delete $t->{_errStr};
 256     return $logMsg;
 257 }
 258
 259
 260 #
 261 #
 262 #
 263 sub run
 264 {
 265     my ($t) = @_;
 266     my $stats = $t->{stats};
 267
 268     my ( $tarErrs,      $nFilesExist, $sizeExist,
 269          $sizeExistCom, $nFilesTotal, $sizeTotal );
 270
 271     #
 272     # TODO: replace the $stats array with variables at the top level,
 273     # ones returned by $getStats.  They should be identical.
 274     #
 275     $tarErrs      = 0;
 276     $nFilesExist  = $stats->{ExistFileCnt};
 277     $sizeExist    = $stats->{ExistFileSize};
 278     $sizeExistCom = $stats->{ExistFileCompSize};
 279     $nFilesTotal  = $stats->{TotalFileCnt};
 280     $sizeTotal    = $stats->{TotalFileSize};
 281
 282     if ( $t->{type} eq "restore" ) {
 283         return ( $t->{fileCnt}, $t->{byteCnt}, 0, 0 );
 284
 285     } else {
 286         return \( $tarErrs,      $nFilesExist, $sizeExist,
 287                   $sizeExistCom, $nFilesTotal, $sizeTotal );
 288     }
 289 }
 290
 291
 292 #
 293 #   usage:
 294 #     $t->restore();
 295 #
 296 # TODO: finish or scuttle this function.  It is not necessary for a
 297 # release.
 298 #
 299 sub restore
 300 {
 301     my $t = @_;
 302
 303     my $bpc = $t->{bpc};
 304     my $fileList = $t->{fileList};
 305
 306     my ($path, $fileName, $fileAttr, $fileType );
 307
 308     #print STDERR "BackupPC::Xfer::Ftp->restore()";
 309
 310     #
 311     # Prepare the view object
 312     #
 313     $t->{view} = BackupPC::View->new( $bpc, $t->{bkupSrcHost},
 314                                       $t->{backups} );
 315     my $view = $t->{view};
 316
 317   SCAN: foreach my $f ( @$fileList ) {
 318
 319         #print STDERR "restoring $f...\n";
 320
 321         $f =~ /(.*)\/([^\/]*)/;
 322         $path     = $1;
 323         $fileName = $2;
 324
 325         $view->dirCache($path);
 326
 327         $fileAttr = $view->fileAttrib($fileName);
 328         $fileType = fileType2Text( $fileAttr->{type} );
 329
 330         if ( $fileType eq "dir") {
 331             $t->restoreDir($fileName, $fileAttr);
 332
 333         } elsif ( $fileType eq "file" ) {
 334             $t->restoreFile($fileName, $fileAttr);
 335
 336         } elsif ( $fileType eq "symlink" ) {
 337             #
 338             # ignore
 339             #
 340         } else {
 341             #
 342             # ignore
 343             #
 344         }
 345     } # end SCAN
 346 }
 347
 348
 349 sub restoreDir
 350 {
 351     my ( $t, $dirName, $dirAttr ) = @_;
 352
 353     my $ftp    = $t->{ftp};
 354     my $bpc    = $t->{bpc};
 355     my $conf   = $t->{conf};
 356     my $view   = $t->{view};
 357     my $TopDir = $bpc->TopDir();
 358
 359     my $path    = "$dirAttr->{relPath}/$dirName";
 360     my $dirList = $view->dirAttrib( -1, $t->{shareName}, $path );
 361
 362     my ( $fileName, $fileAttr, $fileType );
 363
 364     #print STDERR "BackupPC::Xfer::Ftp->restore($dirName)\n";
 365
 366     #
 367     # Create the remote directory
 368     #
 369     unless ( $ftp->mkdir( $path, 1 ) ) {
 370
 371         $t->logFileAction( "fail", $dirName, $dirAttr );
 372         return;
 373     }
 374
 375  SCAN: while ( ($fileName, $fileAttr ) = each %$dirList ) {
 376
 377         $fileType = fileType2Text( $fileAttr->{type} );
 378
 379         if ( $fileType eq "dir" ) {
 380             if ( $t->restoreDir( $fileName, $fileAttr ) ) {
 381                 $t->logWrite( "restored: $path/$fileName\n", 5 );
 382             } else {
 383                 $t->logWrite( "restore failed: $path/$fileName\n", 3 );
 384             }
 385
 386         } elsif ( $fileType eq "file" ) {
 387             $t->restoreFile( $fileName, $fileAttr );
 388
 389         } elsif ( $fileType eq "hardlink" ) {
 390             #
 391             # Hardlinks cannot be restored.  however, if we have the
 392             # target file in the pool, we can restore that.
 393             #
 394             $t->restoreFile( $fileName, $fileAttr );
 395
 396             next SCAN;
 397
 398         } elsif ( $fileType eq "symlink" ) {
 399             #
 400             # Symlinks cannot be restored
 401             #
 402             next SCAN;
 403
 404         } else {
 405             #
 406             # Ignore all other types (devices, doors, etc)
 407             #
 408             next SCAN;
 409         }
 410     }
 411 }
 412
 413
 414 sub restoreFile
 415 {
 416     my ($t, $fileName, $fileAttr ) = @_;
 417
 418     my $conf = $t->{conf};
 419     my $ftp  = $t->{ftp};
 420
 421     my $poolFile = $fileAttr->{fullPath};
 422     my $fileDest = ( $conf->{ClientCharset} ne "" )
 423                  ? from_to( "$fileAttr->{relPath}/$fileName",
 424                             "utf8", $conf->{ClientCharset} )
 425                  : "$fileAttr->{relPath}/$fileName";
 426
 427     #print STDERR "BackupPC::Xfer::Ftp->restoreFile($fileName)\n";
 428
 429     #
 430     # Note: is logging necessary here?
 431     #
 432     if ( $ftp->put( $poolFile, $fileDest ) ) {
 433         $t->logFileAction("restore", $fileName, $fileAttr);
 434
 435     } else {
 436         $t->logFileAction("fail", $fileName, $fileAttr);
 437     }
 438 }
 439
 440
 441 #
 442 #  usage:
 443 #   $t->backup($path);
 444 #
 445 # $t->backup() is a recursive function that takes a path as an
 446 # argument, and performs a backup on that folder consistent with the
 447 # configuration parameters.  $path is considered rooted at
 448 # $t->{shareName}, so no $ftp->cwd() command is necessary.
 449 #
 450 sub backup
 451 {
 452     my ($t) =  @_;
 453
 454     my $ftp    = $t->{ftp};
 455     my $bpc    = $t->{bpc};
 456     my $conf   = $t->{conf};
 457     my $TopDir = $bpc->TopDir();
 458     my $OutDir = "$TopDir/pc/$t->{client}/new/"
 459       . $bpc->fileNameEltMangle( $t->{shareName} );
 460
 461     #
 462     # Prepare the view object
 463     #
 464     $t->{view} = BackupPC::View->new( $bpc, $t->{client}, $t->{backups} );
 465
 466     #
 467     # Prepare backup folder
 468     #
 469     unless ( mkpath( $OutDir, 0, 0755 ) ) {
 470         $t->{_errStr} = "can't create OutDir: $OutDir";
 471         $t->{xferErrCnt}++;
 472         return;
 473     }
 474
 475     #
 476     # determine the filetype of the shareName and back it up
 477     # appropriately.  For now, assume that $t->{shareName} is a
 478     # directory.
 479     #
 480     my $f = {
 481               relPath  => "",
 482               fullName => $t->{shareName},
 483             };
 484
 485     if ( $t->handleDir( $f, $OutDir ) ) {
 486
 487         $t->{xferOK} = 1;
 488         return 1;
 489
 490     } else {
 491
 492         $t->{xferBadShareCnt}++;
 493         return;
 494     }
 495 }
 496
 497
 498 ####################################################################################
 499 # FTP-specific functions
 500 ####################################################################################
 501
 502
 503 #
 504 # This is an encapulation of the logic necessary to grab the arguments
 505 # from %Conf and throw it in a hash pointer to be passed to the
 506 # Net::FTP object.
 507 #
 508 sub getFTPArgs
 509 {
 510     my ($t)  = @_;
 511     my $bpc  = $t->{bpc};
 512     my $conf = $t->{conf};
 513
 514     #
 515     # accepted default key => value pairs to Net::FTP
 516     #
 517     my $args = {
 518                  Host         => undef,
 519                  Firewall     => undef,          # not used
 520                  FirewallType => undef,          # not used
 521                  BlockSize    => 10240,
 522                  Port         => 21,
 523                  Timeout      => 120,
 524                  Debug        => 0,              # do not touch
 525                  Passive      => 1,              # do not touch
 526                  Hash         => undef,          # do not touch
 527                  LocalAddr    => "localhost",    # do not touch
 528                };
 529
 530     #
 531     # This is mostly to fool makeDist
 532     #
 533     exists( $conf->{ClientNameAlias} ) && exists( $conf->{FtpBlockSize} ) &&
 534     exists( $conf->{FtpPort} )         && exists( $conf->{FtpTimeout} )
 535         or die "Configuration variables for FTP not present in config.pl";
 536
 537     #
 538     # map of options from %Conf in the config.pl scripts to options
 539     # the Net::FTP::AutoReconnect object.
 540     #
 541     my $argMap = {
 542                    "Host"      => "ClientNameAlias",
 543                    "BlockSize" => "FtpBlockSize",
 544                    "Port"      => "FtpPort",
 545                    "Timeout"   => "FtpTimeout",
 546                  };
 547
 548     foreach my $key ( keys(%$args) ) {
 549         $args->{$key} = $conf->{ $argMap->{$key} } || $args->{$key};
 550     }
 551
 552     #
 553     # Fix for $args->{Host} since it can be in more than one location.
 554     # Note the precedence here, this may need to be fixed.  Order of
 555     # precedence:
 556     #   $conf->{ClientNameAlias}
 557     #   $t->{hostIP}
 558     #   $t->{host}
 559     #
 560     $args->{Host} ||= $t->{hostIP};
 561     $args->{Host} ||= $t->{host};
 562
 563     #
 564     # return the reference to the hash of items
 565     #
 566     return $args;
 567 }
 568
 569
 570 #
 571 #   usage:
 572 #     $dirList = $t->remotels($path);
 573 #
 574 # remotels() returns a reference to a list of hash references that
 575 # describe the contents of each file in the directory of the path
 576 # specified.
 577 #
 578 # In the future, I would like to make this function return objects in
 579 # Attrib format.  That would be very optimal, and I could probably
 580 # release the code to CPAN.
 581 #
 582 sub remotels
 583 {
 584     my ( $t, $path ) = @_;
 585
 586     my $ftp  = $t->{ftp};
 587     my $bpc  = $t->{bpc};
 588     my $conf = $t->{conf};
 589
 590     my ( $dirContents, $remoteDir, $f );
 591
 592     unless ( $dirContents = ($path =~ /^\.?$/ ) ? $ftp->dir() :
 593                                                   $ftp->dir("$path/") )
 594     {
 595         $t->{xferErrCnt}++;
 596         return "can't retrieve remote directory contents of $path";
 597     }
 598
 599     foreach my $info ( @{parse_dir($dirContents)} ) {
 600
 601         $f = {
 602                name   => $info->[0],
 603                type   => $info->[1],
 604                size   => $info->[2],
 605                mtime  => $info->[3],
 606                mode   => $info->[4],
 607              };
 608
 609         #
 610         # convert & store utf8 version of filename
 611         #
 612         $f->{utf8name} = $f->{name};
 613         from_to( $f->{utf8name}, $conf->{ClientCharset}, "utf8" );
 614
 615         #
 616         # construct the full name
 617         #
 618         $f->{fullName} = "$t->{sharePath}/$path/$f->{name}";
 619         $f->{fullName} =~ s/\/+/\//g;
 620
 621         $f->{relPath} = ($path eq "") ? $f->{name} : "$path/$f->{name}";
 622         $f->{relPath} =~ s/\/+/\//g;
 623
 624         push( @$remoteDir, $f );
 625     }
 626
 627     return $remoteDir;
 628 }
 629
 630
 631 #
 632 # ignoreFileCheck() looks at the attributes of the arguments and the
 633 # backup types, and determines if the file should be skipped in this
 634 # backup.
 635 #
 636 sub ignoreFileCheck
 637 {
 638     my ( $t, $f, $attrib ) = @_;
 639
 640     #
 641     # case for ignoring the files '.' & '..'
 642     #
 643     if ( $f->{name} =~ /^\.\.?$/ ) {
 644         return 1;
 645     }
 646
 647     #
 648     # Check the include/exclude lists.  the function returns true if
 649     # the file should be backed up, so return the opposite.
 650     #
 651     return ( !$t->checkIncludeExclude( $f->{fullName} ) );
 652 }
 653
 654
 655 #
 656 # handleSymlink() backs up a symlink.
 657 #
 658 sub handleSymlink
 659 {
 660     my ( $t, $f, $OutDir, $attrib ) = @_;
 661
 662     my $conf = $t->{conf};
 663     my $ftp  = $t->{ftp};
 664     my ( $target, $targetDesc );
 665
 666     my $attribInfo = {
 667         type  => BPC_FTYPE_SYMLINK,
 668         mode  => $f->{mode},
 669         uid   => undef,            # unsupported
 670         gid   => undef,            # unsupported
 671         size  => 0,
 672         mtime => $f->{mtime},
 673     };
 674
 675     #
 676     # If we are following symlinks, back them up as the type of file
 677     # they point to. Otherwise, backup the symlink.
 678     #
 679     if ( $conf->{FtpFollowSymlinks} ) {
 680
 681         #
 682         # handle nested symlinks by recurring on the target until a
 683         # file or directory is found.
 684         #
 685         $f->{type} =~ /^l (.*)/;
 686         $target = $1;
 687
 688         if ( $targetDesc = $ftp->dir("$target/") ) {
 689             $t->handleSymDir( $f, $OutDir, $attrib, $targetDesc );
 690
 691         } elsif ( $targetDesc = $ftp->dir($target) ) {
 692             if ( $targetDesc->[4] eq 'file' ) {
 693                 $t->handleSymFile( $f, $OutDir, $attrib );
 694
 695             } elsif ( $targetDesc->[4] =~ /l (.*)/) {
 696
 697                 $t->logFileAction("fail", $f->{utf8name}, $attribInfo);
 698                 return;
 699             }
 700         } else {
 701
 702             $t->("fail", $f);
 703             return;
 704         }
 705
 706     } else {
 707
 708         #
 709         # If we are not following symlinks, record them normally.
 710         #
 711         $attrib->set( $f->{utf8name}, $attribInfo );
 712         $t->logFileAction("create", $f->{utf8name}, $attribInfo);
 713     }
 714     return 1;
 715 }
 716
 717
 718 sub handleSymDir
 719 {
 720     my ($t, $fSym, $OutDir, $attrib, $targetDesc) = @_;
 721
 722     return 1;
 723  }
 724
 725
 726 sub handleSymFile
 727 {
 728     my ( $t, $fSym, $OutDir, $attrib, $targetDesc ) = @_;
 729
 730     my $bpc  = $t->{bpc};
 731     my $conf = $t->{conf};
 732
 733     my $f = {
 734               name  => $fSym->{name},
 735               type  => $targetDesc->[1],
 736               size  => $targetDesc->[2],
 737               mtime => $targetDesc->[3],
 738               mode  => $targetDesc->[4]
 739             };
 740
 741     $f->{utf8name} = $fSym->{name};
 742     from_to( $f->{utf8name}, $conf->{ClientCharset}, "utf8" );
 743
 744     $f->{relPath} = $fSym->{relPath};
 745
 746     $f->{fullName} = "$t->{shareName}/$fSym->{relPath}/$fSym->{name}";
 747     $f->{fullName} =~ s/\/+/\//g;
 748
 749     #
 750     # since FTP servers follow symlinks, we can jsut do this:
 751     #
 752     return $t->handleFile( $f, $OutDir, $attrib );
 753 }
 754
 755
 756 #
 757 # handleDir() backs up a directory, and initiates a backup of its
 758 # contents.
 759 #
 760 sub handleDir
 761 {
 762     my ( $t, $dir, $OutDir ) = @_;
 763
 764     my $ftp   = $t->{ftp};
 765     my $bpc   = $t->{bpc};
 766     my $conf  = $t->{conf};
 767     my $view  = $t->{view};
 768     my $stats = $t->{stats};
 769
 770     my ( $exists, $digest, $outSize, $errs );
 771     my ( $poolWrite, $poolFile, $attribInfo );
 772     my ( $localDir, $remoteDir, $attrib, %expectedFiles );
 773
 774     if ( exists($dir->{utf8name})) {
 775         $OutDir .= "/" . $bpc->fileNameMangle( $dir->{utf8name} );
 776     }
 777
 778     unless ( -d $OutDir ) {
 779
 780         mkpath( $OutDir, 0, 0755 );
 781         $t->logFileAction( "create", $dir->{utf8name}, $dir );
 782     }
 783
 784     $attrib    = BackupPC::Attrib->new( { compress => $t->{Compress} } );
 785     $remoteDir = $t->remotels( $dir->{relPath} );
 786
 787     if ( $t->{type} eq "incr" ) {
 788         $localDir  = $view->dirAttrib( $t->{incrBaseBkupNum},
 789                                        $t->{shareName}, $dir->{relPath} );
 790         %expectedFiles = map { $_ => 0 } sort keys %$localDir
 791     }
 792
 793     #
 794     # take care of each file in the directory
 795     #
 796  SCAN: foreach my $f ( @{$remoteDir} ) {
 797
 798         next SCAN if $t->ignoreFileCheck( $f, $attrib );
 799
 800         #
 801         # handle based on filetype
 802         #
 803         if ( $f->{type} eq 'f' ) {
 804             $t->handleFile( $f, $OutDir, $attrib );
 805
 806         } elsif ( $f->{type} eq 'd' ) {
 807
 808             $attribInfo = {
 809                 type  => BPC_FTYPE_DIR,
 810                 mode  => $f->{mode},
 811                 uid   => undef,           # unsupported
 812                 gid   => undef,           # unsupported
 813                 size  => $f->{size},
 814                 mtime => $f->{mtime},
 815             };
 816
 817             #print STDERR "$f->{utf8name}: ". Dumper($attribInfo);
 818
 819             if ( $t->handleDir($f, $OutDir) ) {
 820                 $attrib->set( $f->{utf8name}, $attribInfo);
 821             }
 822
 823         } elsif ( $f->{type} =~ /^l (.*)/ ) {
 824             $t->handleSymlink( $f, $OutDir, $attrib );
 825
 826         } else {
 827             #
 828             # do nothing
 829             #
 830         }
 831
 832         #
 833         # Mark file as seen in expected files hash
 834         #
 835         $expectedFiles{ $f->{utf8name} }++ if ( $t->{type} eq "incr" );
 836
 837     } # end foreach (@{$remoteDir})
 838
 839     #
 840     # If the backup type is incremental, mark the files that are not
 841     # present on the server as deleted.
 842     #
 843     if ( $t->{type} eq "incr" ) {
 844         while ( my ($f, $seen) = each %expectedFiles ) {
 845             $attrib->set( $f, { type => BPC_FTYPE_DELETED } )
 846                 unless ($seen);
 847         }
 848     }
 849
 850     #
 851     # print the directory attributes, now that the directory is done.
 852     #
 853     my $fileName = $attrib->fileName($OutDir);
 854     my $data     = $attrib->writeData();
 855
 856     $poolWrite = BackupPC::PoolWrite->new( $bpc, $fileName, length($data),
 857                                            $t->{Compress} );
 858     $poolWrite->write( \$data );
 859     ( $exists, $digest, $outSize, $errs ) = $poolWrite->close();
 860
 861     #
 862     # Explicit success
 863     #
 864     return 1;
 865 }
 866
 867
 868 #
 869 # handleFile() backs up a file.
 870 #
 871 sub handleFile
 872 {
 873     my ( $t, $f, $OutDir, $attrib ) = @_;
 874
 875     my $bpc        = $t->{bpc};
 876     my $ftp        = $t->{ftp};
 877     my $view       = $t->{view};
 878     my $stats      = $t->{stats};
 879     my $newFilesFH = $t->{newFilesFH};
 880
 881     my ( $poolFile, $poolWrite, $data, $localSize );
 882     my ( $exists, $digest, $outSize, $errs );
 883     my ( $oldAttrib );
 884     local *FTP;
 885
 886     #
 887     # If this is an incremental backup and the file exists in a
 888     # previous backup unchanged, write the attribInfo for the file
 889     # accordingly.
 890     #
 891     if ( $t->{type} eq "incr" ) {
 892         return 1 if $t->incrFileExistCheck( $f, $attrib );
 893     }
 894
 895     my $attribInfo = {
 896                        type  => BPC_FTYPE_FILE,
 897                        mode  => $f->{mode},
 898                        uid   => undef,            # unsupported
 899                        gid   => undef,            # unsupported
 900                        size  => $f->{size},
 901                        mtime => $f->{mtime},
 902                      };
 903
 904     #
 905     # If this is a full backup or the file has changed on the host,
 906     # back it up.
 907     #
 908     unless ( tie( *FTP, 'Net::FTP::RetrHandle', $ftp, $f->{fullName} ) ) {
 909
 910         $t->handleFileAction( "fail", $attribInfo );
 911         $t->{xferBadFileCnt}++;
 912         $stats->{errCnt}++;
 913         return;
 914     }
 915
 916     $poolFile  = $OutDir . "/" . $bpc->fileNameMangle( $f->{name} );
 917     $poolWrite = BackupPC::PoolWrite->new( $bpc, $poolFile, $f->{size},
 918                                            $bpc->{xfer}{compress} );
 919
 920     $localSize = 0;
 921     while (<FTP>) {
 922
 923         $localSize += length($_);
 924         $poolWrite->write( \$_ );
 925     }
 926     ( $exists, $digest, $outSize, $errs ) = $poolWrite->close();
 927
 928     #
 929     # calculate the file statistics
 930     #
 931     if (@$errs) {
 932
 933         $t->logFileAction( "fail", $f->{utf8name}, $attribInfo );
 934         unlink($poolFile);
 935         $t->{xferBadFileCnt}++;
 936         $t->{errCnt} += scalar(@$errs);
 937         return;
 938     }
 939
 940     #
 941     # this should never happen
 942     #
 943     if ( $localSize != $f->{size} ) {
 944
 945         $t->logFileAction( "fail", $f->{utf8name}, $attribInfo );
 946         unklink($poolFile);
 947         $stats->{xferBadFileCnt}++;
 948         $stats->{errCnt}++;
 949         return;
 950     }
 951
 952     #
 953     # Perform logging
 954     #
 955     $attrib->set( $f->{utf8name}, $attribInfo );
 956     $t->logFileAction( $exists ? "pool" : "create", $f->{utf8name}, $attribInfo );
 957     print $newFilesFH "$digest $f->{size} $poolFile\n" unless $exists;
 958
 959     #
 960     # Cumulate the stats
 961     #
 962     $stats->{TotalFileCnt}++;
 963     $stats->{ExistFileCnt}++;
 964     $stats->{ExistFileCompSize} += -s $poolFile;
 965     $stats->{ExistFileSize}     += $f->{size};
 966     $stats->{TotalFileSize}     += $f->{size};
 967
 968     $t->{byteCnt} += $localSize;
 969     $t->{fileCnt}++;
 970 }
 971
 972
 973 #
 974 # this function checks if the file has been modified on disk, and if
 975 # it has, returns.  Otherwise, it updates the attrib values.
 976 #
 977 sub incrFileExistCheck
 978 {
 979     my ($t, $f, $attrib) = @_;
 980
 981     my $view = $t->{view};
 982
 983     my $oldAttribInfo = $view->fileAttrib( $t->{incrBaseBkupNum},
 984                                        $t->{shareName}, $f->{relPath} );
 985
 986     #print STDERR "*" x 50 . "\n";
 987     #print STDERR "Old data:\n" . Dumper($oldAttribInfo);
 988     #print STDERR "New data:\n" . Dumper($f);
 989     #print STDERR "$f->{fullName}: $oldAttribInfo->{mtime} ?= $f->{mtime}, $oldAttribInfo->{size} ?= $f->{size}\n";
 990
 991     return ( $oldAttribInfo->{mtime} == $f->{mtime}
 992           && $oldAttribInfo->{size} == $f->{size} );
 993 }
 994
 995
 996 #
 997 # Generate a log file message for a completed file.  Taken from
 998 # BackupPC_tarExtract. $f should be an attrib object.
 999 #
1000 sub logFileAction
1001 {
1002     my ( $t, $action, $name, $attrib ) = @_;
1003
1004     my $owner = "$attrib->{uid}/$attrib->{gid}";
1005     my $type =
1006       ( ( "", "p", "c", "", "d", "", "b", "", "", "", "l", "", "s" ) )
1007       [ ( $attrib->{mode} & S_IFMT ) >> 12 ];
1008
1009     $name  = "."   if ( $name  eq "" );
1010     $owner = "-/-" if ( $owner eq "/" );
1011
1012     my $fileAction = sprintf( "  %-6s %1s%4o %9s %11.0f %s\n",
1013                               $action, $type, $attrib->{mode} & 07777,
1014                               $owner, $attrib->{size}, $name );
1015
1016     return $t->logWrite( $fileAction, 1 );
1017 }
1018
1019 1;