1 #============================================================= -*-perl-*-
3 # BackupPC::Xfer::Ftp package
7 # This library defines a BackupPC::Xfer::Ftp class for transferring
8 # data from a FTP client.
11 # Paul Mantz <pcmantz@zmanda.com>
14 # (C) 2008, Zmanda Inc.
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.
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.
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
32 #========================================================================
34 # Version 3.2.0, released 31 Jul 2010.
36 # See http://backuppc.sourceforge.net.
38 #========================================================================
40 package BackupPC::Xfer::Ftp;
45 use BackupPC::Attrib qw(:all);
47 use Encode qw/from_to encode/;
48 use File::Listing qw/parse_dir/;
51 use base qw(BackupPC::Xfer::Protocol);
53 use vars qw( $FTPLibOK $FTPLibErr $ARCLibOK );
55 use constant S_IFMT => 0170000;
63 # clear eval error variable
65 my @FTPLibs = qw( Net::FTP Net::FTP::RetrHandle );
67 foreach my $module ( @FTPLibs ) {
74 $FTPLibErr = "module $module doesn't exist: $@";
79 eval "use Net::FTP::AutoReconnect;";
80 $ARCLibOK = (defined($@)) ? 1 : 0;
83 ##############################################################################
85 ##############################################################################
90 # $xfer = new BackupPC::Xfer::Ftp( $bpc, %args );
92 # new() is your default class constructor. it also calls the
93 # constructor for Protocol as well.
97 my ( $class, $bpc, $args ) = @_;
100 my $t = BackupPC::Xfer::Protocol->new(
110 ExistFileCompSize => 0,
114 return bless( $t, $class );
118 ##############################################################################
120 ##############################################################################
126 # start() is called to configure and initiate a dump or restore,
127 # depending on the configured options.
134 my $conf = $t->{conf};
136 my ( @fileList, $logMsg, $incrDate, $args, $dumpText );
139 # initialize the statistics returned by getStats()
141 foreach ( qw/byteCnt fileCnt xferErrCnt xferBadShareCnt
142 xferBadFileCnt xferOK hostAbort hostError
149 # Net::FTP::RetrHandle is necessary.
152 $t->{_errStr} = "Error: FTP transfer selected but module"
153 . " Net::FTP::RetrHandle is not installed.";
159 # standardize the file include/exclude settings if necessary
161 unless ( $t->{type} eq 'restore' ) {
162 $bpc->backupFileConfFix( $conf, "FtpShareName" );
163 $t->loadInclExclRegexps("FtpShareName");
167 # Convert the encoding type of the names if at all possible
169 from_to( $args->{shareName}, "utf8", $conf->{ClientCharset} )
170 if ( $conf->{ClientCharset} ne "" );
173 # Collect FTP configuration arguments and translate them for
174 # passing to the FTP module.
176 unless ( $args = $t->getFTPArgs() ) {
181 # Create the Net::FTP::AutoReconnect or Net::FTP object.
185 $t->{ftp} = ($ARCLibOK) ? Net::FTP::AutoReconnect->new(%$args)
186 : Net::FTP->new(%$args);
189 $t->{_errStr} = "Can't open connection to $args->{Host}: $!";
193 $t->logWrite("Connected to $args->{Host}\n", 2);
196 # Log in to the ftp server and set appropriate path information.
199 eval { $t->{ftp}->login( $conf->{FtpUserName}, $conf->{FtpPasswd} ); };
201 $t->{_errStr} = "Can't login to $args->{Host}: $!";
205 $t->logWrite("Login successful to $conf->{FtpUserName}\@$args->{Host}\n", 2);
208 eval { $t->{ftp}->binary(); };
211 "Can't enable binary transfer mode to $args->{Host}: $!";
215 $t->logWrite("Binary command successful\n", 2);
218 eval { $t->{shareName} =~ m/^\.?$/ || $t->{ftp}->cwd( $t->{shareName} ); };
221 "Can't change working directory to $t->{shareName}: $!";
225 $t->logWrite("Set cwd to $t->{shareName}\n", 2);
228 eval { $t->{sharePath} = $t->{ftp}->pwd(); };
231 "Can't retrieve full working directory of $t->{shareName}: $!";
235 $t->logWrite("Pwd returned as $t->{sharePath}\n", 2);
238 # log the beginning of action based on type
240 if ( $t->{type} eq 'restore' ) {
241 $logMsg = "ftp restore for host $t->{host} started on directory "
242 . "$t->{shareName}\n";
244 } elsif ( $t->{type} eq 'full' ) {
245 $logMsg = "ftp full backup for host $t->{host} started on directory "
246 . "$t->{shareName}\n";
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";
254 $t->logWrite($logMsg, 1);
257 # call the recursive function based on the type of action
259 if ( $t->{type} eq 'restore' ) {
262 $logMsg = "Restore of $t->{host} "
263 . ($t->{xferOK} ? "complete" : "failed");
265 } elsif ( $t->{type} eq 'incr' ) {
268 $logMsg = "Incremental backup of $t->{host} "
269 . ($t->{xferOK} ? "complete" : "failed");
271 } elsif ( $t->{type} eq 'full' ) {
274 $logMsg = "Full backup of $t->{host} "
275 . ($t->{xferOK} ? "complete" : "failed");
278 delete $t->{_errStr};
289 my $stats = $t->{stats};
291 my ( $tarErrs, $nFilesExist, $sizeExist,
292 $sizeExistCom, $nFilesTotal, $sizeTotal );
295 # TODO: replace the $stats array with variables at the top level,
296 # ones returned by $getStats. They should be identical.
299 $nFilesExist = $stats->{ExistFileCnt};
300 $sizeExist = $stats->{ExistFileSize};
301 $sizeExistCom = $stats->{ExistFileCompSize};
302 $nFilesTotal = $stats->{TotalFileCnt};
303 $sizeTotal = $stats->{TotalFileSize};
305 if ( $t->{type} eq "restore" ) {
306 return ( $t->{fileCnt}, $t->{byteCnt}, 0, 0 );
309 return ( $tarErrs, $nFilesExist, $sizeExist,
310 $sizeExistCom, $nFilesTotal, $sizeTotal );
319 # TODO: finish or scuttle this function. It is not necessary for a
327 my $fileList = $t->{fileList};
329 my ($path, $fileName, $fileAttr, $fileType );
331 #print STDERR "BackupPC::Xfer::Ftp->restore()";
334 # Prepare the view object
336 $t->{view} = BackupPC::View->new( $bpc, $t->{bkupSrcHost},
338 my $view = $t->{view};
340 SCAN: foreach my $f ( @$fileList ) {
342 #print STDERR "restoring $f...\n";
344 $f =~ /(.*)\/([^\/]*)/;
348 $view->dirCache($path);
350 $fileAttr = $view->fileAttrib($fileName);
351 $fileType = fileType2Text( $fileAttr->{type} );
353 if ( $fileType eq "dir") {
354 $t->restoreDir($fileName, $fileAttr);
356 } elsif ( $fileType eq "file" ) {
357 $t->restoreFile($fileName, $fileAttr);
359 } elsif ( $fileType eq "symlink" ) {
374 my ( $t, $dirName, $dirAttr ) = @_;
378 my $conf = $t->{conf};
379 my $view = $t->{view};
380 my $TopDir = $bpc->TopDir();
382 my $path = "$dirAttr->{relPath}/$dirName";
383 my $dirList = $view->dirAttrib( -1, $t->{shareName}, $path );
385 my ( $fileName, $fileAttr, $fileType );
387 #print STDERR "BackupPC::Xfer::Ftp->restore($dirName)\n";
390 # Create the remote directory
393 eval { $ftp->mkdir( $path, 1 ); };
395 $t->logFileAction( "fail", $dirName, $dirAttr );
399 SCAN: while ( ($fileName, $fileAttr ) = each %$dirList ) {
401 $fileType = fileType2Text( $fileAttr->{type} );
403 if ( $fileType eq "dir" ) {
404 if ( $t->restoreDir( $fileName, $fileAttr ) ) {
405 $t->logWrite( "restored: $path/$fileName\n", 5 );
407 $t->logWrite( "restore failed: $path/$fileName\n", 3 );
410 } elsif ( $fileType eq "file" ) {
411 $t->restoreFile( $fileName, $fileAttr );
413 } elsif ( $fileType eq "hardlink" ) {
415 # Hardlinks cannot be restored. however, if we have the
416 # target file in the pool, we can restore that.
418 $t->restoreFile( $fileName, $fileAttr );
422 } elsif ( $fileType eq "symlink" ) {
424 # Symlinks cannot be restored
430 # Ignore all other types (devices, doors, etc)
440 my ($t, $fileName, $fileAttr ) = @_;
442 my $conf = $t->{conf};
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";
451 #print STDERR "BackupPC::Xfer::Ftp->restoreFile($fileName)\n";
455 if ( $ftp->put( $poolFile, $fileDest ) ) {
456 $t->logFileAction( "restore", $fileName, $fileAttr );
458 $t->logFileAction( "fail", $fileName, $fileAttr );
462 $t->logFileAction( "fail", $fileName, $fileAttr );
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.
482 my $conf = $t->{conf};
483 my $TopDir = $bpc->TopDir();
484 my $OutDir = "$TopDir/pc/$t->{client}/new/"
485 . $bpc->fileNameEltMangle( $t->{shareName} );
488 # Prepare the view object
490 $t->{view} = BackupPC::View->new( $bpc, $t->{client}, $t->{backups} );
493 # Prepare backup folder
495 unless ( eval { mkpath( $OutDir, 0, 0755 ); } ) {
496 $t->{_errStr} = "can't create OutDir: $OutDir";
500 $t->logWrite("Created output directory $OutDir\n", 3);
503 # determine the filetype of the shareName and back it up
504 # appropriately. For now, assume that $t->{shareName} is a
509 fullName => $t->{shareName},
512 if ( $t->handleDir( $f, $OutDir ) ) {
519 $t->{xferBadShareCnt}++;
525 ####################################################################################
526 # FTP-specific functions
527 ####################################################################################
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
538 my $conf = $t->{conf};
541 Host => $conf->{ClientNameAlias}
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
557 # $dirList = $t->remotels($path);
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
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.
569 my ( $t, $path ) = @_;
573 my $conf = $t->{conf};
575 my ( $dirContents, $remoteDir, $f );
579 $t->logWrite("remotels: about to list $path\n", 4);
581 $dirContents = ( $path =~ /^\.?$/ ) ? $ftp->dir()
582 : $ftp->dir("$path/");
586 $t->logWrite("remotels: can't retrieve remote directory contents of $path: $!\n", 1);
587 return "can't retrieve remote directory contents of $path: $!";
589 if ( $t->{logLevel} >= 4 ) {
590 my $str = join("\n", @$dirContents);
591 $t->logWrite("remotels: got dir() result:\n$str\n", 4);
594 foreach my $info ( @{parse_dir($dirContents)} ) {
604 $t->logWrite("remotels: adding name $f->{name}, type $f->{type}, size $f->{size}, mode $f->{mode}\n", 4);
606 $f->{utf8name} = $f->{name};
607 from_to( $f->{utf8name}, $conf->{ClientCharset}, "utf8" )
608 if ( $conf->{ClientCharset} ne "" );
610 $f->{fullName} = "$t->{sharePath}/$path/$f->{name}";
611 $f->{fullName} =~ s/\/+/\//g;
613 $f->{relPath} = ($path eq "") ? $f->{name} : "$path/$f->{name}";
614 $f->{relPath} =~ s/\/+/\//g;
616 push( @$remoteDir, $f );
623 # ignoreFileCheck() looks at the attributes of the arguments and the
624 # backup types, and determines if the file should be skipped in this
629 my ( $t, $f, $attrib ) = @_;
631 if ( $f->{name} =~ /^\.\.?$/ ) {
635 return ( !$t->checkIncludeExclude( $f->{fullName} ) );
640 # handleSymlink() backs up a symlink.
644 my ( $t, $f, $OutDir, $attrib ) = @_;
646 my $conf = $t->{conf};
648 my ( $target, $targetDesc );
651 type => BPC_FTYPE_SYMLINK,
653 uid => undef, # unsupported
654 gid => undef, # unsupported
656 mtime => $f->{mtime},
660 # If we are following symlinks, back them up as the type of file
661 # they point to. Otherwise, backup the symlink.
663 if ( $conf->{FtpFollowSymlinks} ) {
666 # handle nested symlinks by recurring on the target until a
667 # file or directory is found.
669 $f->{type} =~ /^l (.*)/;
674 if ( $targetDesc = $ftp->dir("$target/") ) {
675 $t->handleSymDir( $f, $OutDir, $attrib, $targetDesc );
677 } elsif ( $targetDesc = $ftp->dir($target) ) {
678 if ( $targetDesc->[4] eq 'file' ) {
679 $t->handleSymFile( $f, $OutDir, $attrib );
681 } elsif ( $targetDesc->[4] =~ /l (.*)/ ) {
682 $t->logFileAction( "fail", $f->{utf8name}, $attribInfo );
691 $t->logFileAction( "fail", $f->{utf8name}, $attribInfo );
697 # If we are not following symlinks, record them normally.
699 $attrib->set( $f->{utf8name}, $attribInfo );
700 $t->logFileAction("create", $f->{utf8name}, $attribInfo);
708 my ($t, $fSym, $OutDir, $attrib, $targetDesc) = @_;
716 my ( $t, $fSym, $OutDir, $attrib, $targetDesc ) = @_;
719 my $conf = $t->{conf};
722 name => $fSym->{name},
723 type => $targetDesc->[1],
724 size => $targetDesc->[2],
725 mtime => $targetDesc->[3],
726 mode => $targetDesc->[4]
729 $f->{utf8name} = $fSym->{name};
730 from_to( $f->{utf8name}, $conf->{ClientCharset}, "utf8" )
731 if ( $conf->{ClientCharset} ne "" );
733 $f->{relPath} = $fSym->{relPath};
734 $f->{fullName} = "$t->{shareName}/$fSym->{relPath}/$fSym->{name}";
735 $f->{fullName} =~ s/\/+/\//g;
738 # since FTP servers follow symlinks, we can just do this:
740 return $t->handleFile( $f, $OutDir, $attrib );
745 # handleDir() backs up a directory, and initiates a backup of its
750 my ( $t, $dir, $OutDir ) = @_;
754 my $conf = $t->{conf};
755 my $view = $t->{view};
756 my $stats = $t->{stats};
758 my ( $exists, $digest, $outSize, $errs );
759 my ( $poolWrite, $poolFile, $attribInfo );
760 my ( $localDir, $remoteDir, $attrib, %expectedFiles );
762 if ( exists($dir->{utf8name})) {
763 $OutDir .= "/" . $bpc->fileNameMangle( $dir->{utf8name} );
766 unless ( -d $OutDir ) {
768 eval { mkpath( $OutDir, 0, 0755 ) };
770 $t->logFileAction( "fail", $dir->{utf8name}, $dir );
773 $t->logFileAction( "create", $dir->{utf8name}, $dir );
777 $t->logWrite("handleDir: dir->relPath = $dir->{relPath}, OutDir = $OutDir\n", 4);
779 $attrib = BackupPC::Attrib->new( { compress => $t->{compress} } );
780 $remoteDir = $t->remotels( $dir->{relPath} );
782 if ( ref($remoteDir) ne 'ARRAY' ) {
783 $t->logWrite("handleDir failed: $remoteDir\n", 1);
784 $t->logFileAction( "fail", $dir->{utf8name}, $dir );
788 if ( $t->{type} eq "incr" ) {
789 $localDir = $view->dirAttrib( $t->{incrBaseBkupNum},
790 $t->{shareName}, $dir->{relPath} );
791 %expectedFiles = map { $_ => 0 } sort keys %$localDir
795 # take care of each file in the directory
797 SCAN: foreach my $f ( @{$remoteDir} ) {
799 next SCAN if $t->ignoreFileCheck( $f, $attrib );
802 # handle based on filetype
804 if ( $f->{type} eq 'f' ) {
805 $t->handleFile( $f, $OutDir, $attrib );
807 } elsif ( $f->{type} eq 'd' ) {
810 type => BPC_FTYPE_DIR,
812 uid => undef, # unsupported
813 gid => undef, # unsupported
815 mtime => $f->{mtime},
818 #print STDERR "$f->{utf8name}: ". Dumper($attribInfo);
820 if ( $t->handleDir($f, $OutDir) ) {
821 $attrib->set( $f->{utf8name}, $attribInfo);
824 } elsif ( $f->{type} =~ /^l (.*)/ ) {
825 $t->handleSymlink( $f, $OutDir, $attrib );
834 # Mark file as seen in expected files hash
836 $expectedFiles{ $f->{utf8name} }++ if ( $t->{type} eq "incr" );
838 } # end foreach (@{$remoteDir})
841 # If the backup type is incremental, mark the files that are not
842 # present on the server as deleted.
844 if ( $t->{type} eq "incr" ) {
845 while ( my ($f, $seen) = each %expectedFiles ) {
846 $attrib->set( $f, { type => BPC_FTYPE_DELETED } )
852 # print the directory attributes, now that the directory is done.
854 my $fileName = $attrib->fileName($OutDir);
855 my $data = $attrib->writeData();
857 $poolWrite = BackupPC::PoolWrite->new( $bpc, $fileName, length($data),
859 $poolWrite->write( \$data );
860 ( $exists, $digest, $outSize, $errs ) = $poolWrite->close();
870 # handleFile() backs up a file.
874 my ( $t, $f, $OutDir, $attrib ) = @_;
878 my $view = $t->{view};
879 my $stats = $t->{stats};
880 my $newFilesFH = $t->{newFilesFH};
882 my ( $poolFile, $poolWrite, $data, $localSize );
883 my ( $exists, $digest, $outSize, $errs );
888 # If this is an incremental backup and the file exists in a
889 # previous backup unchanged, write the attribInfo for the file
892 if ( $t->{type} eq "incr" ) {
893 return 1 if $t->incrFileExistCheck( $f, $attrib );
898 type => BPC_FTYPE_FILE,
899 uid => undef, # unsupported
900 gid => undef, # unsupported
902 delete $attribInfo->{utf8name}; # unused value
905 # If this is a full backup or the file has changed on the host,
909 eval { tie ( *FTP, 'Net::FTP::RetrHandle', $ftp, $f->{fullName} ); };
911 $t->logFileAction( "fail", $f->{utf8name}, $attribInfo );
912 $t->{xferBadFileCnt}++;
917 $poolFile = $OutDir . "/" . $bpc->fileNameMangle( $f->{name} );
918 $poolWrite = BackupPC::PoolWrite->new( $bpc, $poolFile, $f->{size},
925 $localSize += length($_);
926 $poolWrite->write( \$_ );
929 ( $exists, $digest, $outSize, $errs ) = $poolWrite->close();
930 if ( !*FTP || $@ || @$errs ) {
932 $t->logFileAction( "fail", $f->{utf8name}, $attribInfo );
933 $t->logWrite("Unlinking($poolFile) because of error on close\n", 3);
935 $t->{xferBadFileCnt}++;
936 $stats->{errCnt} += scalar @$errs;
941 # this should never happen
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);
947 $stats->{xferBadFileCnt}++;
955 $attrib->set( $f->{utf8name}, $attribInfo );
956 $t->logFileAction( $exists ? "pool" : "create",
957 $f->{utf8name}, $attribInfo );
959 my $relPoolFile = $bpc->fileNameEltMangle( $t->{shareName} )
961 . $bpc->fileNameMangle($attribInfo->{relPath});
963 print $newFilesFH "$digest $f->{size} $relPoolFile\n" unless $exists;
968 $stats->{TotalFileCnt}++;
969 $stats->{ExistFileCnt}++;
970 $stats->{ExistFileCompSize} += -s $poolFile;
971 $stats->{ExistFileSize} += $f->{size};
972 $stats->{TotalFileSize} += $f->{size};
974 $t->{byteCnt} += $localSize;
980 # this function checks if the file has been modified on disk, and if
981 # it has, returns. Otherwise, it updates the attrib values.
983 sub incrFileExistCheck
985 my ($t, $f, $attrib) = @_;
987 my $view = $t->{view};
989 my $oldAttribInfo = $view->fileAttrib( $t->{incrBaseBkupNum},
990 $t->{shareName}, "/" . $f->{relPath} );
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);
998 return ( $oldAttribInfo->{mtime} == $f->{mtime}
999 && $oldAttribInfo->{size} == $f->{size} );
1004 # Generate a log file message for a completed file. Taken from
1005 # BackupPC_tarExtract. $f should be an attrib object.
1009 my ( $t, $action, $name, $attrib ) = @_;
1011 my $owner = "$attrib->{uid}/$attrib->{gid}";
1013 ( ( "", "p", "c", "", "d", "", "b", "", "", "", "l", "", "s" ) )
1014 [ ( $attrib->{mode} & S_IFMT ) >> 12 ];
1016 $name = "." if ( $name eq "" );
1017 $owner = "-/-" if ( $owner eq "/" );
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}
1025 return $t->logWrite( $fileAction, 1 );