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