#
#========================================================================
#
-# Unreleased, planned release in 3.2 (or 3.1.1)
+# Version 3.2.0, released 31 Jul 2010.
#
# See http://backuppc.sourceforge.net.
#
#========================================================================
-
package BackupPC::Xfer::Ftp;
use strict;
# Convert the encoding type of the names if at all possible
#
from_to( $args->{shareName}, "utf8", $conf->{ClientCharset} )
- if ( $conf->{ClientCharset} ne "" );
+ if ( $conf->{ClientCharset} ne "" );
#
# Collect FTP configuration arguments and translate them for
# passing to the FTP module.
#
- $args = $t->getFTPArgs();
+ unless ( $args = $t->getFTPArgs() ) {
+ return;
+ }
#
# Create the Net::FTP::AutoReconnect or Net::FTP object.
#
- unless ( $t->{ftp} = ($ARCLibOK) ? Net::FTP::AutoReconnect->new(%$args)
- : Net::FTP->new(%$args) )
- {
- $t->{_errStr} = "Can't open connection to $args->{Host}";
+ undef $@;
+ eval {
+ $t->{ftp} = ($ARCLibOK) ? Net::FTP::AutoReconnect->new(%$args)
+ : Net::FTP->new(%$args);
+ };
+ if ($@) {
+ $t->{_errStr} = "Can't open connection to $args->{Host}: $!";
$t->{xferErrCnt}++;
return;
}
+ $t->logWrite("Connected to $args->{Host}\n", 2);
#
# Log in to the ftp server and set appropriate path information.
#
- unless ( $t->{ftp}->login( $conf->{FtpUserName}, $conf->{FtpPasswd} ) ) {
- $t->{_errStr} = "Can't login to $args->{Host}";
+ undef $@;
+ eval { $t->{ftp}->login( $conf->{FtpUserName}, $conf->{FtpPasswd} ); };
+ if ( $@ ) {
+ $t->{_errStr} = "Can't login to $args->{Host}: $!";
$t->{xferErrCnt}++;
return;
}
+ $t->logWrite("Login successful to $conf->{FtpUserName}\@$args->{Host}\n", 2);
- unless ( $t->{ftp}->binary() ) {
- $t->{_errStr} = "Can't enable binary transfer mode to $args->{Host}";
+ undef $@;
+ eval { $t->{ftp}->binary(); };
+ if ($@) {
+ $t->{_errStr} =
+ "Can't enable binary transfer mode to $args->{Host}: $!";
$t->{xferErrCnt}++;
return;
}
+ $t->logWrite("Binary command successful\n", 2);
- unless ( ( $t->{shareName} =~ m/^\.?$/ )
- || ( $t->{ftp}->cwd( $t->{shareName} ) ) )
- {
- $t->{_errStr} = "Can't change working directory to $t->{shareName}";
+ undef $@;
+ eval { $t->{shareName} =~ m/^\.?$/ || $t->{ftp}->cwd( $t->{shareName} ); };
+ if ($@) {
+ $t->{_errStr} =
+ "Can't change working directory to $t->{shareName}: $!";
$t->{xferErrCnt}++;
return;
}
+ $t->logWrite("Set cwd to $t->{shareName}\n", 2);
- unless ( $t->{sharePath} = $t->{ftp}->pwd() ) {
- $t->{_errStr} = "Can't retrieve full working directory of $t->{shareName}";
+ undef $@;
+ eval { $t->{sharePath} = $t->{ftp}->pwd(); };
+ if ($@) {
+ $t->{_errStr} =
+ "Can't retrieve full working directory of $t->{shareName}: $!";
$t->{xferErrCnt}++;
return;
}
+ $t->logWrite("Pwd returned as $t->{sharePath}\n", 2);
#
# log the beginning of action based on type
#
if ( $t->{type} eq 'restore' ) {
- $logMsg = "restore started on directory $t->{shareName}";
+ $logMsg = "ftp restore for host $t->{host} started on directory "
+ . "$t->{shareName}\n";
} elsif ( $t->{type} eq 'full' ) {
- $logMsg = "full backup started on directory $t->{shareName}";
+ $logMsg = "ftp full backup for host $t->{host} started on directory "
+ . "$t->{shareName}\n";
} elsif ( $t->{type} eq 'incr' ) {
-
$incrDate = $bpc->timeStamp( $t->{incrBaseTime} - 3600, 1 );
- $logMsg = "incremental backup started back to $incrDate" .
- " (backup #$t->{incrBaseBkupNum}) for directory" . "
- $t->{shareName}";
+ $logMsg = "ftp incremental backup for $t->{host} started back to "
+ . "$incrDate (backup #$t->{incrBaseBkupNum}) for directory "
+ . "$t->{shareName}\n";
}
+ $t->logWrite($logMsg, 1);
#
# call the recursive function based on the type of action
if ( $t->{type} eq 'restore' ) {
$t->restore();
- $logMsg = "Restore of $args->{Host} complete";
+ $logMsg = "Restore of $t->{host} "
+ . ($t->{xferOK} ? "complete" : "failed");
} elsif ( $t->{type} eq 'incr' ) {
$t->backup();
- $logMsg = "Incremental backup of $args->{Host} complete";
+ $logMsg = "Incremental backup of $t->{host} "
+ . ($t->{xferOK} ? "complete" : "failed");
} elsif ( $t->{type} eq 'full' ) {
$t->backup();
- $logMsg = "Full backup of $args->{Host} complete";
+ $logMsg = "Full backup of $t->{host} "
+ . ($t->{xferOK} ? "complete" : "failed");
}
delete $t->{_errStr};
return ( $t->{fileCnt}, $t->{byteCnt}, 0, 0 );
} else {
- return \( $tarErrs, $nFilesExist, $sizeExist,
- $sizeExistCom, $nFilesTotal, $sizeTotal );
+ return ( $tarErrs, $nFilesExist, $sizeExist,
+ $sizeExistCom, $nFilesTotal, $sizeTotal );
}
}
#
# Create the remote directory
#
- unless ( $ftp->mkdir( $path, 1 ) ) {
-
+ undef $@;
+ eval { $ftp->mkdir( $path, 1 ); };
+ if ($@) {
$t->logFileAction( "fail", $dirName, $dirAttr );
return;
}
#print STDERR "BackupPC::Xfer::Ftp->restoreFile($fileName)\n";
- #
- # Note: is logging necessary here?
- #
- if ( $ftp->put( $poolFile, $fileDest ) ) {
- $t->logFileAction("restore", $fileName, $fileAttr);
-
- } else {
- $t->logFileAction("fail", $fileName, $fileAttr);
+ undef $@;
+ eval {
+ if ( $ftp->put( $poolFile, $fileDest ) ) {
+ $t->logFileAction( "restore", $fileName, $fileAttr );
+ } else {
+ $t->logFileAction( "fail", $fileName, $fileAttr );
+ }
+ };
+ if ($@) {
+ $t->logFileAction( "fail", $fileName, $fileAttr );
}
}
#
# Prepare backup folder
#
- unless ( mkpath( $OutDir, 0, 0755 ) ) {
+ unless ( eval { mkpath( $OutDir, 0, 0755 ); } ) {
$t->{_errStr} = "can't create OutDir: $OutDir";
$t->{xferErrCnt}++;
return;
}
+ $t->logWrite("Created output directory $OutDir\n", 3);
#
# determine the filetype of the shareName and back it up
sub getFTPArgs
{
my ($t) = @_;
- my $bpc = $t->{bpc};
my $conf = $t->{conf};
- #
- # accepted default key => value pairs to Net::FTP
- #
- my $args = {
- Host => undef,
- Firewall => undef, # not used
- FirewallType => undef, # not used
- BlockSize => 10240,
- Port => 21,
- Timeout => 120,
- Debug => 0, # do not touch
- Passive => 1, # do not touch
- Hash => undef, # do not touch
- LocalAddr => "localhost", # do not touch
- };
-
- #
- # This is mostly to fool makeDist
- #
- exists( $conf->{ClientNameAlias} ) && exists( $conf->{FtpBlockSize} ) &&
- exists( $conf->{FtpPort} ) && exists( $conf->{FtpTimeout} )
- or die "Configuration variables for FTP not present in config.pl";
-
- #
- # map of options from %Conf in the config.pl scripts to options
- # the Net::FTP::AutoReconnect object.
- #
- my $argMap = {
- "Host" => "ClientNameAlias",
- "BlockSize" => "FtpBlockSize",
- "Port" => "FtpPort",
- "Timeout" => "FtpTimeout",
- };
-
- foreach my $key ( keys(%$args) ) {
- $args->{$key} = $conf->{ $argMap->{$key} } || $args->{$key};
- }
-
- #
- # Fix for $args->{Host} since it can be in more than one location.
- # Note the precedence here, this may need to be fixed. Order of
- # precedence:
- # $conf->{ClientNameAlias}
- # $t->{hostIP}
- # $t->{host}
- #
- $args->{Host} ||= $t->{hostIP};
- $args->{Host} ||= $t->{host};
-
- #
- # return the reference to the hash of items
- #
- return $args;
+ return {
+ Host => $conf->{ClientNameAlias}
+ || $t->{hostIP}
+ || $t->{host},
+ Firewall => undef, # not used
+ FirewallType => undef, # not used
+ BlockSize => $conf->{FtpBlockSize} || 10240,
+ Port => $conf->{FtpPort} || 21,
+ Timeout => defined($conf->{FtpTimeout}) ? $conf->{FtpTimeout} : 120,
+ Debug => $t->{logLevel} >= 10 ? 1 : 0,
+ Passive => defined($conf->{FtpPassive}) ? $conf->{FtpPassive} : 1,
+ Hash => undef, # do not touch
+ };
}
-
#
# usage:
# $dirList = $t->remotels($path);
my ( $dirContents, $remoteDir, $f );
- unless ( $dirContents = ($path =~ /^\.?$/ ) ? $ftp->dir() :
- $ftp->dir("$path/") )
- {
+ $remoteDir = [];
+ undef $@;
+ $t->logWrite("remotels: about to list $path\n", 4);
+ eval {
+ $dirContents = ( $path =~ /^\.?$/ ) ? $ftp->dir()
+ : $ftp->dir("$path/");
+ };
+ if ($@) {
$t->{xferErrCnt}++;
- return "can't retrieve remote directory contents of $path";
+ $t->logWrite("remotels: can't retrieve remote directory contents of $path: $!\n", 1);
+ return "can't retrieve remote directory contents of $path: $!";
+ }
+ if ( $t->{logLevel} >= 4 ) {
+ my $str = join("\n", @$dirContents);
+ $t->logWrite("remotels: got dir() result:\n$str\n", 4);
}
foreach my $info ( @{parse_dir($dirContents)} ) {
$f = {
- name => $info->[0],
- type => $info->[1],
- size => $info->[2],
- mtime => $info->[3],
- mode => $info->[4],
- };
-
- #
- # convert & store utf8 version of filename
- #
+ name => $info->[0],
+ type => $info->[1],
+ size => $info->[2],
+ mtime => $info->[3],
+ mode => $info->[4],
+ };
+
+ $t->logWrite("remotels: adding name $f->{name}, type $f->{type}, size $f->{size}, mode $f->{mode}\n", 4);
+
$f->{utf8name} = $f->{name};
- from_to( $f->{utf8name}, $conf->{ClientCharset}, "utf8" );
+ from_to( $f->{utf8name}, $conf->{ClientCharset}, "utf8" )
+ if ( $conf->{ClientCharset} ne "" );
- #
- # construct the full name
- #
$f->{fullName} = "$t->{sharePath}/$path/$f->{name}";
$f->{fullName} =~ s/\/+/\//g;
push( @$remoteDir, $f );
}
-
return $remoteDir;
}
{
my ( $t, $f, $attrib ) = @_;
- #
- # case for ignoring the files '.' & '..'
- #
if ( $f->{name} =~ /^\.\.?$/ ) {
return 1;
}
- #
- # Check the include/exclude lists. the function returns true if
- # the file should be backed up, so return the opposite.
- #
return ( !$t->checkIncludeExclude( $f->{fullName} ) );
}
$f->{type} =~ /^l (.*)/;
$target = $1;
- if ( $targetDesc = $ftp->dir("$target/") ) {
- $t->handleSymDir( $f, $OutDir, $attrib, $targetDesc );
-
- } elsif ( $targetDesc = $ftp->dir($target) ) {
- if ( $targetDesc->[4] eq 'file' ) {
- $t->handleSymFile( $f, $OutDir, $attrib );
-
- } elsif ( $targetDesc->[4] =~ /l (.*)/) {
-
- $t->logFileAction("fail", $f->{utf8name}, $attribInfo);
+ undef $@;
+ eval {
+ if ( $targetDesc = $ftp->dir("$target/") ) {
+ $t->handleSymDir( $f, $OutDir, $attrib, $targetDesc );
+
+ } elsif ( $targetDesc = $ftp->dir($target) ) {
+ if ( $targetDesc->[4] eq 'file' ) {
+ $t->handleSymFile( $f, $OutDir, $attrib );
+
+ } elsif ( $targetDesc->[4] =~ /l (.*)/ ) {
+ $t->logFileAction( "fail", $f->{utf8name}, $attribInfo );
+ return;
+ }
+ } else {
+ $t->( "fail", $f );
return;
}
- } else {
-
- $t->("fail", $f);
+ };
+ if ($@) {
+ $t->logFileAction( "fail", $f->{utf8name}, $attribInfo );
return;
}
} else {
-
#
# If we are not following symlinks, record them normally.
#
my $conf = $t->{conf};
my $f = {
- name => $fSym->{name},
- type => $targetDesc->[1],
- size => $targetDesc->[2],
- mtime => $targetDesc->[3],
- mode => $targetDesc->[4]
- };
+ name => $fSym->{name},
+ type => $targetDesc->[1],
+ size => $targetDesc->[2],
+ mtime => $targetDesc->[3],
+ mode => $targetDesc->[4]
+ };
$f->{utf8name} = $fSym->{name};
- from_to( $f->{utf8name}, $conf->{ClientCharset}, "utf8" );
-
- $f->{relPath} = $fSym->{relPath};
+ from_to( $f->{utf8name}, $conf->{ClientCharset}, "utf8" )
+ if ( $conf->{ClientCharset} ne "" );
+ $f->{relPath} = $fSym->{relPath};
$f->{fullName} = "$t->{shareName}/$fSym->{relPath}/$fSym->{name}";
$f->{fullName} =~ s/\/+/\//g;
#
- # since FTP servers follow symlinks, we can jsut do this:
+ # since FTP servers follow symlinks, we can just do this:
#
return $t->handleFile( $f, $OutDir, $attrib );
}
unless ( -d $OutDir ) {
- mkpath( $OutDir, 0, 0755 );
- $t->logFileAction( "create", $dir->{utf8name}, $dir );
+ eval { mkpath( $OutDir, 0, 0755 ) };
+ if ( $@ ) {
+ $t->logFileAction( "fail", $dir->{utf8name}, $dir );
+ return;
+ } else {
+ $t->logFileAction( "create", $dir->{utf8name}, $dir );
+ }
}
- $attrib = BackupPC::Attrib->new( { compress => $t->{Compress} } );
+ $t->logWrite("handleDir: dir->relPath = $dir->{relPath}, OutDir = $OutDir\n", 4);
+
+ $attrib = BackupPC::Attrib->new( { compress => $t->{compress} } );
$remoteDir = $t->remotels( $dir->{relPath} );
+ if ( ref($remoteDir) ne 'ARRAY' ) {
+ $t->logWrite("handleDir failed: $remoteDir\n", 1);
+ $t->logFileAction( "fail", $dir->{utf8name}, $dir );
+ return;
+ }
+
if ( $t->{type} eq "incr" ) {
$localDir = $view->dirAttrib( $t->{incrBaseBkupNum},
$t->{shareName}, $dir->{relPath} );
my $data = $attrib->writeData();
$poolWrite = BackupPC::PoolWrite->new( $bpc, $fileName, length($data),
- $t->{Compress} );
+ $t->{compress} );
$poolWrite->write( \$data );
( $exists, $digest, $outSize, $errs ) = $poolWrite->close();
}
my $attribInfo = {
- type => BPC_FTYPE_FILE,
- mode => $f->{mode},
- uid => undef, # unsupported
- gid => undef, # unsupported
- size => $f->{size},
- mtime => $f->{mtime},
- };
+ %$f,
+ type => BPC_FTYPE_FILE,
+ uid => undef, # unsupported
+ gid => undef, # unsupported
+ };
+ delete $attribInfo->{utf8name}; # unused value
#
# If this is a full backup or the file has changed on the host,
# back it up.
#
- unless ( tie( *FTP, 'Net::FTP::RetrHandle', $ftp, $f->{fullName} ) ) {
-
- $t->handleFileAction( "fail", $attribInfo );
+ undef $@;
+ eval { tie ( *FTP, 'Net::FTP::RetrHandle', $ftp, $f->{fullName} ); };
+ if ( !*FTP || $@ ) {
+ $t->logFileAction( "fail", $f->{utf8name}, $attribInfo );
$t->{xferBadFileCnt}++;
$stats->{errCnt}++;
return;
}
- $poolFile = $OutDir . "/" . $bpc->fileNameMangle( $f->{name} );
- $poolWrite = BackupPC::PoolWrite->new( $bpc, $poolFile, $f->{size},
- $bpc->{xfer}{compress} );
-
+ $poolFile = $OutDir . "/" . $bpc->fileNameMangle( $f->{name} );
+ $poolWrite = BackupPC::PoolWrite->new( $bpc, $poolFile, $f->{size},
+ $t->{compress} );
$localSize = 0;
- while (<FTP>) {
- $localSize += length($_);
- $poolWrite->write( \$_ );
- }
+ undef $@;
+ eval {
+ while (<FTP>) {
+ $localSize += length($_);
+ $poolWrite->write( \$_ );
+ }
+ };
( $exists, $digest, $outSize, $errs ) = $poolWrite->close();
-
- #
- # calculate the file statistics
- #
- if (@$errs) {
+ if ( !*FTP || $@ || @$errs ) {
$t->logFileAction( "fail", $f->{utf8name}, $attribInfo );
+ $t->logWrite("Unlinking($poolFile) because of error on close\n", 3);
unlink($poolFile);
$t->{xferBadFileCnt}++;
- $t->{errCnt} += scalar(@$errs);
+ $stats->{errCnt} += scalar @$errs;
return;
}
# this should never happen
#
if ( $localSize != $f->{size} ) {
-
$t->logFileAction( "fail", $f->{utf8name}, $attribInfo );
- unklink($poolFile);
+ $t->logWrite("Unlinking($poolFile) because of size mismatch ($localSize vs $f->{size})\n", 3);
+ unlink($poolFile);
$stats->{xferBadFileCnt}++;
$stats->{errCnt}++;
return;
# Perform logging
#
$attrib->set( $f->{utf8name}, $attribInfo );
- $t->logFileAction( $exists ? "pool" : "create", $f->{utf8name}, $attribInfo );
- print $newFilesFH "$digest $f->{size} $poolFile\n" unless $exists;
+ $t->logFileAction( $exists ? "pool" : "create",
+ $f->{utf8name}, $attribInfo );
+
+ my $relPoolFile = $bpc->fileNameEltMangle( $t->{shareName} )
+ . "/"
+ . $bpc->fileNameMangle($attribInfo->{relPath});
+
+ print $newFilesFH "$digest $f->{size} $relPoolFile\n" unless $exists;
#
# Cumulate the stats
my $view = $t->{view};
my $oldAttribInfo = $view->fileAttrib( $t->{incrBaseBkupNum},
- $t->{shareName}, $f->{relPath} );
+ $t->{shareName}, "/" . $f->{relPath} );
- #print STDERR "*" x 50 . "\n";
- #print STDERR "Old data:\n" . Dumper($oldAttribInfo);
- #print STDERR "New data:\n" . Dumper($f);
- #print STDERR "$f->{fullName}: $oldAttribInfo->{mtime} ?= $f->{mtime}, $oldAttribInfo->{size} ?= $f->{size}\n";
+ ##$t->logWrite( "Old attrib:\n" . Dumper($oldAttribInfo), 1 );
+ ##$t->logWrite( "New attrib:\n" . Dumper($f), 1 );
+ ##$t->logWrite( sprintf("%s: mtime %d vs %d, size %d vs %d\n", $f->{fullName},
+ ## $oldAttribInfo->{mtime}, $f->{mtime},
+ ## $oldAttribInfo->{size}, $f->{size}), 1);
return ( $oldAttribInfo->{mtime} == $f->{mtime}
&& $oldAttribInfo->{size} == $f->{size} );
$name = "." if ( $name eq "" );
$owner = "-/-" if ( $owner eq "/" );
- my $fileAction = sprintf( " %-6s %1s%4o %9s %11.0f %s\n",
- $action, $type, $attrib->{mode} & 07777,
- $owner, $attrib->{size}, $name );
+ my $fileAction = sprintf(
+ " %-6s %1s%4o %9s %11.0f %s\n",
+ $action, $type, $attrib->{mode} & 07777,
+ $owner, $attrib->{size}, $attrib->{relPath}
+ );
return $t->logWrite( $fileAction, 1 );
}
projects / BackupPC.git / blobdiff