"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "lib/BackupPC/Xfer/Ftp.pm" between
BackupPC-4.3.2.tar.gz and BackupPC-4.4.0.tar.gz

About: BackupPC is a high-performance, enterprise-grade system for backing up Linux and WinXX PCs and laptops to a server’s disk (http/cgi user interface).

Ftp.pm  (BackupPC-4.3.2)	:	Ftp.pm  (BackupPC-4.4.0)
skipping to change at line 31		skipping to change at line 31
# This program is distributed in the hope that it will be useful,		# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of		# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the		# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.		# GNU General Public License for more details.
#		#
# You should have received a copy of the GNU General Public License		# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.		# along with this program. If not, see <http://www.gnu.org/licenses/>.
#		#
#========================================================================		#========================================================================
#		#
# Version 4.3.2, released 17 Feb 2020.		# Version 4.4.0, released 20 Jun 2020.
#		#
# See http://backuppc.sourceforge.net.		# See http://backuppc.sourceforge.net.
#		#
#========================================================================		#========================================================================
package BackupPC::Xfer::Ftp;		package BackupPC::Xfer::Ftp;
use strict;		use strict;
use BackupPC::Lib;		use BackupPC::Lib;
skipping to change at line 71		skipping to change at line 71
# clear eval error variable		# clear eval error variable
#		#
my @FTPLibs = qw( Net::FTP Net::FTP::RetrHandle );		my @FTPLibs = qw( Net::FTP Net::FTP::RetrHandle );
foreach my $module ( @FTPLibs ) {		foreach my $module ( @FTPLibs ) {
undef $@;		undef $@;
eval "use $module;";		eval "use $module;";
if ( $@ ) {		if ( $@ ) {
$FTPLibOK = 0;		$FTPLibOK = 0;
$FTPLibErr = "module $module doesn't exist: $@";		$FTPLibErr = "module $module doesn't exist: $@";
last;		last;
}		}
}		}
eval "use Net::FTP::AutoReconnect;";		eval "use Net::FTP::AutoReconnect;";
$ARCLibOK = (defined($@)) ? 1 : 0;		$ARCLibOK = (defined($@)) ? 1 : 0;
#		#
# TODO		# TODO
#		#
$ARCLibOK = 0;		$ARCLibOK = 0;
};		}
##############################################################################		##############################################################################
# Constructor		# Constructor
##############################################################################		##############################################################################
#		#
# usage:		# usage:
# $xfer = new BackupPC::Xfer::Ftp( $bpc, %args );		# $xfer = new BackupPC::Xfer::Ftp( $bpc, %args );
#		#
# new() is your default class constructor. it also calls the		# new() is your default class constructor. it also calls the
# constructor for Protocol as well.		# constructor for Protocol as well.
#		#
sub new		sub new
{		{
my ( $class, $bpc, $args ) = @_;		my($class, $bpc, $args) = @_;
$args ||= {};		$args ||= {};
my $t = BackupPC::Xfer::Protocol->new(		my $t = BackupPC::Xfer::Protocol->new(
$bpc,		$bpc,
{		{
ftp => undef,		ftp => undef,
stats => {		stats => {
errorCnt => 0,		errorCnt => 0,
TotalFileCnt => 0,		TotalFileCnt => 0,
TotalFileSize => 0,		TotalFileSize => 0,
ExistFileCnt => 0,		ExistFileCnt => 0,
ExistFileSize => 0,		ExistFileSize => 0,
ExistFileCompSize => 0,		ExistFileCompSize => 0,
},		},
%$args,		%$args,
} );		}
return bless( $t, $class );		);
		return bless($t, $class);
}		}
##############################################################################		##############################################################################
# Methods		# Methods
##############################################################################		##############################################################################
#		#
# usage:		# usage:
# $xfer->start();		# $xfer->start();
#		#
# start() is called to configure and initiate a dump or restore,		# start() is called to configure and initiate a dump or restore,
# depending on the configured options.		# depending on the configured options.
#		#
sub start		sub start
{		{
my($t) = @_;		my($t) = @_;
my $bpc = $t->{bpc};		my $bpc = $t->{bpc};
my $conf = $t->{conf};		my $conf = $t->{conf};
my $TopDir = $bpc->TopDir();		my $TopDir = $bpc->TopDir();
my ( @fileList, $logMsg, $args, $dumpText );		my(@fileList, $logMsg, $args, $dumpText);
#		#
# initialize the statistics returned by getStats()		# initialize the statistics returned by getStats()
#		#
foreach ( qw/byteCnt fileCnt xferErrCnt xferBadShareCnt		foreach (
xferBadFileCnt xferOK hostAbort hostError		qw/byteCnt fileCnt xferErrCnt xferBadShareCnt
lastOutputLine/ )		xferBadFileCnt xferOK hostAbort hostError
{		lastOutputLine/
		) {
$t->{$_} = 0;		$t->{$_} = 0;
}		}
#		#
# Net::FTP::RetrHandle is necessary.		# Net::FTP::RetrHandle is necessary.
#		#
if ( !$FTPLibOK ) {		if ( !$FTPLibOK ) {
$t->{_errStr} = "Error: FTP transfer selected but module"		$t->{_errStr} = "Error: FTP transfer selected but module Net::FTP::RetrH
. " Net::FTP::RetrHandle is not installed.";		andle is not installed.";
$t->{xferErrCnt}++;		$t->{xferErrCnt}++;
return;		return;
}		}
#		#
# standardize the file include/exclude settings if necessary		# standardize the file include/exclude settings if necessary
#		#
unless ( $t->{type} eq 'restore' ) {		unless ( $t->{type} eq 'restore' ) {
$bpc->backupFileConfFix( $conf, "FtpShareName" );		$bpc->backupFileConfFix($conf, "FtpShareName");
$t->loadInclExclRegexps("FtpShareName");		$t->loadInclExclRegexps("FtpShareName");
}		}
#		#
# Convert the encoding type of the names if at all possible		# Convert the encoding type of the names if at all possible
#		#
$t->{shareNamePath} = $t->shareName2Path($t->{shareName});		$t->{shareNamePath} = $t->shareName2Path($t->{shareName});
from_to( $args->{shareNamePath}, "utf8", $conf->{ClientCharset} )		from_to($args->{shareNamePath}, "utf8", $conf->{ClientCharset})
if ( $conf->{ClientCharset} ne "" );		if ( $conf->{ClientCharset} ne "" );
#		#
# Collect FTP configuration arguments and translate them for		# Collect FTP configuration arguments and translate them for
# passing to the FTP module.		# passing to the FTP module.
#		#
unless ( $args = $t->getFTPArgs() ) {		unless ( $args = $t->getFTPArgs() ) {
return;		return;
}		}
#		#
# Create the Net::FTP::AutoReconnect or Net::FTP object.		# Create the Net::FTP::AutoReconnect or Net::FTP object.
#		#
undef $@;		undef $@;
eval {		eval { $t->{ftp} = ($ARCLibOK) ? Net::FTP::AutoReconnect->new(%$args) : Net:
$t->{ftp} = ($ARCLibOK) ? Net::FTP::AutoReconnect->new(%$args)		:FTP->new(%$args); };
: Net::FTP->new(%$args);
};
if ( $@ || !defined($t->{ftp}) ) {		if ( $@ || !defined($t->{ftp}) ) {
$t->{_errStr} = "Can't open ftp connection to $args->{Host}: $!";		$t->{_errStr} = "Can't open ftp connection to $args->{Host}: $!";
$t->{xferErrCnt}++;		$t->{xferErrCnt}++;
return;		return;
}		}
$t->logWrite("Connected to $args->{Host}\n", 2);		$t->logWrite("Connected to $args->{Host}\n", 2);
#		#
# Log in to the ftp server and set appropriate path information.		# Log in to the ftp server and set appropriate path information.
#		#
undef $@;		undef $@;
my $ret;		my $ret;
eval { $ret = $t->{ftp}->login( $conf->{FtpUserName}, $conf->{FtpPasswd} ); };		eval { $ret = $t->{ftp}->login($conf->{FtpUserName}, $conf->{FtpPasswd}); };
if ( !$ret ) {		if ( !$ret ) {
$t->{_errStr} = "Can't ftp login to $args->{Host} (user = $conf->{FtpUse rName}), $@";		$t->{_errStr} = "Can't ftp login to $args->{Host} (user = $conf->{FtpUse rName}), $@";
$t->{xferErrCnt}++;		$t->{xferErrCnt}++;
return;		return;
}		}
$t->logWrite("Login successful to $conf->{FtpUserName}\@$args->{Host}\n", 2) ;		$t->logWrite("Login successful to $conf->{FtpUserName}\@$args->{Host}\n", 2) ;
eval { $ret = $t->{ftp}->binary(); };		eval { $ret = $t->{ftp}->binary(); };
if ( !$ret ) {		if ( !$ret ) {
$t->{_errStr} =		$t->{_errStr} =
"Can't enable ftp binary transfer mode to $args->{Host}: " . $t->{ftp} ->message();		"Can't enable ftp binary transfer mode to $args->{Host}: " . $t->{ftp} ->message();
$t->{xferErrCnt}++;		$t->{xferErrCnt}++;
return;		return;
}		}
$t->logWrite("Binary command successful\n", 2);		$t->logWrite("Binary command successful\n", 2);
eval { $ret = $t->{ftp}->cwd( $t->{shareNamePath} ); };		eval { $ret = $t->{ftp}->cwd($t->{shareNamePath}); };
if ( !$ret ) {		if ( !$ret ) {
$t->{_errStr} =		$t->{_errStr} =
"Can't change working directory to $t->{shareNamePath}: " . $t->{ftp }->message();		"Can't change working directory to $t->{shareNamePath}: " . $t->{ftp}- >message();
$t->{xferErrCnt}++;		$t->{xferErrCnt}++;
return;		return;
}		}
$t->logWrite("Set cwd to $t->{shareNamePath}\n", 2);		$t->logWrite("Set cwd to $t->{shareNamePath}\n", 2);
#		#
# log the beginning of action based on type		# log the beginning of action based on type
#		#
if ( $t->{type} eq 'restore' ) {		if ( $t->{type} eq 'restore' ) {
$logMsg = "ftp restore for host $t->{host} started on directory "		$logMsg = "ftp restore for host $t->{host} started on directory $t->{sha
. "$t->{shareName}";		reName}";
} elsif ( $t->{type} eq 'full' ) {		} elsif ( $t->{type} eq 'full' ) {
$logMsg = "ftp full backup for host $t->{host} started on directory "		$logMsg = "ftp full backup for host $t->{host} started on directory $t->
. "$t->{shareName}";		{shareName}";
} elsif ( $t->{type} eq 'incr' ) {		} elsif ( $t->{type} eq 'incr' ) {
$logMsg = "ftp incremental backup for $t->{host} started for directory "		$logMsg = "ftp incremental backup for $t->{host} started for directory $
. "$t->{shareName}";		t->{shareName}";
}		}
$logMsg .= " (client path $t->{shareNamePath})" if ( $t->{shareName} ne $t-> {shareNamePath} );		$logMsg .= " (client path $t->{shareNamePath})" if ( $t->{shareName} ne $t-> {shareNamePath} );
$t->logWrite($logMsg . "\n", 1);		$t->logWrite($logMsg . "\n", 1);
#		#
# call the recursive function based on the type of action		# call the recursive function based on the type of action
#		#
if ( $t->{type} eq 'restore' ) {		if ( $t->{type} eq 'restore' ) {
$t->restore();		$t->restore();
$logMsg = "Restore of $t->{host} "		$logMsg = "Restore of $t->{host} " . ($t->{xferOK} ? "complete" : "faile
. ($t->{xferOK} ? "complete" : "failed");		d");
} else {		} else {
$t->{compress} = $t->{backups}[$t->{newBkupIdx}]{compress};		$t->{compress} = $t->{backups}[$t->{newBkupIdx}]{compress};
$t->{newBkupNum} = $t->{backups}[$t->{newBkupIdx}]{num};		$t->{newBkupNum} = $t->{backups}[$t->{newBkupIdx}]{num};
$t->{lastBkupNum} = $t->{backups}[$t->{lastBkupIdx}]{num};		$t->{lastBkupNum} = $t->{backups}[$t->{lastBkupIdx}]{num};
$t->{AttrNew} = BackupPC::XS::AttribCache::new($t->{client}, $t->{ne		$t->{AttrNew} = BackupPC::XS::AttribCache::new($t->{client}, $t->{newBku
wBkupNum}, $t->{shareName},		pNum}, $t->{shareName}, $t->{compress});
$t->{compress});		$t->{DeltaNew} = BackupPC::XS::DeltaRefCnt::new("$TopDir/pc/$t->{client}
$t->{DeltaNew} = BackupPC::XS::DeltaRefCnt::new("$TopDir/pc/$t->{clie		/$t->{newBkupNum}");
nt}/$t->{newBkupNum}");
$t->{AttrNew}->setDeltaInfo($t->{DeltaNew});		$t->{AttrNew}->setDeltaInfo($t->{DeltaNew});
$t->{Inode} = 1;		$t->{Inode} = 1;
for ( my $i = 0 ; $i < @{$t->{backups}} ; $i++ ) {		for ( my $i = 0 ; $i < @{$t->{backups}} ; $i++ ) {
$t->{Inode} = $t->{backups}[$i]{inodeLast} + 1 if ( $t->{Inode} <= $t		$t->{Inode} = $t->{backups}[$i]{inodeLast} + 1 if ( $t->{Inode} <= $
->{backups}[$i]{inodeLast} );		t->{backups}[$i]{inodeLast} );
}		}
$t->{Inode0} = $t->{Inode};		$t->{Inode0} = $t->{Inode};
if ( !$t->{inPlace} ) {		if ( !$t->{inPlace} ) {
$t->{AttrOld} = BackupPC::XS::AttribCache::new($t->{client}, $t->{l		$t->{AttrOld} =
astBkupNum}, $t->{shareName},		BackupPC::XS::AttribCache::new($t->{client}, $t->{lastBkupNum}, $t
$t->{compress});		->{shareName}, $t->{compress});
$t->{DeltaOld} = BackupPC::XS::DeltaRefCnt::new("$TopDir/pc/$t->{cli ent}/$t->{lastBkupNum}");		$t->{DeltaOld} = BackupPC::XS::DeltaRefCnt::new("$TopDir/pc/$t->{cli ent}/$t->{lastBkupNum}");
$t->{AttrOld}->setDeltaInfo($t->{DeltaOld});		$t->{AttrOld}->setDeltaInfo($t->{DeltaOld});
}		}
$t->logWrite("ftp inPlace = $t->{inPlace}, newBkupNum = $t->{newBkupNum}		$t->logWrite("ftp inPlace = $t->{inPlace}, newBkupNum = $t->{newBkupNum}
, lastBkupNum = $t->{lastBkupNum}\n", 4);		, lastBkupNum = $t->{lastBkupNum}\n",
		4);
$bpc->flushXSLibMesgs();		$bpc->flushXSLibMesgs();
$t->backup();		$t->backup();
$t->{AttrNew}->flush(1);		$t->{AttrNew}->flush(1);
$bpc->flushXSLibMesgs();		$bpc->flushXSLibMesgs();
if ( $t->{AttrOld} ) {		if ( $t->{AttrOld} ) {
$t->{AttrOld}->flush(1);		$t->{AttrOld}->flush(1);
$bpc->flushXSLibMesgs();		$bpc->flushXSLibMesgs();
}		}
skipping to change at line 301		skipping to change at line 295
if ( $t->{DeltaOld} ) {		if ( $t->{DeltaOld} ) {
print("RefCnt Deltas for old #$t->{lastBkupNum}\n");		print("RefCnt Deltas for old #$t->{lastBkupNum}\n");
$t->{DeltaOld}->print();		$t->{DeltaOld}->print();
}		}
}		}
$bpc->flushXSLibMesgs();		$bpc->flushXSLibMesgs();
$t->{DeltaNew}->flush();		$t->{DeltaNew}->flush();
$t->{DeltaOld}->flush() if ( $t->{DeltaOld} );		$t->{DeltaOld}->flush() if ( $t->{DeltaOld} );
if ( $t->{type} eq 'incr' ) {		if ( $t->{type} eq 'incr' ) {
$logMsg = "Incremental backup of $t->{host} "		$logMsg = "Incremental backup of $t->{host} " . ($t->{xferOK} ? "com
. ($t->{xferOK} ? "complete" : "failed");		plete" : "failed");
} else {		} else {
$logMsg = "Full backup of $t->{host} "		$logMsg = "Full backup of $t->{host} " . ($t->{xferOK} ? "complete"
. ($t->{xferOK} ? "complete" : "failed");		: "failed");
}		}
return if ( !$t->{xferOK} && defined($t->{_errStr}) );		return if ( !$t->{xferOK} && defined($t->{_errStr}) );
}		}
delete $t->{_errStr};		delete $t->{_errStr};
return $logMsg;		return $logMsg;
}		}
#		#
#		#
#		#
sub run		sub run
{		{
my ($t) = @_;		my($t) = @_;
my $stats = $t->{stats};		my $stats = $t->{stats};
my ( $tarErrs, $nFilesExist, $sizeExist,		my($tarErrs, $nFilesExist, $sizeExist, $sizeExistCom, $nFilesTotal, $sizeTot
$sizeExistCom, $nFilesTotal, $sizeTotal );		al);
#		#
# TODO: replace the $stats array with variables at the top level,		# TODO: replace the $stats array with variables at the top level,
# ones returned by $getStats. They should be identical.		# ones returned by $getStats. They should be identical.
#		#
$tarErrs = 0;		$tarErrs = 0;
$nFilesExist = $stats->{ExistFileCnt};		$nFilesExist = $stats->{ExistFileCnt};
$sizeExist = $stats->{ExistFileSize};		$sizeExist = $stats->{ExistFileSize};
$sizeExistCom = $stats->{ExistFileCompSize};		$sizeExistCom = $stats->{ExistFileCompSize};
$nFilesTotal = $stats->{TotalFileCnt};		$nFilesTotal = $stats->{TotalFileCnt};
$sizeTotal = $stats->{TotalFileSize};		$sizeTotal = $stats->{TotalFileSize};
if ( $t->{type} eq "restore" ) {		if ( $t->{type} eq "restore" ) {
return ( $t->{fileCnt}, $t->{byteCnt}, 0, 0 );		return ($t->{fileCnt}, $t->{byteCnt}, 0, 0);
} else {		} else {
return ( $tarErrs, $nFilesExist, $sizeExist,		return ($tarErrs, $nFilesExist, $sizeExist, $sizeExistCom, $nFilesTotal,
$sizeExistCom, $nFilesTotal, $sizeTotal );		$sizeTotal);
}		}
}		}
sub restore		sub restore
{		{
my($t) = @_;		my($t) = @_;
my $bpc = $t->{bpc};		my $bpc = $t->{bpc};
my $fileList = $t->{fileList};		my $fileList = $t->{fileList};
$t->{view} = BackupPC::View->new($bpc, $t->{bkupSrcHost}, $t->{backups});		$t->{view} = BackupPC::View->new($bpc, $t->{bkupSrcHost}, $t->{backups});
my $view = $t->{view};		my $view = $t->{view};
foreach my $file ( @$fileList ) {		foreach my $file ( @$fileList ) {
my $attr = $view->fileAttrib($t->{bkupSrcNum}, $t->{bkupSrcShare}, $file );		my $attr = $view->fileAttrib($t->{bkupSrcNum}, $t->{bkupSrcShare}, $file );
$t->logWrite("restore($file)\n", 4);		$t->logWrite("restore($file)\n", 4);
if ( $attr->{type} == BPC_FTYPE_DIR ) {		if ( $attr->{type} == BPC_FTYPE_DIR ) {
$t->restoreDir($file, $attr);		$t->restoreDir($file, $attr);
skipping to change at line 383		skipping to change at line 373
$t->logWrite("restore($file): failed... unsupported file type $attr- >{type}\n", 0);		$t->logWrite("restore($file): failed... unsupported file type $attr- >{type}\n", 0);
$t->{xferErrCnt}++;		$t->{xferErrCnt}++;
}		}
}		}
$t->{xferOK} = 1;		$t->{xferOK} = 1;
return 1;		return 1;
}		}
sub restoreDir		sub restoreDir
{		{
my ($t, $dirName, $dirAttr) = @_;		my($t, $dirName, $dirAttr) = @_;
my $ftp = $t->{ftp};		my $ftp = $t->{ftp};
my $bpc = $t->{bpc};		my $bpc = $t->{bpc};
my $conf = $t->{conf};		my $conf = $t->{conf};
my $view = $t->{view};		my $view = $t->{view};
my $dirList = $view->dirAttrib($t->{bkupSrcNum}, $t->{bkupSrcShare}, $dirNam e);		my $dirList = $view->dirAttrib($t->{bkupSrcNum}, $t->{bkupSrcShare}, $dirNam e);
(my $targetPath = "$t->{shareNamePath}/$dirName") =~ s{//+}{/}g;		(my $targetPath = "$t->{shareNamePath}/$dirName") =~ s{//+}{/}g;
my ( $fileName, $fileAttr, $fileType );		my($fileName, $fileAttr, $fileType);
$t->logWrite("restoreDir($dirName) -> $targetPath\n", 4);		$t->logWrite("restoreDir($dirName) -> $targetPath\n", 4);
#		#
# Create the remote directory		# Create the remote directory
#		#
undef $@;		undef $@;
eval { $ftp->mkdir( $targetPath, 1 ); };		eval { $ftp->mkdir($targetPath, 1); };
if ( $@ ) {		if ( $@ ) {
$t->logFileAction("fail", $dirName, $dirAttr);		$t->logFileAction("fail", $dirName, $dirAttr);
return;		return;
} else {		} else {
$t->logFileAction("restore", $dirName, $dirAttr);		$t->logFileAction("restore", $dirName, $dirAttr);
}		}
while ( ($fileName, $fileAttr ) = each %$dirList ) {		while ( ($fileName, $fileAttr) = each %$dirList ) {
$t->logWrite("restoreDir: entry = $dirName/$fileName\n", 4);		$t->logWrite("restoreDir: entry = $dirName/$fileName\n", 4);
if ( $fileAttr->{type} == BPC_FTYPE_DIR ) {		if ( $fileAttr->{type} == BPC_FTYPE_DIR ) {
$t->restoreDir("$dirName/$fileName", $fileAttr);		$t->restoreDir("$dirName/$fileName", $fileAttr);
} elsif ( $fileAttr->{type} == BPC_FTYPE_FILE ) {		} elsif ( $fileAttr->{type} == BPC_FTYPE_FILE ) {
$t->restoreFile("$dirName/$fileName", $fileAttr);		$t->restoreFile("$dirName/$fileName", $fileAttr);
skipping to change at line 433		skipping to change at line 423
#		#
# can't restore any other file types		# can't restore any other file types
#		#
$t->logWrite("restore($fileName): failed... unsupported file type $f ileAttr->{type}\n", 0);		$t->logWrite("restore($fileName): failed... unsupported file type $f ileAttr->{type}\n", 0);
}		}
}		}
}		}
sub restoreFile		sub restoreFile
{		{
my ($t, $fileName, $fileAttr ) = @_;		my($t, $fileName, $fileAttr) = @_;
my $conf = $t->{conf};		my $conf = $t->{conf};
my $ftp = $t->{ftp};		my $ftp = $t->{ftp};
my $bpc = $t->{bpc};		my $bpc = $t->{bpc};
my $TopDir = $bpc->TopDir();		my $TopDir = $bpc->TopDir();
my $poolFile = $fileAttr->{fullPath};		my $poolFile = $fileAttr->{fullPath};
my $tempFile = "$TopDir/pc/$t->{client}/FtpRestoreTmp$$";		my $tempFile = "$TopDir/pc/$t->{client}/FtpRestoreTmp$$";
my $fout;		my $fout;
my $fileDest = ( $conf->{ClientCharset} ne "" )		my $fileDest =
? from_to( "$t->{shareNamePath}//$fileName",		($conf->{ClientCharset} ne "")
"utf8", $conf->{ClientCharset} )		? from_to("$t->{shareNamePath}//$fileName", "utf8", $conf->{ClientCharset}
: "$t->{shareNamePath}/$fileName";		)
		: "$t->{shareNamePath}/$fileName";
$t->logWrite("restoreFile($fileName) -> $fileDest\n", 4);		$t->logWrite("restoreFile($fileName) -> $fileDest\n", 4);
if ( $fileAttr->{compress} ) {		if ( $fileAttr->{compress} ) {
my $f = BackupPC::XS::FileZIO::open($poolFile, 0, $fileAttr->{compress}) ;		my $f = BackupPC::XS::FileZIO::open($poolFile, 0, $fileAttr->{compress}) ;
if ( !defined($f) ) {		if ( !defined($f) ) {
$t->logWrite("restoreFile: Unable to open file $poolFile (during res tore of $fileName)\n", 0);		$t->logWrite("restoreFile: Unable to open file $poolFile (during res tore of $fileName)\n", 0);
$t->{stats}{errCnt}++;		$t->{stats}{errCnt}++;
return;		return;
}		}
skipping to change at line 485		skipping to change at line 475
}		}
}		}
$f->close();		$f->close();
close($fout);		close($fout);
} else {		} else {
$tempFile = $poolFile;		$tempFile = $poolFile;
}		}
undef $@;		undef $@;
eval {		eval {
if ( $ftp->put( $tempFile, $fileDest ) ) {		if ( $ftp->put($tempFile, $fileDest) ) {
$t->logFileAction("restore", $fileName, $fileAttr);		$t->logFileAction("restore", $fileName, $fileAttr);
} else {		} else {
$@ = 1 if ( !$@ ); # force the fail message below		$@ = 1 if ( !$@ ); # force the fail message below
}		}
};		};
unlink($tempFile);		unlink($tempFile);
if ($@) {		if ( $@ ) {
$t->logWrite("restoreFile($fileName) failed ($@)\n", 4);		$t->logWrite("restoreFile($fileName) failed ($@)\n", 4);
$t->logFileAction("fail", $fileName, $fileAttr);		$t->logFileAction("fail", $fileName, $fileAttr);
}		}
}		}
#		#
# usage:		# usage:
# $t->backup($path);		# $t->backup($path);
#		#
# $t->backup() is a recursive function that takes a path as an		# $t->backup() is a recursive function that takes a path as an
# argument, and performs a backup on that folder consistent with the		# argument, and performs a backup on that folder consistent with the
# configuration parameters. $path is considered rooted at		# configuration parameters. $path is considered rooted at
# $t->{shareName}, so no $ftp->cwd() command is necessary.		# $t->{shareName}, so no $ftp->cwd() command is necessary.
#		#
sub backup		sub backup
{		{
my ($t) = @_;		my($t) = @_;
my $ftp = $t->{ftp};		my $ftp = $t->{ftp};
my $bpc = $t->{bpc};		my $bpc = $t->{bpc};
my $conf = $t->{conf};		my $conf = $t->{conf};
#		#
# determine the filetype of the shareName and back it up		# determine the filetype of the shareName and back it up
# appropriately. For now, assume that $t->{shareName} is a		# appropriately. For now, assume that $t->{shareName} is a
# directory.		# directory.
#		#
my $f = {		my $f = {
name => "/",		name => "/",
type => BPC_FTYPE_DIR,		type => BPC_FTYPE_DIR,
mode => 0775,		mode => 0775,
mtime => time,		mtime => time,
compress => $t->{compress},		compress => $t->{compress},
};		};
if ( $t->handleDir($f) ) {		if ( $t->handleDir($f) ) {
$t->logWrite("adding top-level attrib for share $t->{shareName}\n", 4);		$t->logWrite("adding top-level attrib for share $t->{shareName}\n", 4);
my $fNew = {		my $fNew = {
name => $t->{shareName},		name => $t->{shareName},
type => BPC_FTYPE_DIR,		type => BPC_FTYPE_DIR,
mode => 0775,		mode => 0775,
uid => 0,		uid => 0,
gid => 0,		gid => 0,
size => 0,		size => 0,
mtime => time(),		mtime => time(),
inode => $t->{Inode}++,		inode => $t->{Inode}++,
nlinks => 0,		nlinks => 0,
compress => $t->{compress},		compress => $t->{compress},
};		};
$t->{AttrNew}->set("/", $fNew);		$t->{AttrNew}->set("/", $fNew);
$t->{xferOK} = 1;		$t->{xferOK} = 1;
return 1;		return 1;
} else {		} else {
$t->{xferBadShareCnt}++;		$t->{xferBadShareCnt}++;
return;		return;
skipping to change at line 566		skipping to change at line 556
# FTP-specific functions		# FTP-specific functions
################################################################################ ####		################################################################################ ####
#		#
# This is an encapulation of the logic necessary to grab the arguments		# This is an encapulation of the logic necessary to grab the arguments
# from %Conf and throw it in a hash pointer to be passed to the		# from %Conf and throw it in a hash pointer to be passed to the
# Net::FTP object.		# Net::FTP object.
#		#
sub getFTPArgs		sub getFTPArgs
{		{
my ($t) = @_;		my($t) = @_;
my $conf = $t->{conf};		my $conf = $t->{conf};
return {		return {
Host => $t->{hostIP} || $t->{host},		Host => $t->{hostIP} || $t->{host},
Firewall => undef, # not used		Firewall => undef,
FirewallType => undef, # not used		# not used
		FirewallType => undef,
		# not used
BlockSize => $conf->{FtpBlockSize} || 10240,		BlockSize => $conf->{FtpBlockSize} || 10240,
Port => $conf->{FtpPort} || 21,		Port => $conf->{FtpPort} || 21,
Timeout => defined($conf->{FtpTimeout}) ? $conf->{FtpTimeout} : 120 ,		Timeout => defined($conf->{FtpTimeout}) ? $conf->{FtpTimeout} : 120 ,
Debug => $t->{logLevel} >= 5 ? 1 : 0,		Debug => $t->{logLevel} >= 5 ? 1 : 0,
Passive => (defined($conf->{FtpPassive}) ? $conf->{FtpPassive} : 1) ,		Passive => (defined($conf->{FtpPassive}) ? $conf->{FtpPassive} : 1) ,
Hash => undef, # do not touch		Hash => undef, # do not touch
};		};
}		}
#		#
# usage:		# usage:
# $dirList = $t->remotels($path);		# $dirList = $t->remotels($path);
#		#
# remotels() returns a reference to a list of hash references that		# remotels() returns a reference to a list of hash references that
# describe the contents of each file in the directory of the path		# describe the contents of each file in the directory of the path
# specified.		# specified.
#		#
sub remotels		sub remotels
{		{
my ( $t, $name ) = @_;		my($t, $name) = @_;
my $ftp = $t->{ftp};		my $ftp = $t->{ftp};
my $bpc = $t->{bpc};		my $bpc = $t->{bpc};
my $conf = $t->{conf};		my $conf = $t->{conf};
my $nameClient = $name;		my $nameClient = $name;
my $char2type = {		my $char2type = {
'f' => BPC_FTYPE_FILE,		'f' => BPC_FTYPE_FILE,
'd' => BPC_FTYPE_DIR,		'd' => BPC_FTYPE_DIR,
'l' => BPC_FTYPE_SYMLINK,		'l' => BPC_FTYPE_SYMLINK,
};		};
my ($dirContents, $remoteDir, $f, $linkname);		my($dirContents, $remoteDir, $f, $linkname);
from_to( $nameClient, "utf8", $conf->{ClientCharset} )		from_to($nameClient, "utf8", $conf->{ClientCharset})
if ( $conf->{ClientCharset} ne "" );		if ( $conf->{ClientCharset} ne "" );
$remoteDir = [];		$remoteDir = [];
undef $@;		undef $@;
$t->logWrite("remotels: about to list $name\n", 4);		$t->logWrite("remotels: about to list $name\n", 4);
eval {		eval {
$dirContents = ($nameClient =~ /^\.?$/ || $nameClient =~ /^\/*$/)		$dirContents = ($nameClient =~ /^\.?$/ || $nameClient =~ /^\/*$/) ? $ftp
? $ftp->dir() : $ftp->dir("$nameClient/");		->dir() : $ftp->dir("$nameClient/");
};		};
if ( !defined($dirContents) ) {		if ( !defined($dirContents) ) {
$t->{xferErrCnt}++;		$t->{xferErrCnt}++;
$t->logWrite("remotels: can't retrieve remote directory contents of $nam e: $!\n", 1);		$t->logWrite("remotels: can't retrieve remote directory contents of $nam e: $!\n", 1);
return "can't retrieve remote directory contents of $name: $!";		return "can't retrieve remote directory contents of $name: $!";
}		}
if ( $t->{logLevel} >= 4 ) {		if ( $t->{logLevel} >= 4 ) {
my $str = join("\n", @$dirContents);		my $str = join("\n", @$dirContents);
$t->logWrite("remotels: got dir() result:\n$str\n", 4);		$t->logWrite("remotels: got dir() result:\n$str\n", 4);
}		}
skipping to change at line 640		skipping to change at line 629
if ( $info->[1] =~ /^l (.*)/ ) {		if ( $info->[1] =~ /^l (.*)/ ) {
$linkname = $1;		$linkname = $1;
}		}
#		#
# Try to extract number uid/gid, if present. If there are special files (eg, devices or pipe) that are		# Try to extract number uid/gid, if present. If there are special files (eg, devices or pipe) that are
# in the directoy listing, they won't be in $dirContents. So $dirStr mi ght not be the matching text		# in the directoy listing, they won't be in $dirContents. So $dirStr mi ght not be the matching text
# for $info. So we peel off more elements if they don't appear to match . This is very fragile.		# for $info. So we peel off more elements if they don't appear to match . This is very fragile.
# Better solution would be to update $ftp->dir() to extract uid/gid if p resent.		# Better solution would be to update $ftp->dir() to extract uid/gid if p resent.
#		#
while ( @$dirContents && $dirStr !~ m{\s+\Q$info->[0]\E$}		while ( @$dirContents
&& $dirStr !~ m{^l.*\s+\Q$info->[0] -> $linkname\E		&& $dirStr !~ m{\s+\Q$info->[0]\E$}
$} ) {		&& $dirStr !~ m{^l.*\s+\Q$info->[0] -> $linkname\E$} ) {
$t->logWrite("no match between $dirStr and $info->[0]\n", 4);		$t->logWrite("no match between $dirStr and $info->[0]\n", 4);
$dirStr = shift(@$dirContents);		$dirStr = shift(@$dirContents);
}		}
my $fTypeChar = substr($info->[1], 0, 1);		my $fTypeChar = substr($info->[1], 0, 1);
if ( $dirStr =~ m{^.{10}\s+\d+\s+(\d+)\s+(\d+)\s+(\d+).*\Q$info->[0]\E}		if ( $dirStr =~ m{^.{10}\s+\d+\s+(\d+)\s+(\d+)\s+(\d+).*\Q$info->[0]\E}
&& ($fTypeChar ne "f" || $info->[2] == $3) ) {		&& ($fTypeChar ne "f" || $info->[2] == $3) ) {
$uid = $1;		$uid = $1;
$gid = $2;		$gid = $2;
}		}
from_to($info->[0], $conf->{ClientCharset}, "utf8")		from_to($info->[0], $conf->{ClientCharset}, "utf8")
if ( $conf->{ClientCharset} ne "" );		if ( $conf->{ClientCharset} ne "" );
from_to($linkname, $conf->{ClientCharset}, "utf8")		from_to($linkname, $conf->{ClientCharset}, "utf8")
if ( $linkname ne "" && $conf->{ClientCharset} n e "" );		if ( $linkname ne "" && $conf->{ClientCharset} ne "" );
my $dir = "$name/";		my $dir = "$name/";
$dir = "" if ( $name eq "" );		$dir = "" if ( $name eq "" );
$dir =~ s{^/+}{};		$dir =~ s{^/+}{};
$f = {		$f = {
name => "$dir$info->[0]",		name => "$dir$info->[0]",
type => defined($char2type->{$fTypeChar}) ? $char2type->{$fTypeC har} : BPC_FTYPE_UNKNOWN,		type => defined($char2type->{$fTypeChar}) ? $char2type->{$fTypeC har} : BPC_FTYPE_UNKNOWN,
size => $info->[2],		size => $info->[2],
mtime => $info->[3],		mtime => $info->[3],
mode => $info->[4],		mode => $info->[4],
uid => $uid,		uid => $uid,
gid => $gid,		gid => $gid,
compress => $t->{compress},		compress => $t->{compress},
};		};
$f->{linkname} = $linkname if ( defined($linkname) );		$f->{linkname} = $linkname if ( defined($linkname) );
$t->logWrite("remotels: adding name $f->{name}, type $f->{type} ($info->		$t->logWrite(
[1]), size $f->{size}, mode $f->{mode}, $uid/$gid\n", 4);		"remotels: adding name $f->{name}, type $f->{type} ($info->[1]), siz
		e $f->{size}, mode $f->{mode}, $uid/$gid\n",
		4
		);
push( @$remoteDir, $f );		push(@$remoteDir, $f);
}		}
return $remoteDir;		return $remoteDir;
}		}
#		#
# handleSymlink() backs up a symlink.		# handleSymlink() backs up a symlink.
#		#
sub handleSymlink		sub handleSymlink
{		{
my ( $t, $f ) = @_;		my($t, $f) = @_;
my $a = $t->{AttrNew}->get($f->{name});		my $a = $t->{AttrNew}->get($f->{name});
my $stats = $t->{stats};		my $stats = $t->{stats};
my($same, $exists, $digest, $outSize, $errs);		my($same, $exists, $digest, $outSize, $errs);
#		#
# Symbolic link: write the value of the link to a plain file,		# Symbolic link: write the value of the link to a plain file,
# that we pool as usual (ie: we don't create a symlink).		# that we pool as usual (ie: we don't create a symlink).
# The attributes remember the original file type.		# The attributes remember the original file type.
# We also change the size to reflect the size of the link		# We also change the size to reflect the size of the link
# contents.		# contents.
#		#
skipping to change at line 707		skipping to change at line 701
if ( $a && $a->{type} == BPC_FTYPE_SYMLINK ) {		if ( $a && $a->{type} == BPC_FTYPE_SYMLINK ) {
#		#
# Check if it is the same		# Check if it is the same
#		#
my $oldLink = $t->fileReadAll($a, $f);		my $oldLink = $t->fileReadAll($a, $f);
if ( $oldLink eq $f->{linkname} ) {		if ( $oldLink eq $f->{linkname} ) {
logFileAction("same", $f) if ( $t->{logLevel} >= 1 );		logFileAction("same", $f) if ( $t->{logLevel} >= 1 );
$stats->{ExistFileCnt}++;		$stats->{ExistFileCnt}++;
$stats->{ExistFileSize} += $f->{size};		$stats->{ExistFileSize} += $f->{size};
$stats->{ExistFileCompSize} += -s $a->{poolPath}		$stats->{ExistFileCompSize} += -s $a->{poolPath}
if ( -f $a->{poolPath} );		if ( -f $a->{poolPath} );
$same = 1;		$same = 1;
}		}
}		}
if ( !$same ) {		if ( !$same ) {
$t->moveFileToOld($a, $f);		$t->moveFileToOld($a, $f);
$t->logWrite("PoolWrite->new(name = $f->{name}, compress = $t->{compress })\n", 5);		$t->logWrite("PoolWrite->new(name = $f->{name}, compress = $t->{compress })\n", 5);
my $poolWrite = BackupPC::XS::PoolWrite::new($t->{compress});		my $poolWrite = BackupPC::XS::PoolWrite::new($t->{compress});
$poolWrite->write(\$f->{linkname});		$poolWrite->write(\$f->{linkname});
($exists, $digest, $outSize, $errs) = $poolWrite->close();		($exists, $digest, $outSize, $errs) = $poolWrite->close();
$f->{digest} = $digest;		$f->{digest} = $digest;
if ( $errs ) {		if ( $errs ) {
$t->logFileAction( "fail", $f->{name}, $f );		$t->logFileAction("fail", $f->{name}, $f);
$t->{xferBadFileCnt}++;		$t->{xferBadFileCnt}++;
$stats->{errCnt} += scalar @$errs;		$stats->{errCnt} += scalar @$errs;
return;		return;
}		}
}		}
#		#
# Update attribs		# Update attribs
#		#
$t->attribUpdate($a, $f, $same);		$t->attribUpdate($a, $f, $same);
#		#
# Perform logging		# Perform logging
#		#
$t->logFileAction( $same ? "same" : $exists ? "pool" : "new", $f->{name}, $f );		$t->logFileAction($same ? "same" : $exists ? "pool" : "new", $f->{name}, $f) ;
#		#
# Cumulate the stats		# Cumulate the stats
#		#
$stats->{TotalFileCnt}++;		$stats->{TotalFileCnt}++;
$stats->{TotalFileSize} += $f->{size};		$stats->{TotalFileSize} += $f->{size};
if ( $exists ) {		if ( $exists ) {
$stats->{ExistFileCnt}++;		$stats->{ExistFileCnt}++;
$stats->{ExistFileCompSize} += -s $a->{poolPath}		$stats->{ExistFileCompSize} += -s $a->{poolPath}
if ( -f $a->{poolPath} );		if ( -f $a->{poolPath} );
$stats->{ExistFileSize} += $f->{size};		$stats->{ExistFileSize} += $f->{size};
} else {		} else {
$stats->{NewFileCnt}++;		$stats->{NewFileCnt}++;
$stats->{NewFileCompSize} += -s $a->{poolPath}		$stats->{NewFileCompSize} += -s $a->{poolPath}
if ( -f $a->{poolPath} );		if ( -f $a->{poolPath} );
$stats->{NewFileSize} += $f->{size};		$stats->{NewFileSize} += $f->{size};
}		}
$t->{byteCnt} += $f->{size};		$t->{byteCnt} += $f->{size};
$t->{fileCnt}++;		$t->{fileCnt}++;
return 1;		return 1;
}		}
#		#
# handleDir() backs up a directory, and initiates a backup of its		# handleDir() backs up a directory, and initiates a backup of its
# contents.		# contents.
#		#
sub handleDir		sub handleDir
{		{
my ( $t, $f ) = @_;		my($t, $f) = @_;
my $ftp = $t->{ftp};		my $ftp = $t->{ftp};
my $bpc = $t->{bpc};		my $bpc = $t->{bpc};
my $conf = $t->{conf};		my $conf = $t->{conf};
my $stats = $t->{stats};		my $stats = $t->{stats};
my $AttrNew = $t->{AttrNew};		my $AttrNew = $t->{AttrNew};
my $same = 0;		my $same = 0;
my $a = $AttrNew->get($f->{name});		my $a = $AttrNew->get($f->{name});
my ( $exists, $digest, $outSize, $errs );		my($exists, $digest, $outSize, $errs);
my ( $poolWrite, $poolFile );		my($poolWrite, $poolFile);
my ( $localDir, $remoteDir, %expectedFiles );		my($localDir, $remoteDir, %expectedFiles);
$a->{poolPath} = $bpc->MD52Path($a->{digest}, $a->{compress}) if ( length($a ->{digest}) );		$a->{poolPath} = $bpc->MD52Path($a->{digest}, $a->{compress}) if ( length($a ->{digest}) );
my $pathNew = $AttrNew->getFullMangledPath($f->{name});		my $pathNew = $AttrNew->getFullMangledPath($f->{name});
if ( -d $pathNew ) {		if ( -d $pathNew ) {
$t->logFileAction( "same", $f->{name}, $f );		$t->logFileAction("same", $f->{name}, $f);
$same = 1;		$same = 1;
} else {		} else {
if ( -e $pathNew ) {		if ( -e $pathNew ) {
$t->logWrite("handleDir: $pathNew ($f->{name}) isn't a directory... renaming and recreating\n", 3)		$t->logWrite("handleDir: $pathNew ($f->{name}) isn't a directory... renaming and recreating\n", 3)
if ( defined($a) );		if ( defined($a) );
} else {		} else {
$t->logWrite("handleDir: creating directory $pathNew ($f->{name})\n" , 3)		$t->logWrite("handleDir: creating directory $pathNew ($f->{name})\n" , 3)
if ( defined($a) );		if ( defined($a) );
}		}
$t->moveFileToOld($a, $f);		$t->moveFileToOld($a, $f);
$t->logFileAction("new", $f->{name}, $f) if ( $t->{logLevel} >= 1 );		$t->logFileAction("new", $f->{name}, $f) if ( $t->{logLevel} >= 1 );
#		#
# make sure all the parent directories exist and have directory attribs		# make sure all the parent directories exist and have directory attribs
#		#
$t->pathCreate($pathNew, 1);		$t->pathCreate($pathNew, 1);
my $name = $f->{name};		my $name = $f->{name};
$name = "/$name" if ( $name !~ m{^/} );		$name = "/$name" if ( $name !~ m{^/} );
while ( length($name) > 1 ) {		while ( length($name) > 1 ) {
if ( $name =~ m{/} ) {		if ( $name =~ m{/} ) {
$name =~ s{(.*)/.*}{$1};		$name =~ s{(.*)/.*}{$1};
} else {		} else {
$name = "/";		$name = "/";
}		}
my $a = $AttrNew->get($name);		my $a = $AttrNew->get($name);
last if ( defined($a) && $a->{type} == BPC_FTYPE_DIR );		last if ( defined($a) && $a->{type} == BPC_FTYPE_DIR );
$t->logWrite("handleDir: adding BPC_FTYPE_DIR attrib entry for $name \n", 3);		$t->logWrite("handleDir: adding BPC_FTYPE_DIR attrib entry for $name \n", 3);
my $fNew = {		my $fNew = {
name => $name,		name => $name,
type => BPC_FTYPE_DIR,		type => BPC_FTYPE_DIR,
mode => $f->{mode},		mode => $f->{mode},
uid => $f->{uid},		uid => $f->{uid},
gid => $f->{gid},		gid => $f->{gid},
size => 0,		size => 0,
mtime => $f->{mtime},		mtime => $f->{mtime},
inode => $t->{Inode}++,		inode => $t->{Inode}++,
nlinks => 0,		nlinks => 0,
compress => $t->{compress},		compress => $t->{compress},
};		};
$AttrNew->set($name, $fNew);		$AttrNew->set($name, $fNew);
$t->moveFileToOld($a, $fNew);		$t->moveFileToOld($a, $fNew);
}		}
}		}
#		#
# Update attribs		# Update attribs
#		#
$t->attribUpdate($a, $f, $same);		$t->attribUpdate($a, $f, $same);
$t->logWrite("handleDir: name = $f->{name}, pathNew = $pathNew\n", 4);		$t->logWrite("handleDir: name = $f->{name}, pathNew = $pathNew\n", 4);
$remoteDir = $t->remotels( $f->{name} );		$remoteDir = $t->remotels($f->{name});
if ( ref($remoteDir) ne 'ARRAY' ) {		if ( ref($remoteDir) ne 'ARRAY' ) {
$t->logWrite("handleDir failed: $remoteDir\n", 1);		$t->logWrite("handleDir failed: $remoteDir\n", 1);
$t->logFileAction( "fail", $f->{name}, $f );		$t->logFileAction("fail", $f->{name}, $f);
$t->{xferErrCnt}++;		$t->{xferErrCnt}++;
return;		return;
}		}
my $all = $AttrNew->getAll($f->{name});		my $all = $AttrNew->getAll($f->{name});
$bpc->flushXSLibMesgs();		$bpc->flushXSLibMesgs();
#		#
# take care of each file in the directory		# take care of each file in the directory
#		#
skipping to change at line 883		skipping to change at line 877
$t->{xferBadFileCnt}++;		$t->{xferBadFileCnt}++;
}		}
#		#
# Mark file as seen in expected files hash		# Mark file as seen in expected files hash
#		#
$t->logWrite("dirLoop: handled $f->{name}\n", 5);		$t->logWrite("dirLoop: handled $f->{name}\n", 5);
$expectedFiles{$f->{name}}++;		$expectedFiles{$f->{name}}++;
} # end foreach (@{$remoteDir})		} # end foreach (@{$remoteDir})
#		#
# If we didn't see a file, move to old.		# If we didn't see a file, move to old.
#		#
foreach my $name ( keys(%$all) ) {		foreach my $name ( keys(%$all) ) {
next if ( $name eq "." || $name eq ".." );		next if ( $name eq "." || $name eq ".." );
my $path = "$f->{name}/$name";		my $path = "$f->{name}/$name";
$path =~ s{^/+}{};		$path =~ s{^/+}{};
$t->logWrite("dirCleanup: checking $path, expected = $expectedFiles{$pat h}\n", 5);		$t->logWrite("dirCleanup: checking $path, expected = $expectedFiles{$pat h}\n", 5);
next if ( $expectedFiles{$path} );		next if ( $expectedFiles{$path} );
skipping to change at line 908		skipping to change at line 902
# Explicit success		# Explicit success
#		#
return 1;		return 1;
}		}
#		#
# handleFile() backs up a file.		# handleFile() backs up a file.
#		#
sub handleFile		sub handleFile
{		{
my ( $t, $f ) = @_;		my($t, $f) = @_;
my $bpc = $t->{bpc};		my $bpc = $t->{bpc};
my $ftp = $t->{ftp};		my $ftp = $t->{ftp};
my $view = $t->{view};		my $view = $t->{view};
my $stats = $t->{stats};		my $stats = $t->{stats};
my ( $poolFile, $poolWrite, $data, $localSize );		my($poolFile, $poolWrite, $data, $localSize);
my ( $exists, $digest, $outSize, $errs );		my($exists, $digest, $outSize, $errs);
my ( $oldAttrib );		my($oldAttrib);
local *FTP;		local *FTP;
my $a = $t->{AttrNew}->get($f->{name});		my $a = $t->{AttrNew}->get($f->{name});
my $aOld = $t->{AttrOld}->get($f->{name}) if ( $t->{AttrOld} );		my $aOld = $t->{AttrOld}->get($f->{name}) if ( $t->{AttrOld} );
my $same = 0;		my $same = 0;
#		#
# If this is an incremental backup and the file exists in a		# If this is an incremental backup and the file exists in a
# previous backup unchanged, write the attribInfo for the file		# previous backup unchanged, write the attribInfo for the file
# accordingly.		# accordingly.
#		#
if ( $t->{type} eq "incr" ) {		if ( $t->{type} eq "incr" ) {
if ( $a		if ( $a
&& $f->{type} == $a->{type}		&& $f->{type} == $a->{type}
&& $f->{mtime} == $a->{mtime}		&& $f->{mtime} == $a->{mtime}
&& $f->{size} == $a->{size}		&& $f->{size} == $a->{size}
&& $f->{uid} == $a->{uid}		&& $f->{uid} == $a->{uid}
&& $f->{gid} == $a->{gid} ) {		&& $f->{gid} == $a->{gid} ) {
$t->logWrite("handleFile: $f->{name} has same attribs\n", 5);		$t->logWrite("handleFile: $f->{name} has same attribs\n", 5);
return 1;		return 1;
}		}
}		}
#		#
# If this is a full backup or the file has changed on the host,		# If this is a full backup or the file has changed on the host,
# back it up.		# back it up.
#		#
# TODO: convert back to local charset?		# TODO: convert back to local charset?
#		#
undef $@;		undef $@;
eval { tie ( *FTP, 'Net::FTP::RetrHandle', $ftp, "$f->{name}" ); };		eval { tie(*FTP, 'Net::FTP::RetrHandle', $ftp, "$f->{name}"); };
if ( !*FTP || $@ ) {		if ( !*FTP || $@ ) {
$t->logFileAction( "fail", $f->{name}, $f );		$t->logFileAction("fail", $f->{name}, $f);
$t->{xferBadFileCnt}++;		$t->{xferBadFileCnt}++;
$stats->{errCnt}++;		$stats->{errCnt}++;
return;		return;
}		}
$t->logWrite("PoolWrite->new(name = $f->{name}, compress = $t->{compress})\n ", 5);		$t->logWrite("PoolWrite->new(name = $f->{name}, compress = $t->{compress})\n ", 5);
$poolWrite = BackupPC::XS::PoolWrite::new($t->{compress});		$poolWrite = BackupPC::XS::PoolWrite::new($t->{compress});
$localSize = 0;		$localSize = 0;
undef $@;		undef $@;
eval {		eval {
while (<FTP>) {		while ( <FTP> ) {
$localSize += length($_);		$localSize += length($_);
$poolWrite->write( \$_ );		$poolWrite->write(\$_);
}		}
};		};
( $exists, $digest, $outSize, $errs ) = $poolWrite->close();		($exists, $digest, $outSize, $errs) = $poolWrite->close();
$f->{digest} = $digest;		$f->{digest} = $digest;
if ( $a && $a->{digest} eq $digest ) {		if ( $a && $a->{digest} eq $digest ) {
$same = 1 if ( $a->{nlinks} == 0 );		$same = 1 if ( $a->{nlinks} == 0 );
}		}
if ( !$same ) {		if ( !$same ) {
$t->moveFileToOld($a, $f);		$t->moveFileToOld($a, $f);
}		}
if ( !*FTP || $@ || $errs ) {		if ( !*FTP || $@ || $errs ) {
$t->logFileAction( "fail", $f->{name}, $f );		$t->logFileAction("fail", $f->{name}, $f);
$t->{xferBadFileCnt}++;		$t->{xferBadFileCnt}++;
$stats->{errCnt} += ref($errs) eq 'ARRAY' ? scalar(@$errs) : 1;		$stats->{errCnt} += ref($errs) eq 'ARRAY' ? scalar(@$errs) : 1;
return;		return;
}		}
#		#
# this should never happen		# this should never happen
#		#
if ( $localSize != $f->{size} ) {		if ( $localSize != $f->{size} ) {
$t->logFileAction( "fail", $f->{name}, $f );		$t->logFileAction("fail", $f->{name}, $f);
$t->logWrite("Size mismatch on $f->{name} ($localSize vs $f->{size})\n", 3);		$t->logWrite("Size mismatch on $f->{name} ($localSize vs $f->{size})\n", 3);
$stats->{xferBadFileCnt}++;		$stats->{xferBadFileCnt}++;
$stats->{errCnt}++;		$stats->{errCnt}++;
return;		return;
}		}
#		#
# Update attribs		# Update attribs
#		#
$t->attribUpdate($a, $f, $same);		$t->attribUpdate($a, $f, $same);
#		#
# Perform logging		# Perform logging
#		#
$t->logFileAction( $same ? "same" : $exists ? "pool" : "new", $f->{name}, $f );		$t->logFileAction($same ? "same" : $exists ? "pool" : "new", $f->{name}, $f) ;
#		#
# Cumulate the stats		# Cumulate the stats
#		#
$stats->{TotalFileCnt}++;		$stats->{TotalFileCnt}++;
$stats->{TotalFileSize} += $f->{size};		$stats->{TotalFileSize} += $f->{size};
if ( $exists ) {		if ( $exists ) {
$stats->{ExistFileCnt}++;		$stats->{ExistFileCnt}++;
$stats->{ExistFileCompSize} += $outSize;		$stats->{ExistFileCompSize} += $outSize;
$stats->{ExistFileSize} += $f->{size};		$stats->{ExistFileSize} += $f->{size};
skipping to change at line 1030		skipping to change at line 1024
$t->{byteCnt} += $localSize;		$t->{byteCnt} += $localSize;
$t->{fileCnt}++;		$t->{fileCnt}++;
}		}
#		#
# Generate a log file message for a completed file. Taken from		# Generate a log file message for a completed file. Taken from
# BackupPC_tarExtract. $f should be an attrib object.		# BackupPC_tarExtract. $f should be an attrib object.
#		#
sub logFileAction		sub logFileAction
{		{
my ( $t, $action, $name, $attrib ) = @_;		my($t, $action, $name, $attrib) = @_;
my $owner = "$attrib->{uid}/$attrib->{gid}";		my $owner = "$attrib->{uid}/$attrib->{gid}";
my $type = BackupPC::XS::Attrib::fileType2Text($attrib->{type});		my $type = BackupPC::XS::Attrib::fileType2Text($attrib->{type});
$type = $1 if ( $type =~ /(.)/ );		$type = $1 if ( $type =~ /(.)/ );
$type = "" if ( $type eq "f" );		$type = "" if ( $type eq "f" );
$name = "." if ( $name eq "" );		$name = "." if ( $name eq "" );
$owner = "-/-" if ( $owner eq "/" );		$owner = "-/-" if ( $owner eq "/" );
$t->{bpc}->flushXSLibMesgs();		$t->{bpc}->flushXSLibMesgs();
my $fileAction = sprintf(		my $fileAction = sprintf(
" %-6s %1s%4o %9s %11.0f %s\n",		" %-6s %1s%4o %9s %11.0f %s\n",
$action, $type, $attrib->{mode} & 07777,		$action, $type, $attrib->{mode} & 07777,
$owner, $attrib->{size}, $attrib->{name}		$owner, $attrib->{size}, $attrib->{name}
);		);
if ( ($t->{stats}{TotalFileCnt} % 20) == 0 && !$t->{noProgressPrint} ) {		if ( ($t->{stats}{TotalFileCnt} % 20) == 0 && !$t->{noProgressPrint} ) {
printf("__bpc_progress_fileCnt__ %d\n", $t->{stats}{TotalFileCnt});		printf("__bpc_progress_fileCnt__ %d\n", $t->{stats}{TotalFileCnt});
}		}
return $t->logWrite( $fileAction, 1 );		return $t->logWrite($fileAction, 1);
}		}
#		#
# Move $a to old; the new file $f will replace $a		# Move $a to old; the new file $f will replace $a
#		#
sub moveFileToOld		sub moveFileToOld
{		{
my($t, $a, $f) = @_;		my($t, $a, $f) = @_;
my $AttrNew = $t->{AttrNew};		my $AttrNew = $t->{AttrNew};
my $AttrOld = $t->{AttrOld};		my $AttrOld = $t->{AttrOld};
my $DeltaNew = $t->{DeltaNew};		my $DeltaNew = $t->{DeltaNew};
my $DeltaOld = $t->{DeltaOld};		my $DeltaOld = $t->{DeltaOld};
my $bpc = $t->{bpc};		my $bpc = $t->{bpc};
if ( !$a || keys(%$a) == 0 ) {		if ( !$a || keys(%$a) == 0 ) {
#		#
# A new file will be created, so add delete attribute to old		# A new file will be created, so add delete attribute to old
#		#
if ( $AttrOld ) {		if ( $AttrOld ) {
$AttrOld->set($f->{name}, { type => BPC_FTYPE_DELETED });		$AttrOld->set($f->{name}, {type => BPC_FTYPE_DELETED});
$t->logWrite("moveFileToOld: added $f->{name} as BPC_FTYPE_DELETED i n old\n", 5);		$t->logWrite("moveFileToOld: added $f->{name} as BPC_FTYPE_DELETED i n old\n", 5);
}		}
return;		return;
}		}
$t->logWrite("moveFileToOld: $a->{name}, $f->{name}, links = $a->{nlinks}, t ype = $a->{type}\n", 5);		$t->logWrite("moveFileToOld: $a->{name}, $f->{name}, links = $a->{nlinks}, t ype = $a->{type}\n", 5);
if ( $a->{type} != BPC_FTYPE_DIR ) {		if ( $a->{type} != BPC_FTYPE_DIR ) {
if ( $a->{nlinks} > 0 ) {		if ( $a->{nlinks} > 0 ) {
if ( $AttrOld ) {		if ( $AttrOld ) {
if ( !$AttrOld->getInode($a->{inode}) ) {		if ( !$AttrOld->getInode($a->{inode}) ) {
#		#
skipping to change at line 1121		skipping to change at line 1115
#		#
# Delete the directory tree, including updating reference counts		# Delete the directory tree, including updating reference counts
#		#
my $pathNew = $AttrNew->getFullMangledPath($f->{name});		my $pathNew = $AttrNew->getFullMangledPath($f->{name});
$t->logWrite("moveFileToOld(..., $f->{name}): deleting $pathNew\n", 3);		$t->logWrite("moveFileToOld(..., $f->{name}): deleting $pathNew\n", 3);
BackupPC::DirOps::RmTreeQuiet($bpc, $pathNew, $a->{compress}, $Delta New, $AttrNew);		BackupPC::DirOps::RmTreeQuiet($bpc, $pathNew, $a->{compress}, $Delta New, $AttrNew);
} else {		} else {
#		#
# For a directory we need to move it to old, and copy		# For a directory we need to move it to old, and copy
# any inodes that are referenced below this directory.		# any inodes that are referenced below this directory.
# Also update the reference counts for the moved files.		# Also update the reference counts for the moved files.
#		#
my $pathNew = $AttrNew->getFullMangledPath($f->{name});		my $pathNew = $AttrNew->getFullMangledPath($f->{name});
my $pathOld = $AttrOld->getFullMangledPath($f->{name});		my $pathOld = $AttrOld->getFullMangledPath($f->{name});
$t->logWrite("moveFileToOld(..., $f->{name}): renaming $pathNew to $ pathOld\n", 5);		$t->logWrite("moveFileToOld(..., $f->{name}): renaming $pathNew to $ pathOld\n", 5);
$t->pathCreate($pathOld);		$t->pathCreate($pathOld);
$AttrNew->flush(0, $f->{name});		$AttrNew->flush(0, $f->{name});
if ( !rename($pathNew, $pathOld) ) {		if ( !rename($pathNew, $pathOld) ) {
$t->logWrite(sprintf("moveFileToOld(..., %s: can't rename %s to		$t->logWrite(sprintf(
%s ($!, %d, %d, %d)\n",		"moveFileToOld(..., %s: can't rename %s to %s ($!, %d, %d, %
$f->{name}, $pathNew, $pathOld, -e $pathNe		d)\n",
w, -e $pathOld, -d $pathOld));		$f->{name}, $pathNew, $pathOld, -e $pathNew, -e $pathOld, -d
		$pathOld
		));
$t->{xferErrCnt}++;		$t->{xferErrCnt}++;
} else {		} else {
BackupPC::XS::DirOps::refCountAll($pathOld, $a->{compress}, -1, $DeltaNew);		BackupPC::XS::DirOps::refCountAll($pathOld, $a->{compress}, -1, $DeltaNew);
BackupPC::XS::DirOps::refCountAll($pathOld, $a->{compress}, 1, $DeltaOld);		BackupPC::XS::DirOps::refCountAll($pathOld, $a->{compress}, 1, $DeltaOld);
$t->copyInodes($f->{name});		$t->copyInodes($f->{name});
$AttrOld->set($f->{name}, $a, 1);		$AttrOld->set($f->{name}, $a, 1);
}		}
}		}
$AttrNew->delete($f->{name});		$AttrNew->delete($f->{name});
}		}
}		}
sub copyInodes		sub copyInodes
{		{
my($t, $dirName) = @_;		my($t, $dirName) = @_;
my $AttrNew = $t->{AttrNew};		my $AttrNew = $t->{AttrNew};
my $AttrOld = $t->{AttrOld};		my $AttrOld = $t->{AttrOld};
my $DeltaNew = $t->{DeltaNew};		my $DeltaNew = $t->{DeltaNew};
my $DeltaOld = $t->{DeltaOld};		my $DeltaOld = $t->{DeltaOld};
my $bpc = $t->{bpc};		my $bpc = $t->{bpc};
return if ( !defined($AttrOld) );		return if ( !defined($AttrOld) );
my $dirPath = $AttrNew->getFullMangledPath($dirName);		my $dirPath = $AttrNew->getFullMangledPath($dirName);
$t->logWrite("copyInodes: dirName = $dirName, dirPath = $dirPath\n", 4);		$t->logWrite("copyInodes: dirName = $dirName, dirPath = $dirPath\n", 4);
my $attrAll = $AttrNew->getAll($dirName);		my $attrAll = $AttrNew->getAll($dirName);
$bpc->flushXSLibMesgs();		$bpc->flushXSLibMesgs();
#		#
# Add non-attrib directories (ie: directories that were created		# Add non-attrib directories (ie: directories that were created
# to store attributes in deeper directories), since these		# to store attributes in deeper directories), since these
# directories may not appear in the attrib file at this level.		# directories may not appear in the attrib file at this level.
#		#
if ( defined(my $entries = BackupPC::DirOps::dirRead($bpc, $dirPath)) ) {		if ( defined(my $entries = BackupPC::DirOps::dirRead($bpc, $dirPath)) ) {
foreach my $e ( @$entries ) {		foreach my $e ( @$entries ) {
next if ( $e->{name} eq "."		next if ( $e->{name} eq "."
|| $e->{name} eq ".."		|| $e->{name} eq ".."
|| $e->{name} eq "inode"		|| $e->{name} eq "inode"
|| !-d "$dirPath/$e->{name}" );		|| !-d "$dirPath/$e->{name}" );
my $fileUM = $bpc->fileNameUnmangle($e->{name});		my $fileUM = $bpc->fileNameUnmangle($e->{name});
next if ( $attrAll && defined($attrAll->{$fileUM}) );		next if ( $attrAll && defined($attrAll->{$fileUM}) );
$attrAll->{$fileUM} = {		$attrAll->{$fileUM} = {
type => BPC_FTYPE_DIR,		type => BPC_FTYPE_DIR,
noAttrib => 1,		noAttrib => 1,
};		};
}		}
}		}
foreach my $fileUM ( keys(%$attrAll) ) {		foreach my $fileUM ( keys(%$attrAll) ) {
skipping to change at line 1237		skipping to change at line 1233
my $AttrNew = $t->{AttrNew};		my $AttrNew = $t->{AttrNew};
my $AttrOld = $t->{AttrOld};		my $AttrOld = $t->{AttrOld};
my $DeltaNew = $t->{DeltaNew};		my $DeltaNew = $t->{DeltaNew};
my $DeltaOld = $t->{DeltaOld};		my $DeltaOld = $t->{DeltaOld};
my $bpc = $t->{bpc};		my $bpc = $t->{bpc};
my $attribSet = 1;		my $attribSet = 1;
my $newCompress = $t->{compress};		my $newCompress = $t->{compress};
$newCompress = $a->{compress} if ( $a && defined($a->{compress}) );		$newCompress = $a->{compress} if ( $a && defined($a->{compress}) );
$t->logWrite(sprintf("File %s: old digest %s, new digest %s\n", $f->{name},		$t->logWrite(
unpack("H*", $a->{digest}), unpack("H*", $f->{digest})), 5) if ( $a );		sprintf(
		"File %s: old digest %s, new digest %s\n",
		$f->{name},
		unpack("H*", $a->{digest}),
		unpack("H*", $f->{digest})
		),
		5
		) if ( $a );
if ( $same && $a ) {		if ( $same && $a ) {
if ( $a->{type} == $f->{type}		if ( $a->{type} == $f->{type}
&& $a->{mode} == S_IMODE($f->{mode})		&& $a->{mode} == S_IMODE($f->{mode})
&& $a->{uid} == $f->{uid}		&& $a->{uid} == $f->{uid}
&& $a->{gid} == $f->{gid}		&& $a->{gid} == $f->{gid}
&& $a->{size} == $f->{size}		&& $a->{size} == $f->{size}
&& $a->{mtime} == $f->{mtime}		&& $a->{mtime} == $f->{mtime}
&& $a->{digest} eq $f->{digest} ) {		&& $a->{digest} eq $f->{digest} ) {
#		#
# same contents, same attributes, so no need to rewrite		# same contents, same attributes, so no need to rewrite
#		#
$attribSet = 0;		$attribSet = 0;
} else {		} else {
#		#
# same contents, different attributes, so copy to old and		# same contents, different attributes, so copy to old and
# we will write the new attributes below		# we will write the new attributes below
#		#
if ( $AttrOld && !$AttrOld->get($f->{name}) ) {		if ( $AttrOld && !$AttrOld->get($f->{name}) ) {
skipping to change at line 1269		skipping to change at line 1273
}		}
}		}
$f->{inode} = $a->{inode};		$f->{inode} = $a->{inode};
$f->{nlinks} = $a->{nlinks};		$f->{nlinks} = $a->{nlinks};
}		}
} else {		} else {
#		#
# file is new or changed; update ref counts		# file is new or changed; update ref counts
#		#
$DeltaNew->update($newCompress, $f->{digest}, 1)		$DeltaNew->update($newCompress, $f->{digest}, 1)
if ( $f->{digest} ne "" );		if ( $f->{digest} ne "" );
}		}
if ( $attribSet ) {		if ( $attribSet ) {
my $newInode = $f->{inode};		my $newInode = $f->{inode};
$newInode = $t->{Inode}++ if ( !defined($newInode) );		$newInode = $t->{Inode}++ if ( !defined($newInode) );
my $nlinks = 0;		my $nlinks = 0;
$nlinks = $f->{nlinks} if ( defined($f->{nlinks}) );		$nlinks = $f->{nlinks} if ( defined($f->{nlinks}) );
$AttrNew->set($f->{name}, {		$AttrNew->set(
type => $f->{type},		$f->{name},
mode => S_IMODE($f->{mode}),		{
uid => $f->{uid},		type => $f->{type},
gid => $f->{gid},		mode => S_IMODE($f->{mode}),
size => $f->{size},		uid => $f->{uid},
mtime => $f->{mtime},		gid => $f->{gid},
inode => $newInode,		size => $f->{size},
nlinks => $nlinks,		mtime => $f->{mtime},
compress => $newCompress,		inode => $newInode,
digest => $f->{digest},		nlinks => $nlinks,
});		compress => $newCompress,
		digest => $f->{digest},
		}
		);
}		}
$bpc->flushXSLibMesgs();		$bpc->flushXSLibMesgs();
}		}
#		#
# Create the parent directory of $fullPath (if necessary).		# Create the parent directory of $fullPath (if necessary).
# If $noStrip != 0 then $fullPath is the directory to create,		# If $noStrip != 0 then $fullPath is the directory to create,
# rather than the parent.		# rather than the parent.
#		#
sub pathCreate		sub pathCreate
{		{
my($t, $fullPath, $noStrip) = @_;		my($t, $fullPath, $noStrip) = @_;
#		#
# Get parent directory of $fullPath		# Get parent directory of $fullPath
#		#
$t->logWrite("pathCreate: fullPath = $fullPath\n", 6);		$t->logWrite("pathCreate: fullPath = $fullPath\n", 6);
$fullPath =~ s{/[^/]*$}{} if ( !$noStrip );		$fullPath =~ s{/[^/]*$}{} if ( !$noStrip );
return 0 if ( -d $fullPath );		return 0 if ( -d $fullPath );
unlink($fullPath) if ( -e $fullPath );		unlink($fullPath) if ( -e $fullPath );
eval { mkpath($fullPath, 0, 0777) };		eval { mkpath($fullPath, 0, 0777) };
if ( $@ ) {		if ( $@ ) {
$t->logWrite("Can't create $fullPath\n", 1);		$t->logWrite("Can't create $fullPath\n", 1);
$t->{xferErrCnt}++;		$t->{xferErrCnt}++;
return -1;		return -1;
}		}
return 0;		return 0;
}		}
sub fileReadAll		sub fileReadAll
End of changes. 109 change blocks.
236 lines changed or deleted		254 lines changed or added

---