method. This simplifies some of the xfer specific code.
Implemented by Paul Mantz.
* Added FTP xfer method, implemented by Paul Mantz.
* Added BackupPC::Xfer module to provide a common interface to the
different xfer methods. Implemented by Paul Mantz.
* Moved setting of $bpc->{PoolDir} and $bpc->{CPoolDir} after the
config file is read in BackupPC::Lib. Fix proposed by Tim Taylor
and Joe Krahn.
* Create $TopDir and related data directories in BackupPC_dump
prior to hardlink test. Requested by Les Stott.
* Modified lib/BackupPC/CGI/RSS.pm to replace \n with \r\n in the RSS
http response headers. Patch submitted by Thomas Eckhardt.
* Modified bin/BackupPC_archive to allow the archive request file
name to contain spaces and dashes, requested by Tim Massey.
* Fix to configure.pl for --no-fhs case to initialize ConfigDir
from Dan Pritts. Also changed perl path to #!/usr/bin/env perl.
* Modified bin/BackupPC_archiveHost to shell escape the output file
name. That allows it to contain spaces and other special characters.
Requested by Toni Van Remortel.
* Added --config-override to configure.pl, allow config settings to be
set on the command line. Proposed by Les Stott and Holger Parplies.
* Minor updates to lib/BackupPC/Lang/fr.pm from Nicolas STRANSKY
applied by GFK.
* Minor updates to lib/BackupPC/Lang/de.pm from Klaus Weidenbach.
* lib/BackupPC/Xfer/Smb.pm now increments xferErrCnt on NT_STATUS_ACCESS_DENIED
and ERRnoaccess errors from smbclient. Reported by Jesús Martel.
* Modified bin/BackupPC_sendEmail to not send any per-client email if
$Conf{BackupsDisable} is set.
# Version __VERSION__, __RELEASEDATE__
#------------------------------------------------------------------------
+* Added BackupPC::Xfer::Protocol as a common class for each Xfer
+ method. This simplifies some of the xfer specific code.
+ Implemented by Paul Mantz.
+
+* Added FTP xfer method, implemented by Paul Mantz.
+
+* Added BackupPC::Xfer module to provide a common interface to the
+ different xfer methods. Implemented by Paul Mantz.
+
+* Moved setting of $bpc->{PoolDir} and $bpc->{CPoolDir} after the
+ config file is read in BackupPC::Lib. Fix proposed by Tim Taylor
+ and Joe Krahn.
+
+* Create $TopDir and related data directories in BackupPC_dump
+ prior to hardlink test. Requested by Les Stott.
+
+* Modified lib/BackupPC/CGI/RSS.pm to replace \n with \r\n in the RSS
+ http response headers. Patch submitted by Thomas Eckhardt.
+
+* Modified bin/BackupPC_archive to allow the archive request file
+ name to contain spaces and dashes, requested by Tim Massey.
+
+* Fix to configure.pl for --no-fhs case to initialize ConfigDir
+ from Dan Pritts. Also changed perl path to #!/usr/bin/env perl.
+
+* Modified bin/BackupPC_archiveHost to shell escape the output file
+ name. That allows it to contain spaces and other special characters.
+ Requested by Toni Van Remortel.
+
+* Added --config-override to configure.pl, allow config settings to be
+ set on the command line. Proposed by Les Stott and Holger Parplies.
+
+* Minor updates to lib/BackupPC/Lang/fr.pm from Nicolas STRANSKY
+ applied by GFK.
+
+* Minor updates to lib/BackupPC/Lang/de.pm from Klaus Weidenbach.
+
+* lib/BackupPC/Xfer/Smb.pm now increments xferErrCnt on NT_STATUS_ACCESS_DENIED
+ and ERRnoaccess errors from smbclient. Reported by Jesús Martel.
+
+* Modified bin/BackupPC_sendEmail to not send any per-client email if
+ $Conf{BackupsDisable} is set.
+
#------------------------------------------------------------------------
# Version 3.1.0, 25 Nov 2007
#------------------------------------------------------------------------
}
$user = $1 if ( $ARGV[0] =~ /(.+)/ );
$client = $1 if ( $ARGV[1] =~ /(.+)/ );
-if ( $ARGV[2] !~ /^([\w.]+)$/ ) {
+if ( $ARGV[2] !~ /^([\w\.\s-]+)$/ ) {
print("$0: bad reqFileName (arg #3): $ARGV[2]\n");
exit(1);
}
#
# Build the command we will run
#
-$share = $bpc->shellEscape($share);
-$host = $bpc->shellEscape($host);
+$share = $bpc->shellEscape($share);
+$host = $bpc->shellEscape($host);
+my $outLocE = $bpc->shellEscape($outLoc);
#
# We prefer to use /bin/csh because the exit status of a pipeline
#
# Output file is a device or a regular file, so don't use split
#
- $cmd .= ">> $outLoc";
- $mesg .= " to $outLoc";
+ $cmd .= ">> $outLocE";
+ $mesg .= " to $outLocE";
} else {
mkpath($outLoc) if ( !-d $outLoc );
if ( !-d $outLoc ) {
exit(1);
}
if ( $splitSize > 0 && -x $splitPath ) {
- $cmd .= "| $splitPath -b $splitSize - $outLoc/$host.$bkupNum.tar$fileExt.";
- $mesg .= ", split to output files $outLoc/$host.$bkupNum.tar$fileExt.*";
+ $cmd .= "| $splitPath -b $splitSize - $outLocE/$host.$bkupNum.tar$fileExt.";
+ $mesg .= ", split to output files $outLocE/$host.$bkupNum.tar$fileExt.*";
} else {
- $cmd .= "> $outLoc/$host.$bkupNum.tar$fileExt";
- $mesg .= " to output file $outLoc/$host.$bkupNum.tar$fileExt";
+ $cmd .= "> $outLocE/$host.$bkupNum.tar$fileExt";
+ $mesg .= " to output file $outLocE/$host.$bkupNum.tar$fileExt";
}
}
print("$mesg\n");
if ( -d $outLoc && -x $parPath ) {
if ( $parfile != 0 ) {
print("Running $parPath to create parity files\n");
- my $parCmd = "$parPath c -r$parfile $outLoc/$host.$bkupNum.tar$fileExt.par2 $outLoc/$host.$bkupNum.tar$fileExt*";
+ my $parCmd = "$parPath c -r$parfile $outLocE/$host.$bkupNum.tar$fileExt.par2 $outLocE/$host.$bkupNum.tar$fileExt*";
$ret = system($parCmd);
if ( $ret ) {
print("Executing: $parCmd\n");
use BackupPC::Lib;
use BackupPC::FileZIO;
use BackupPC::Storage;
-use BackupPC::Xfer::Smb;
-use BackupPC::Xfer::Tar;
-use BackupPC::Xfer::Rsync;
-use BackupPC::Xfer::BackupPCd;
+use BackupPC::Xfer;
use Encode;
use Socket;
use File::Path;
NothingToDo($needLink);
}
+#
+# Create top-level directories if they don't exist
+#
+foreach my $dir ( (
+ "$Conf{TopDir}",
+ "$Conf{TopDir}/pool",
+ "$Conf{TopDir}/cpool",
+ "$Conf{TopDir}/pc",
+ "$Conf{TopDir}/trash",
+ ) ) {
+ next if ( -d $dir );
+ mkpath($dir, 0, 0750);
+ if ( !-d $dir ) {
+ print("Failed to create $dir\n");
+ printf(LOG "%sFailed to create directory %s\n", $bpc->timeStamp, $dir);
+ print("link $clientURI\n") if ( $needLink );
+ exit(1);
+ } else {
+ printf(LOG "%sCreated directory %s\n", $bpc->timeStamp, $dir);
+ }
+}
+
if ( !$bpc->HardlinkTest($Dir, "$TopDir/cpool") ) {
print(LOG $bpc->timeStamp, "Can't create a test hardlink between a file"
. " in $Dir and $TopDir/cpool. Either these are different"
my($logMsg, %stat, $xfer, $ShareNames, $noFilesErr);
my $newFilesFH;
-if ( $Conf{XferMethod} eq "tar" ) {
- $ShareNames = $Conf{TarShareName};
-} elsif ( $Conf{XferMethod} eq "rsync" || $Conf{XferMethod} eq "rsyncd" ) {
- $ShareNames = $Conf{RsyncShareName};
-} elsif ( $Conf{XferMethod} eq "backuppcd" ) {
- $ShareNames = $Conf{BackupPCdShareName};
-} else {
- $ShareNames = $Conf{SmbShareName};
-}
-
-$ShareNames = [ $ShareNames ] unless ref($ShareNames) eq "ARRAY";
+$ShareNames = BackupPC::Xfer::getShareNames(\%Conf);
#
# Run an optional pre-dump command
exit(1);
}
- if ( $Conf{XferMethod} eq "tar" ) {
- #
- # Use tar (eg: tar/ssh) as the transport program.
- #
- $xfer = BackupPC::Xfer::Tar->new($bpc);
- } elsif ( $Conf{XferMethod} eq "rsync" || $Conf{XferMethod} eq "rsyncd" ) {
- #
- # Use rsync as the transport program.
- #
- if ( !defined($xfer = BackupPC::Xfer::Rsync->new($bpc)) ) {
- my $errStr = BackupPC::Xfer::Rsync::errStr;
- print(LOG $bpc->timeStamp, "dump failed: $errStr\n");
- print("dump failed: $errStr\n");
- UserCommandRun("DumpPostShareCmd", $shareName) if ( $NeedPostCmd );
- UserCommandRun("DumpPostUserCmd") if ( $NeedPostCmd );
- exit(1);
- }
- } elsif ( $Conf{XferMethod} eq "backuppcd" ) {
- #
- # Use backuppcd as the transport program.
- #
- if ( !defined($xfer = BackupPC::Xfer::BackupPCd->new($bpc)) ) {
- my $errStr = BackupPC::Xfer::BackupPCd::errStr;
- print(LOG $bpc->timeStamp, "dump failed: $errStr\n");
- print("dump failed: $errStr\n");
- UserCommandRun("DumpPostShareCmd", $shareName) if ( $NeedPostCmd );
- UserCommandRun("DumpPostUserCmd") if ( $NeedPostCmd );
- exit(1);
- }
- } else {
- #
- # Default is to use smbclient (smb) as the transport program.
- #
- $xfer = BackupPC::Xfer::Smb->new($bpc);
+ $xfer = BackupPC::Xfer::create($Conf{XferMethod}, $bpc);
+ if ( !defined($xfer) ) {
+ my $errStr = BackupPC::Xfer::errStr();
+ print(LOG $bpc->timeStamp, "dump failed: $errStr\n");
+ print("dump failed: $errStr\n");
+ UserCommandRun("DumpPostShareCmd", $shareName) if ( $NeedPostCmd );
+ UserCommandRun("DumpPostUserCmd") if ( $NeedPostCmd );
+ exit(1);
}
my $useTar = $xfer->useTar;
# we use a select.
#
my($FDread, $tarOut, $mesg);
- vec($FDread, fileno(TAR), 1) = 1 if ( $useTar );
+ vec($FDread, fileno(TAR), 1) = 1;
$xfer->setSelectMask(\$FDread);
SCAN: while ( 1 ) {
my $ein = $FDread;
last if ( $FDread =~ /^\0*$/ );
select(my $rout = $FDread, undef, $ein, undef);
- if ( $useTar ) {
- if ( vec($rout, fileno(TAR), 1) ) {
- if ( sysread(TAR, $mesg, 8192) <= 0 ) {
- vec($FDread, fileno(TAR), 1) = 0;
- close(TAR);
- } else {
- $tarOut .= $mesg;
- }
- }
- while ( $tarOut =~ /(.*?)[\n\r]+(.*)/s ) {
- $_ = $1;
- $tarOut = $2;
- if ( /^ / ) {
- $XferLOG->write(\"$_\n");
- } else {
- $XferLOG->write(\"tarExtract: $_\n");
- }
- if ( /^BackupPC_tarExtact aborting \((.*)\)/ ) {
- $stat{hostError} = $1;
- }
- if ( /^Done: (\d+) errors, (\d+) filesExist, (\d+) sizeExist, (\d+) sizeExistComp, (\d+) filesTotal, (\d+) sizeTotal/ ) {
- $tarErrs += $1;
- $nFilesExist += $2;
- $sizeExist += $3;
- $sizeExistComp += $4;
- $nFilesTotal += $5;
- $sizeTotal += $6;
- }
- }
- }
+ if ( vec($rout, fileno(TAR), 1) ) {
+ if ( sysread(TAR, $mesg, 8192) <= 0 ) {
+ vec($FDread, fileno(TAR), 1) = 0;
+ close(TAR);
+ } else {
+ $tarOut .= $mesg;
+ }
+ }
+ while ( $tarOut =~ /(.*?)[\n\r]+(.*)/s ) {
+ $_ = $1;
+ $tarOut = $2;
+ if ( /^ / ) {
+ $XferLOG->write(\"$_\n");
+ } else {
+ $XferLOG->write(\"tarExtract: $_\n");
+ }
+ if ( /^BackupPC_tarExtact aborting \((.*)\)/ ) {
+ $stat{hostError} = $1;
+ }
+ if ( /^Done: (\d+) errors, (\d+) filesExist, (\d+) sizeExist, (\d+) sizeExistComp, (\d+) filesTotal, (\d+) sizeTotal/ ) {
+ $tarErrs += $1;
+ $nFilesExist += $2;
+ $sizeExist += $3;
+ $sizeExistComp += $4;
+ $nFilesTotal += $5;
+ $sizeTotal += $6;
+ }
+ }
last if ( !$xfer->readOutput(\$FDread, $rout) );
while ( my $str = $xfer->logMsgGet ) {
print(LOG $bpc->timeStamp, "xfer: $str\n");
use lib "/usr/local/BackupPC/lib";
use BackupPC::Lib;
use BackupPC::FileZIO;
-use BackupPC::Xfer::Smb;
-use BackupPC::Xfer::Tar;
-use BackupPC::Xfer::Rsync;
-use BackupPC::Xfer::BackupPCd;
+use BackupPC::Xfer;
use Socket;
use File::Path;
}
$NeedPostCmd = 1;
-if ( $Conf{XferMethod} eq "tar" ) {
- #
- # Use tar (eg: tar/ssh) as the transport program.
- #
- $xfer = BackupPC::Xfer::Tar->new($bpc);
-} elsif ( $Conf{XferMethod} eq "rsync" || $Conf{XferMethod} eq "rsyncd" ) {
- #
- # Use rsync as the transport program.
- #
- if ( !defined($xfer = BackupPC::Xfer::Rsync->new($bpc)) ) {
- my $errStr = BackupPC::Xfer::Rsync->errStr;
- UserCommandRun("RestorePostUserCmd") if ( $NeedPostCmd );
- $stat{hostError} = $errStr;
- exit(RestoreCleanup($client));
- }
-} elsif ( $Conf{XferMethod} eq "backuppcd" ) {
- #
- # Use backuppcd as the transport program.
- #
- if ( !defined($xfer = BackupPC::Xfer::BackupPCd->new($bpc)) ) {
- my $errStr = BackupPC::Xfer::BackupPCd->errStr;
- UserCommandRun("RestorePostUserCmd") if ( $NeedPostCmd );
- $stat{hostError} = $errStr;
- exit(RestoreCleanup($client));
- }
-} else {
- #
- # Default is to use smbclient (smb) as the transport program.
- #
- $xfer = BackupPC::Xfer::Smb->new($bpc);
+$xfer = BackupPC::Xfer::create($Conf{XferMethod}, $bpc);
+if ( !defined($xfer) ) {
+ my $errStr = BackupPC::Xfer::errStr();
+ UserCommandRun("RestorePostUserCmd") if ( $NeedPostCmd );
+ $stat{hostError} = $errStr;
+ exit(RestoreCleanup($client));
}
+
my $useTar = $xfer->useTar;
if ( $useTar ) {
use lib "/usr/local/BackupPC/lib";
use BackupPC::Lib;
use BackupPC::FileZIO;
+use Encode;
use Data::Dumper;
use Getopt::Std;
sub sendUserEmail
{
my($user, $host, $mesg, $subj, $vars) = @_;
+ return if ( $Conf{BackupsDisable} );
+
$vars->{user} = $user;
$vars->{host} = $host;
$vars->{headers} = $Conf{EMailHeaders};
$vars->{domain} = $Conf{EMailUserDestDomain};
$vars->{CgiURL} = $Conf{CgiURL};
$subj =~ s/\$(\w+)/defined($vars->{$1}) ? $vars->{$1} : "\$$1"/eg;
- $vars->{subj} = $subj;
+ $vars->{subj} = $subj;
$mesg =~ s/\$(\w+)/defined($vars->{$1}) ? $vars->{$1} : "\$$1"/eg;
SendMail($mesg);
$UserEmailInfo{$user}{lastTime} = time;
if ( $opts{t} ) {
binmode(STDOUT, ":utf8") if ( $utf8 );
+
print("#" x 75, "\n");
print $mesg;
return;
#
$Conf{ClientCharsetLegacy} = 'iso-8859-1';
+###########################################################################
+# Samba Configuration
+# (can be overwritten in the per-PC log file)
+###########################################################################
#
# Name of the host share that is backed up when using SMB. This can be a
# string or an array of strings if there are multiple shares per host.
. ' $I_option -U $userName -E -N -d 1'
. ' -c tarmode\\ full -Tx -';
+###########################################################################
+# Tar Configuration
+# (can be overwritten in the per-PC log file)
+###########################################################################
#
# Which host directories to backup when using tar transport. This can be a
# string or an array of strings if there are multiple directories to
#
$Conf{TarClientPath} = '';
+###########################################################################
+# Rsync/Rsyncd Configuration
+# (can be overwritten in the per-PC log file)
+###########################################################################
#
# Path to rsync executable on the client
#
#
];
+###########################################################################
+# FTP Configuration
+# (can be overwritten in the per-PC log file)
+##########################################################################
+#
+# Name of the host share that is backed up when using FTP. This can be a
+# string or an array of strings if there are multiple shares per host.
+# Examples:
+#
+# $Conf{FtpShareName} = 'c'; # backup 'c' share
+# $Conf{FtpShareName} = ['c', 'd']; # backup 'c' and 'd' shares
+#
+# This setting only matters if $Conf{XferMethod} = 'ftp'.
+#
+$Conf{FtpShareName} = '';
+
+#
+# FTP user name. This is used to log into the server.
+#
+# This setting is used only if $Conf{XferMethod} = 'ftp'.
+#
+$Conf{FtpUserName} = '';
+
+#
+# FTP user password. This is used to log into the server.
+#
+# This setting is used only if $Conf{XferMethod} = 'ftp'.
+#
+$Conf{FtpPasswd} = '';
+
+#
+# Transfer block size. This sets the size of the amounts of data in
+# each frame. While undefined, this value takes the default value.
+#
+# This setting is used only if $Conf{XferMethod} = 'ftp'.
+#
+$Conf{FtpBlockSize} = 10240;
+
+#
+# The port of the ftp server. If undefined, 21 is used.
+#
+# This setting is used only if $Conf{XferMethod} = 'ftp'.
+#
+$Conf{FtpPort} = 21;
+
+#
+# Connection timeout for FTP. When undefined, the default is 120 seconds.
+#
+# This setting is used only if $Conf{XferMethod} = 'ftp'.
+#
+$Conf{FtpTimeout} = 120;
+
+#
+# Behaviour when BackupPC encounters symlinks on the FTP share.
+#
+# Symlinks cannot be restored via FTP, so the desired behaviour will
+# be different depending on the setup of the share. The default for
+# this behavor is 1. Directory shares with more complicated directory
+# structures should consider other protocols.
+#
+$Conf{FtpFollowSymlinks} = 0;
+
+
+###########################################################################
+# BackupPCd Configuration
+# (can be overwritten in the per-PC log file)
+###########################################################################
#
# Share name to backup. For $Conf{XferMethod} = "backuppcd" this should
# be a file system path, eg '/' or '/home'.
#
$Conf{BackupPCdRestoreCmd} = '$bpcdPath TODO';
-
+###########################################################################
+# Archive Configuration
+# (can be overwritten in the per-PC log file)
+###########################################################################
#
# Archive Destination
#
RsyncClientCmd => 0,
RsyncClientRestoreCmd => 0,
RsyncClientPath => 0,
+ FtpShareName => 1,
+ FtpUserName => 1,
+ FtpPasswd => 1,
+ FtpBlockSize => 1,
+ FtpPort => 1,
+ FtpTimeout => 1,
+ BackupPCdPath => 1,
+ BackupPCdShareName => 1,
+ BackupPCdCmd => 1,
+ BackupPCdRestoreCmd => 1,
ArchiveDest => 1,
ArchiveComp => 1,
ArchivePar => 1,
-#!/bin/perl
+#!/usr/bin/env perl
#============================================================= -*-perl-*-
#
# configure.pl: Configuration and installation program for BackupPC
"cgi-dir=s",
"compress-level=i",
"config-path=s",
+ "config-override=s%",
"config-dir=s",
"data-dir=s",
"dest-dir=s",
# Create defaults for FHS setup
#
if ( $opts{fhs} ) {
- $Conf{TopDir} ||= "/data/BackupPC";
- $Conf{ConfDir} ||= $opts{"config-dir"} || "/etc/BackupPC";
- $Conf{InstallDir} ||= "/usr/local/BackupPC";
- $Conf{LogDir} ||= $opts{"log-dir"} || "/var/log/BackupPC";
+ $Conf{TopDir} ||= $opts{"data-dir"} || "/data/BackupPC";
+ $Conf{ConfDir} ||= $opts{"config-dir"} || "/etc/BackupPC";
+ $Conf{InstallDir} ||= $opts{"install-dir"} || "/usr/local/BackupPC";
+ $Conf{LogDir} ||= $opts{"log-dir"} || "/var/log/BackupPC";
+} else {
+ $Conf{TopDir} ||= $opts{"data-dir"} || "/data/BackupPC";
+ $Conf{ConfDir} ||= $opts{"config-dir"} || "$Conf{TopDir}/conf";
+ $Conf{InstallDir} ||= $opts{"install-dir"} || "/usr/local/BackupPC";
+ $Conf{LogDir} ||= $opts{"log-dir"} || "$Conf{TopDir}/log";
}
#
lib/BackupPC/Storage
lib/BackupPC/Xfer
lib/BackupPC/Zip
+ lib/Net/FTP
) ) {
next if ( -d "$DestDir$Conf{InstallDir}/$dir" );
mkpath("$DestDir$Conf{InstallDir}/$dir", 0, 0755);
InstallFile("init.d/src/$init", "init.d/$init", 0444);
}
+printf("Making Apache configuration file for suid-perl\n");
+InstallFile("httpd/src/BackupPC.conf", "httpd/BackupPC.conf", 0644);
+
printf("Installing docs in $DestDir$Conf{InstallDir}/doc\n");
foreach my $doc ( qw(BackupPC.pod BackupPC.html) ) {
InstallFile("doc/$doc", "$DestDir$Conf{InstallDir}/doc/$doc", 0444);
=~ s/(\s*\$Conf\{.*?\}\s*=\s*).*/$1$value/s;
}
+#
+# Apply any command-line configuration parameter settings
+#
+foreach my $param ( keys(%{$opts{"config-override"}}) ) {
+ my $val = eval { $opts{"config-override"}{$param} };
+ if ( @$ ) {
+ printf("Can't eval --config-override setting %s=%s\n",
+ $param, $opts{"config-override"}{$param});
+ exit(1);
+ }
+ if ( !defined($newVars->{$param}) ) {
+ printf("Unkown config parameter %s in --config-override\n", $param);
+ exit(1);
+ }
+ $newConf->[$newVars->{$param}]{text} = $opts{"config-override"}{$param};
+}
+
#
# Now backup and write the config file
#
if ( $prog =~ /Lib.pm/ );
s/__BACKUPPCUSER__/$Conf{BackupPCUser}/g;
s/__CGIDIR__/$Conf{CgiDir}/g;
+ s/__IMAGEDIR__/$Conf{CgiImageDir}/g;
+ s/__IMAGEDIRURL__/$Conf{CgiImageDirURL}/g;
if ( $first && /^#.*bin\/perl/ ) {
#
# Fill in correct path to perl (no taint for >= 2.0.1).
--- /dev/null
+#
+# DESCRIPTION
+#
+# This file controls access and configuration for the BackupPC CGI
+# interface.
+#
+# Distributed with BackupPC version 3.1.1, released 22 Dec 2008.
+
+<Directory __CGIDIR__ >
+
+#
+# This section tells apache which machines can access the interface.
+# You can change the allow line to allow access from your local
+# network, or comment out this region to allow access from all
+# machines.
+#
+order deny,allow
+deny from all
+allow from 127.0.0.1
+
+#
+# You can change the authorization method to LDAP or another method
+# besides htaccess here if you are so inclined.
+#
+AuthType Basic
+AuthUserFile __CONFDIR__/BackupPC.users
+AuthName "BackupPC Community Edition Administrative Interface"
+require valid-user
+
+</Directory>
+
+Alias __IMAGEDIRURL__ __IMAGEDIR__
+ScriptAlias /BackupPC_Admin __CGIDIR__/BackupPC_Admin
#
#========================================================================
#
-# Version 3.1.0, released 25 Nov 2007.
+# Version 3.1.1, released 22 Dec 2008.
#
# See http://backuppc.sourceforge.net.
#
{name => "ClientCharset"},
{name => "ClientCharsetLegacy"},
+ ### Smb Settings
{text => "CfgEdit_Title_Smb_Settings",
visible => sub { return $_[0]->{XferMethod} eq "smb"; } },
{name => "SmbShareName",
{name => "SmbSharePasswd",
visible => sub { return $_[0]->{XferMethod} eq "smb"; } },
+ ### Tar Settings
{text => "CfgEdit_Title_Tar_Settings",
visible => sub { return $_[0]->{XferMethod} eq "tar"; } },
{name => "TarShareName",
visible => sub { return $_[0]->{XferMethod} eq "tar"; } },
+ ### Rsync Settings
{text => "CfgEdit_Title_Rsync_Settings",
visible => sub { return $_[0]->{XferMethod} eq "rsync"; } },
{text => "CfgEdit_Title_Rsyncd_Settings",
{name => "RsyncCsumCacheVerifyProb",
visible => sub { return $_[0]->{XferMethod} =~ /rsync/; } },
+ ### Ftp Settings
+ {text => "CfgEdit_Title_Ftp_Settings",
+ visible => sub { return $_[0]->{XferMethod} eq "ftp"; } },
+ {name => "FtpShareName",
+ visible => sub { return $_[0]->{XferMethod} eq "ftp"; } },
+ {name => "FtpUserName",
+ visible => sub { return $_[0]->{XferMethod} eq "ftp"; } },
+ {name => "FtpPasswd",
+ visible => sub { return $_[0]->{XferMethod} eq "ftp"; } },
+ {name => "FtpBlockSize",
+ visible => sub { return $_[0]->{XferMethod} eq "ftp"; } },
+ {name => "FtpPort",
+ visible => sub { return $_[0]->{XferMethod} eq "ftp"; } },
+ {name => "FtpTimeout",
+ visible => sub { return $_[0]->{XferMethod} eq "ftp"; } },
+ {name => "FtpFollowSymlinks",
+ visible => sub { return $_[0]->{XferMethod} eq "ftp"; } },
+
+ ### BackupPCd Settings
{text => "CfgEdit_Title_BackupPCd_Settings",
visible => sub { return $_[0]->{XferMethod} eq "backuppcd"; } },
{name => "BackupPCdShareName",
{name => "BackupPCdRestoreCmd",
visible => sub { return $_[0]->{XferMethod} eq "backuppcd"; } },
+ ### Archive Settings
{text => "CfgEdit_Title_Archive_Settings",
visible => sub { return $_[0]->{XferMethod} eq "archive"; } },
{name => "ArchiveDest",
{name => "ArchiveSplit",
visible => sub { return $_[0]->{XferMethod} eq "archive"; } },
+ ### Include/Exclude Settings
{text => "CfgEdit_Title_Include_Exclude",
visible => sub { return $_[0]->{XferMethod} ne "archive"; } },
{name => "BackupFilesOnly",
{name => "BackupFilesExclude",
visible => sub { return $_[0]->{XferMethod} ne "archive"; } },
+ ### Samba paths and commands
{text => "CfgEdit_Title_Smb_Paths_Commands",
visible => sub { return $_[0]->{XferMethod} eq "smb"; } },
{name => "SmbClientPath",
{name => "SmbClientRestoreCmd",
visible => sub { return $_[0]->{XferMethod} eq "smb"; } },
+ ### Tar paths and commands
{text => "CfgEdit_Title_Tar_Paths_Commands",
visible => sub { return $_[0]->{XferMethod} eq "tar"; } },
{name => "TarClientPath",
{name => "TarClientRestoreCmd",
visible => sub { return $_[0]->{XferMethod} eq "tar"; } },
+ ### Rsync paths and commands
{text => "CfgEdit_Title_Rsync_Paths_Commands_Args",
visible => sub { return $_[0]->{XferMethod} eq "rsync"; } },
{text => "CfgEdit_Title_Rsyncd_Port_Args",
{name => "RsyncRestoreArgs",
visible => sub { return $_[0]->{XferMethod} =~ /rsync/; } },
+ ### Archive paths and commands
{text => "CfgEdit_Title_Archive_Paths_Commands",
visible => sub { return $_[0]->{XferMethod} eq "archive"; } },
{name => "ArchiveClientCmd",
$incrSizeTot = sprintf("%.2f", $incrSizeTot / 1000);
my $now = timeStamp2(time);
- print 'Content-type: text/xml', "\n\n",
+ print 'Content-type: text/xml', "\r\n\r\n",
$rss->as_string;
}
#
#========================================================================
#
-# Version 3.1.0, released 25 Nov 2007.
+# Version 3.1.1, released 22 Dec 2008.
#
# See http://backuppc.sourceforge.net.
#
######################################################################
XferMethod => {
type => "select",
- values => [qw(archive rsync rsyncd smb tar)],
+ values => [qw(archive ftp rsync rsyncd smb tar)],
},
XferLogLevel => "integer",
ClientCharset => "string",
ClientCharsetLegacy => "string",
+ ######################################################################
+ # Smb Configuration
+ ######################################################################
SmbShareName => {
type => "list",
child => "string",
SmbClientIncrCmd => "string",
SmbClientRestoreCmd => {type => "string", undefIfEmpty => 1},
+ ######################################################################
+ # Tar Configuration
+ ######################################################################
TarShareName => {
type => "list",
child => "string",
TarClientRestoreCmd => {type => "string", undefIfEmpty => 1},
TarClientPath => {type => "string", undefIfEmpty => 1},
+ ######################################################################
+ # Rsync Configuration
+ ######################################################################
RsyncShareName => {
type => "list",
child => "string",
RsyncClientCmd => "string",
RsyncClientRestoreCmd => "string",
+ ######################################################################
+ # Rsyncd Configuration
+ ######################################################################
RsyncdClientPort => "integer",
RsyncdUserName => "string",
RsyncdPasswd => "string",
RsyncdAuthRequired => "boolean",
+ ######################################################################
+ # Rsync(d) Options
+ ######################################################################
RsyncCsumCacheVerifyProb => "float",
RsyncArgs => {
type => "list",
child => "string",
},
+ ######################################################################
+ # FTP Configuration
+ ######################################################################
+ FtpShareName => {
+ type => "list",
+ child => "string",
+ },
+ FtpUserName => "string",
+ FtpPasswd => "string",
+ FtpBlockSize => "integer",
+ FtpPort => "integer",
+ FtpTimeout => "integer",
+ FtpFollowSymlinks => "boolean",
+
+ ######################################################################
+ # BackupPCd Configuration
+ ######################################################################
+ BackupPCdShareName => {
+ type => "list",
+ child => "string",
+ },
BackupPCdCmd => "string",
BackupPCdPath => "string",
- BackupPCdShareName => "string",
BackupPCdRestoreCmd => "string",
+ ######################################################################
+ # Archive Configuration
+ ######################################################################
ArchiveDest => "string",
ArchiveComp => {
type => "select",
ArchiveSplit => "float",
ArchiveClientCmd => "string",
+ ######################################################################
+ # Other Client Configuration
+ ######################################################################
NmbLookupCmd => "string",
NmbLookupFindHostCmd => "string",
RsyncClientCmd => "boolean",
RsyncClientPath => "boolean",
RsyncClientRestoreCmd => "boolean",
+ FtpShareName => "boolean",
+ FtpUserName => "boolean",
+ FtpPasswd => "boolean",
+ FtpBlockSize => "boolean",
+ FtpPort => "boolean",
+ FtpTimeout => "boolean",
+ BackupPCdShareName => "boolean",
+ BackupPCdCmd => "boolean",
+ BackupPCdPath => "boolean",
+ BackupPCdRestoreCmd => "boolean",
ArchiveDest => "boolean",
ArchiveComp => "boolean",
ArchivePar => "boolean",
<li>Dieser Status wurde am \$now generiert.
<li>Das Pool Filesystem (Backup-Speicherplatz) ist zu \$Info{DUlastValue}%
(\$DUlastTime) voll, das Maximum heute ist \$Info{DUDailyMax}% (\$DUmaxTime)
- und das Maximum gestern war \$Info{DUDailyMaxPrev}%. (Hinweis: Sollten ca. 70% ?berschritten werden, so
- ist evtl. bald eine Erweiterung des Backupspeichers erforderlich. Ist weitere Planung n?tig?)
+ und das Maximum gestern war \$Info{DUDailyMaxPrev}%. (Hinweis: Sollten ca. 70% überschritten werden, so
+ ist evtl. bald eine Erweiterung des Backupspeichers erforderlich. Ist weitere Planung nötig?)
</ul>
</p>
$Lang{CfgEdit_Title_Tar_Settings} = "Tar Einstellungen";
$Lang{CfgEdit_Title_Rsync_Settings} = "Rsync Einstellungen";
$Lang{CfgEdit_Title_Rsyncd_Settings} = "Rsyncd Einstellungen";
+$Lang{CfgEdit_Title_Ftp_Settings} = "FTP Einstellungen";
$Lang{CfgEdit_Title_BackupPCd_Settings} = "BackupPCd Einstellungen";
$Lang{CfgEdit_Title_Archive_Settings} = "Archive Einstellungen";
$Lang{CfgEdit_Title_Include_Exclude} = "Include/Exclude";
$Lang{CfgEdit_Title_Tar_Settings} = "Tar Settings";
$Lang{CfgEdit_Title_Rsync_Settings} = "Rsync Settings";
$Lang{CfgEdit_Title_Rsyncd_Settings} = "Rsyncd Settings";
+$Lang{CfgEdit_Title_Ftp_Settings} = "FTP Settings";
$Lang{CfgEdit_Title_BackupPCd_Settings} = "BackupPCd Settings";
$Lang{CfgEdit_Title_Archive_Settings} = "Archive Settings";
$Lang{CfgEdit_Title_Include_Exclude} = "Include/Exclude";
$Lang{CfgEdit_Title_Tar_Settings} = "Tar Settings";
$Lang{CfgEdit_Title_Rsync_Settings} = "Rsync Settings";
$Lang{CfgEdit_Title_Rsyncd_Settings} = "Rsyncd Settings";
+$Lang{CfgEdit_Title_Ftp_Settings} = "FTP Settings";
$Lang{CfgEdit_Title_BackupPCd_Settings} = "BackupPCd Settings";
$Lang{CfgEdit_Title_Archive_Settings} = "Archive Settings";
$Lang{CfgEdit_Title_Include_Exclude} = "Include/Exclude";
$Lang{CfgEdit_Title_Tar_Settings} = "Paramètres de Tar";
$Lang{CfgEdit_Title_Rsync_Settings} = "Paramètres de Rsync";
$Lang{CfgEdit_Title_Rsyncd_Settings} = "Paramètres de Rsyncd";
+$Lang{CfgEdit_Title_Ftp_Settings} = "Paramètres de FTP";
$Lang{CfgEdit_Title_BackupPCd_Settings} = "Paramètres de BackupPCd";
$Lang{CfgEdit_Title_Archive_Settings} = "Paramètres d'archivage";
$Lang{CfgEdit_Title_Include_Exclude} = "Inclure/Exclure";
$Lang{CfgEdit_Title_Tar_Settings} = "Configurazione Tar";
$Lang{CfgEdit_Title_Rsync_Settings} = "Configurazione Rsync";
$Lang{CfgEdit_Title_Rsyncd_Settings} = "Configurazione Rsyncd";
+$Lang{CfgEdit_Title_Ftp_Settings} = "Configurazione FTP";
$Lang{CfgEdit_Title_BackupPCd_Settings} = "Configurazione BackupPCd";
$Lang{CfgEdit_Title_Archive_Settings} = "Configurazione Archivi";
$Lang{CfgEdit_Title_Include_Exclude} = "Includi/Escludi";
$Lang{CfgEdit_Title_Tar_Settings} = "Tar instellingen";
$Lang{CfgEdit_Title_Rsync_Settings} = "Rsync instellingen";
$Lang{CfgEdit_Title_Rsyncd_Settings} = "Rsyncd instellingen";
+$Lang{CfgEdit_Title_Ftp_Settings} = "FTP instellingen";
$Lang{CfgEdit_Title_BackupPCd_Settings} = "BackupPCd instellingen";
$Lang{CfgEdit_Title_Archive_Settings} = "Archivering instellingen";
$Lang{CfgEdit_Title_Include_Exclude} = "Inclusief/Exclusief";
$Lang{CfgEdit_Title_Tar_Settings} = "Ustawienia Tar";
$Lang{CfgEdit_Title_Rsync_Settings} = "Ustawienia Rsync";
$Lang{CfgEdit_Title_Rsyncd_Settings} = "Ustawienia Rsyncd";
+$Lang{CfgEdit_Title_Ftp_Settings} = "Ustawienia FTP";
$Lang{CfgEdit_Title_BackupPCd_Settings} = "Ustawienia BackupPCd";
$Lang{CfgEdit_Title_Archive_Settings} = "Ustawienia Archiwizacji";
$Lang{CfgEdit_Title_Include_Exclude} = "Dodaj/Usuń";
$Lang{CfgEdit_Title_Xfer} = "Transferência";
$Lang{CfgEdit_Title_Xfer_Settings} = "Configurações de transferência";
$Lang{CfgEdit_Title_Smb_Settings} = "Configurações do Smb";
-$Lang{CfgEdit_Title_Tar_Settings} = "Configurações doTar";
+$Lang{CfgEdit_Title_Tar_Settings} = "Configurações do Tar";
$Lang{CfgEdit_Title_Rsync_Settings} = "Configurações do Rsync";
$Lang{CfgEdit_Title_Rsyncd_Settings} = "Configurações do Rsyncd";
+$Lang{CfgEdit_Title_Ftp_Settings} = "Configurações do FTP";
$Lang{CfgEdit_Title_BackupPCd_Settings} = "Configurações do BackupPCd";
$Lang{CfgEdit_Title_Archive_Settings} = "Configurações do Archive";
$Lang{CfgEdit_Title_Include_Exclude} = "Inclui/Exclui";
$Lang{CfgEdit_Title_Tar_Settings} = "Tar 设置";
$Lang{CfgEdit_Title_Rsync_Settings} = "Rsync 设置";
$Lang{CfgEdit_Title_Rsyncd_Settings} = "Rsyncd 设置";
+$Lang{CfgEdit_Title_Ftp_Settings} = "FTP 设置";
$Lang{CfgEdit_Title_BackupPCd_Settings} = "BackupPCd 设置";
$Lang{CfgEdit_Title_Archive_Settings} = "备档设置";
$Lang{CfgEdit_Title_Include_Exclude} = "包含／排除";
#
#========================================================================
#
-# Version 3.1.0, released 25 Nov 2007.
+# Version 3.2.0, released 31 Dec 2008.
#
# See http://backuppc.sourceforge.net.
#
use Config;
use Encode qw/from_to encode_utf8/;
-use vars qw( $IODirentOk );
+use vars qw( $IODirentOk $IODirentLoaded );
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
require Exporter;
BEGIN {
eval "use IO::Dirent qw( readdirent DT_DIR );";
- if ( !$@ && opendir(my $fh, ".") ) {
- #
- # Make sure the IO::Dirent really works - some installs
- # on certain file systems don't return a valid type.
- #
- my $dt_dir = eval("DT_DIR");
- foreach my $e ( readdirent($fh) ) {
- if ( $e->{name} eq "." && $e->{type} == $dt_dir ) {
- $IODirentOk = 1;
- last;
- }
- }
- closedir($fh);
- }
+ $IODirentLoaded = 1 if ( !$@ );
};
#
#
# Set defaults for $topDir and $installDir.
#
- $topDir = '/tera0/backup/BackupPC' if ( $topDir eq "" );
+ $topDir = '/data/BackupPC' if ( $topDir eq "" );
$installDir = '/usr/local/BackupPC' if ( $installDir eq "" );
#
useFHS => $useFHS,
TopDir => $topDir,
InstallDir => $installDir,
- ConfDir => $confDir eq "" ? '/tera0/backup/BackupPC/conf' : $confDir,
+ ConfDir => $confDir eq "" ? '/data/BackupPC/conf' : $confDir,
LogDir => '/var/log/BackupPC',
};
} else {
my $bpc = bless {
%$paths,
- Version => '3.1.0',
+ Version => '3.2.0',
}, $class;
$bpc->{storage} = BackupPC::Storage->new($paths);
# Clean up %ENV and setup other variables.
#
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
- $bpc->{PoolDir} = "$bpc->{TopDir}/pool";
- $bpc->{CPoolDir} = "$bpc->{TopDir}/cpool";
if ( defined(my $error = $bpc->ConfigRead()) ) {
print(STDERR $error, "\n");
return;
$paths->{$dir} = $bpc->{$dir} = $bpc->{Conf}{$dir};
}
$bpc->{storage}->setPaths($paths);
+ $bpc->{PoolDir} = "$bpc->{TopDir}/pool";
+ $bpc->{CPoolDir} = "$bpc->{TopDir}/cpool";
#
# Verify we are running as the correct user
from_to($path, "utf8", $need->{charsetLegacy})
if ( $need->{charsetLegacy} ne "" );
return if ( !opendir(my $fh, $path) );
+ if ( $IODirentLoaded && !$IODirentOk ) {
+ #
+ # Make sure the IO::Dirent really works - some installs
+ # on certain file systems (eg: XFS) don't return a valid type.
+ #
+ if ( opendir(my $fh, $bpc->{TopDir}) ) {
+ my $dt_dir = eval("DT_DIR");
+ foreach my $e ( readdirent($fh) ) {
+ if ( $e->{name} eq "." && $e->{type} == $dt_dir ) {
+ $IODirentOk = 1;
+ last;
+ }
+ }
+ closedir($fh);
+ }
+ #
+ # if it isn't ok then don't check again.
+ #
+ $IODirentLoaded = 0 if ( !$IODirentOk );
+ }
if ( $IODirentOk ) {
@entries = sort({ $a->{inode} <=> $b->{inode} } readdirent($fh));
map { $_->{type} = 0 + $_->{type} } @entries; # make type numeric
}
closedir(DIR);
}
- return sort(compareLOGName @files);
+ return sort compareLOGName @files;
+}
+
+#
+# converts a glob-style pattern into a perl regular expression.
+#
+sub glob2re
+{
+ my ( $bpc, $glob ) = @_;
+ my ( $char, $subst );
+
+ # $escapeChars escapes characters with no special glob meaning but
+ # have meaning in regexps.
+ my $escapeChars = [ '.', '/', ];
+
+ # $charMap is where we implement the special meaning of glob
+ # patterns and translate them to regexps.
+ my $charMap = {
+ '?' => '[^/]',
+ '*' => '[^/]*', };
+
+ # multiple forward slashes are equivalent to one slash. We should
+ # never have to use this.
+ $glob =~ s/\/+/\//;
+
+ foreach $char (@$escapeChars) {
+ $glob =~ s/\Q$char\E/\\$char/g;
+ }
+
+ while ( ( $char, $subst ) = each(%$charMap) ) {
+ $glob =~ s/(?<!\\)\Q$char\E/$subst/g;
+ }
+
+ return $glob;
}
1;
--- /dev/null
+#============================================================= -*-perl-*-
+#
+# BackupPC::Xfer package
+#
+# DESCRIPTION
+#
+# This library defines a Factory for invoking transfer protocols in
+# a polymorphic manner. This libary allows for easier expansion of
+# supported protocols.
+#
+# AUTHOR
+# Paul Mantz <pcmantz@zmanda.com>
+#
+# COPYRIGHT
+# Copyright (C) 2008 Zmanda
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+#========================================================================
+#
+# Version 3.1.0+
+#
+# See http://backuppc.sourceforge.net.
+#
+#========================================================================
+
+
+package BackupPC::Xfer;
+
+use strict;
+use Encode qw/from_to encode/;
+
+use BackupPC::Xfer::Archive;
+use BackupPC::Xfer::BackupPCd;
+use BackupPC::Xfer::Ftp;
+use BackupPC::Xfer::Protocol;
+use BackupPC::Xfer::Rsync;
+use BackupPC::Xfer::Smb;
+use BackupPC::Xfer::Tar;
+
+use vars qw( $errStr );
+
+sub create
+{
+ my($protocol, $bpc, $args) = @_;
+ my $xfer;
+
+ $errStr = undef;
+
+ if ( $protocol eq 'archive' ) {
+
+ $xfer = BackupPC::Xfer::Archive->new( $bpc, $args );
+ $errStr = BackupPC::Xfer::Archive::errStr() if ( !defined($xfer) );
+ return $xfer;
+
+ } elsif ( $protocol eq 'backuppcd' ) {
+
+ $xfer = BackupPC::Xfer::BackupPCd->new( $bpc, $args );
+ $errStr = BackupPC::Xfer::BackupPCd::errStr() if ( !defined($xfer) );
+ return $xfer;
+
+ } elsif ( $protocol eq 'ftp' ) {
+
+ $xfer = BackupPC::Xfer::Ftp->new( $bpc, $args );
+ $errStr = BackupPC::Xfer::Ftp::errStr() if ( !defined($xfer) );
+ return $xfer;
+
+ } elsif ( $protocol eq 'rsync' || $protocol eq 'rsyncd' ) {
+
+ $xfer = BackupPC::Xfer::Rsync->new( $bpc, $args );
+ $errStr = BackupPC::Xfer::Rsync::errStr() if ( !defined($xfer) );
+ return $xfer;
+
+ } elsif ( $protocol eq 'smb' ) {
+
+ $xfer = BackupPC::Xfer::Smb->new( $bpc, $args );
+ $errStr = BackupPC::Xfer::Smb::errStr() if ( !defined($xfer) );
+ return $xfer;
+
+ } elsif ( $protocol eq 'tar' ) {
+
+ $xfer = BackupPC::Xfer::Tar->new( $bpc, $args );
+ $errStr = BackupPC::Xfer::Tar::errStr() if ( !defined($xfer) );
+ return $xfer;
+
+ } elsif ( $protocol eq 'protocol') {
+
+ $xfer = BackupPC::Xfer::Protocol->new( $bpc, $args );
+ $errStr = BackupPC::Xfer::Protocol::errStr() if ( !defined($xfer) );
+ return $xfer;
+
+ } else {
+
+ $xfer = undef;
+ $errStr = "$protocol is not a supported protocol.";
+ return $xfer;
+ }
+}
+
+#
+# getShareNames() loads the correct shares dependent on the
+# transfer type.
+#
+sub getShareNames
+{
+ my($conf) = @_;
+ my $ShareNames;
+
+ if ( $conf->{XferMethod} eq "tar" ) {
+ $ShareNames = $conf->{TarShareName};
+
+ } elsif ( $conf->{XferMethod} eq "ftp" ) {
+ $ShareNames = $conf->{FtpShareName};
+
+ } elsif ( $conf->{XferMethod} eq "rsync" || $conf->{XferMethod} eq "rsyncd" ) {
+ $ShareNames = $conf->{RsyncShareName};
+
+ } elsif ( $conf->{XferMethod} eq "backuppcd" ) {
+ $ShareNames = $conf->{BackupPCdShareName};
+
+ } elsif ( $conf->{XferMethod} eq "smb" ) {
+ $ShareNames = $conf->{SmbShareName};
+
+ } else {
+ #
+ # default to smb shares
+ #
+ $ShareNames = $conf->{SmbShareName};
+ }
+
+ $ShareNames = [$ShareNames] unless ref($ShareNames) eq "ARRAY";
+ return $ShareNames;
+}
+
+sub errStr
+{
+ return $errStr;
+}
+
+1;
package BackupPC::Xfer::Archive;
use strict;
-
-sub new
-{
- my($class, $bpc, $args) = @_;
-
- $args ||= {};
- my $t = bless {
- bpc => $bpc,
- conf => { $bpc->Conf },
- host => "",
- hostIP => "",
- shareName => "",
- pipeRH => undef,
- pipeWH => undef,
- badFiles => [],
- %$args,
- }, $class;
-
- return $t;
-}
-
-sub args
-{
- my($t, $args) = @_;
-
- foreach my $arg ( keys(%$args) ) {
- $t->{$arg} = $args->{$arg};
- }
-}
-
-sub useArchive
-{
- return 1;
-}
+use base qw(BackupPC::Xfer::Protocol);
sub start
{
return "Completed Archive";
}
-sub errStr
-{
- my($t) = @_;
-
- return $t->{_errStr};
-}
-
-sub abort
-{
-}
-
-sub xferPid
-{
- my($t) = @_;
-
- return ($t->{xferPid});
-}
-
-sub logMsg
-{
- my($t, $msg) = @_;
-
- push(@{$t->{_logMsg}}, $msg);
-}
-
-sub logMsgGet
-{
- my($t) = @_;
-
- return shift(@{$t->{_logMsg}});
-}
-
1;
package BackupPC::Xfer::BackupPCd;
use strict;
+use base qw(BackupPC::Xfer::Protocol);
sub new
{
return $t;
}
-sub args
-{
- my($t, $args) = @_;
-
- foreach my $arg ( keys(%$args) ) {
- $t->{$arg} = $args->{$arg};
- }
-}
-
-sub useTar
-{
- return 0;
-}
-
sub start
{
my($t) = @_;
}
}
-sub abort
-{
- my($t, $reason) = @_;
-
- # TODO
- return 1;
-}
-
-sub errStr
-{
- my($t) = @_;
-
- return $t->{_errStr};
-}
-
-sub xferPid
-{
- my($t) = @_;
-
- return ();
-}
-
-#
-# Returns a hash ref giving various status information about
-# the transfer.
-#
-sub getStats
-{
- my($t) = @_;
-
- return { map { $_ => $t->{$_} }
- qw(byteCnt fileCnt xferErrCnt xferBadShareCnt xferBadFileCnt
- xferOK hostAbort hostError lastOutputLine)
- };
-}
-
-sub getBadFiles
-{
- my($t) = @_;
-
- return @{$t->{badFiles}};
-}
-
1;
--- /dev/null
+#============================================================= -*-perl-*-
+#
+# BackupPC::Xfer::Ftp package
+#
+# DESCRIPTION
+#
+# This library defines a BackupPC::Xfer::Ftp class for transferring
+# data from a FTP client.
+#
+# AUTHOR
+# Paul Mantz <pcmantz@zmanda.com>
+#
+# COPYRIGHT
+# (C) 2008, Zmanda Inc.
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License as
+# published by the Free Software Foundation; either version 2 of the
+# License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+# 02111-1307 USA
+#
+#
+#========================================================================
+#
+# Unreleased, planned release in 3.2 (or 3.1.1)
+#
+# See http://backuppc.sourceforge.net.
+#
+#========================================================================
+
+
+package BackupPC::Xfer::Ftp;
+
+use strict;
+
+use BackupPC::View;
+use BackupPC::Attrib qw(:all);
+
+use Encode qw/from_to encode/;
+use File::Listing qw/parse_dir/;
+use File::Path;
+use Data::Dumper;
+use base qw(BackupPC::Xfer::Protocol);
+
+use vars qw( $FTPLibOK $FTPLibErr $ARCLibOK );
+
+use constant S_IFMT => 0170000;
+
+BEGIN {
+
+ $FTPLibOK = 1;
+ $ARCLibOK = 0;
+
+ #
+ # clear eval error variable
+ #
+ my @FTPLibs = qw( Net::FTP Net::FTP::RetrHandle );
+
+ foreach my $module ( @FTPLibs ) {
+
+ undef $@;
+ eval "use $module;";
+
+ if ( $@ ) {
+ $FTPLibOK = 0;
+ $FTPLibErr = "module $module doesn't exist: $@";
+ last;
+ }
+ }
+
+ eval "use Net::FTP::AutoReconnect;";
+ $ARCLibOK = (defined($@)) ? 1 : 0;
+};
+
+##############################################################################
+# Constructor
+##############################################################################
+
+
+#
+# usage:
+# $xfer = new BackupPC::Xfer::Ftp( $bpc, %args );
+#
+# new() is your default class constructor. it also calls the
+# constructor for Protocol as well.
+#
+sub new
+{
+ my ( $class, $bpc, $args ) = @_;
+ $args ||= {};
+
+ my $t = BackupPC::Xfer::Protocol->new(
+ $bpc,
+ {
+ ftp => undef,
+ stats => {
+ errorCnt => 0,
+ TotalFileCnt => 0,
+ TotalFileSize => 0,
+ ExistFileCnt => 0,
+ ExistFileSize => 0,
+ ExistFileCompSize => 0,
+ },
+ %$args,
+ } );
+ return bless( $t, $class );
+}
+
+
+##############################################################################
+# Methods
+##############################################################################
+
+#
+# usage:
+# $xfer->start();
+#
+# start() is called to configure and initiate a dump or restore,
+# depending on the configured options.
+#
+sub start
+{
+ my ($t) = @_;
+
+ my $bpc = $t->{bpc};
+ my $conf = $t->{conf};
+
+ my ( @fileList, $logMsg, $incrDate, $args, $dumpText );
+
+ #
+ # initialize the statistics returned by getStats()
+ #
+ foreach ( qw/byteCnt fileCnt xferErrCnt xferBadShareCnt
+ xferBadFileCnt xferOK hostAbort hostError
+ lastOutputLine/ )
+ {
+ $t->{$_} = 0;
+ }
+
+ #
+ # Net::FTP::RetrHandle is necessary.
+ #
+ if ( !$FTPLibOK ) {
+ $t->{_errStr} = "Error: FTP transfer selected but module"
+ . " Net::FTP::RetrHandle is not installed.";
+ $t->{xferErrCnt}++;
+ return;
+ }
+
+ #
+ # standardize the file include/exclude settings if necessary
+ #
+ unless ( $t->{type} eq 'restore' ) {
+ $bpc->backupFileConfFix( $conf, "FtpShareName" );
+ $t->loadInclExclRegexps("FtpShareName");
+ }
+
+ #
+ # Convert the encoding type of the names if at all possible
+ #
+ from_to( $args->{shareName}, "utf8", $conf->{ClientCharset} )
+ if ( $conf->{ClientCharset} ne "" );
+
+ #
+ # Collect FTP configuration arguments and translate them for
+ # passing to the FTP module.
+ #
+ $args = $t->getFTPArgs();
+
+ #
+ # 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}";
+ $t->{xferErrCnt}++;
+ return;
+ }
+
+ #
+ # 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}";
+ $t->{xferErrCnt}++;
+ return;
+ }
+
+ unless ( $t->{ftp}->binary() ) {
+ $t->{_errStr} = "Can't enable binary transfer mode to $args->{Host}";
+ $t->{xferErrCnt}++;
+ return;
+ }
+
+ unless ( ( $t->{shareName} =~ m/^\.?$/ )
+ || ( $t->{ftp}->cwd( $t->{shareName} ) ) )
+ {
+ $t->{_errStr} = "Can't change working directory to $t->{shareName}";
+ $t->{xferErrCnt}++;
+ return;
+ }
+
+ unless ( $t->{sharePath} = $t->{ftp}->pwd() ) {
+ $t->{_errStr} = "Can't retrieve full working directory of $t->{shareName}";
+ $t->{xferErrCnt}++;
+ return;
+ }
+
+ #
+ # log the beginning of action based on type
+ #
+ if ( $t->{type} eq 'restore' ) {
+ $logMsg = "restore started on directory $t->{shareName}";
+
+ } elsif ( $t->{type} eq 'full' ) {
+ $logMsg = "full backup started on directory $t->{shareName}";
+
+ } 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}";
+ }
+
+ #
+ # call the recursive function based on the type of action
+ #
+ if ( $t->{type} eq 'restore' ) {
+
+ $t->restore();
+ $logMsg = "Restore of $args->{Host} complete";
+
+ } elsif ( $t->{type} eq 'incr' ) {
+
+ $t->backup();
+ $logMsg = "Incremental backup of $args->{Host} complete";
+
+ } elsif ( $t->{type} eq 'full' ) {
+
+ $t->backup();
+ $logMsg = "Full backup of $args->{Host} complete";
+ }
+
+ delete $t->{_errStr};
+ return $logMsg;
+}
+
+
+#
+#
+#
+sub run
+{
+ my ($t) = @_;
+ my $stats = $t->{stats};
+
+ my ( $tarErrs, $nFilesExist, $sizeExist,
+ $sizeExistCom, $nFilesTotal, $sizeTotal );
+
+ #
+ # TODO: replace the $stats array with variables at the top level,
+ # ones returned by $getStats. They should be identical.
+ #
+ $tarErrs = 0;
+ $nFilesExist = $stats->{ExistFileCnt};
+ $sizeExist = $stats->{ExistFileSize};
+ $sizeExistCom = $stats->{ExistFileCompSize};
+ $nFilesTotal = $stats->{TotalFileCnt};
+ $sizeTotal = $stats->{TotalFileSize};
+
+ if ( $t->{type} eq "restore" ) {
+ return ( $t->{fileCnt}, $t->{byteCnt}, 0, 0 );
+
+ } else {
+ return \( $tarErrs, $nFilesExist, $sizeExist,
+ $sizeExistCom, $nFilesTotal, $sizeTotal );
+ }
+}
+
+
+#
+# usage:
+# $t->restore();
+#
+# TODO: finish or scuttle this function. It is not necessary for a
+# release.
+#
+sub restore
+{
+ my $t = @_;
+
+ my $bpc = $t->{bpc};
+ my $fileList = $t->{fileList};
+
+ my ($path, $fileName, $fileAttr, $fileType );
+
+ #print STDERR "BackupPC::Xfer::Ftp->restore()";
+
+ #
+ # Prepare the view object
+ #
+ $t->{view} = BackupPC::View->new( $bpc, $t->{bkupSrcHost},
+ $t->{backups} );
+ my $view = $t->{view};
+
+ SCAN: foreach my $f ( @$fileList ) {
+
+ #print STDERR "restoring $f...\n";
+
+ $f =~ /(.*)\/([^\/]*)/;
+ $path = $1;
+ $fileName = $2;
+
+ $view->dirCache($path);
+
+ $fileAttr = $view->fileAttrib($fileName);
+ $fileType = fileType2Text( $fileAttr->{type} );
+
+ if ( $fileType eq "dir") {
+ $t->restoreDir($fileName, $fileAttr);
+
+ } elsif ( $fileType eq "file" ) {
+ $t->restoreFile($fileName, $fileAttr);
+
+ } elsif ( $fileType eq "symlink" ) {
+ #
+ # ignore
+ #
+ } else {
+ #
+ # ignore
+ #
+ }
+ } # end SCAN
+}
+
+
+sub restoreDir
+{
+ my ( $t, $dirName, $dirAttr ) = @_;
+
+ my $ftp = $t->{ftp};
+ my $bpc = $t->{bpc};
+ my $conf = $t->{conf};
+ my $view = $t->{view};
+ my $TopDir = $bpc->TopDir();
+
+ my $path = "$dirAttr->{relPath}/$dirName";
+ my $dirList = $view->dirAttrib( -1, $t->{shareName}, $path );
+
+ my ( $fileName, $fileAttr, $fileType );
+
+ #print STDERR "BackupPC::Xfer::Ftp->restore($dirName)\n";
+
+ #
+ # Create the remote directory
+ #
+ unless ( $ftp->mkdir( $path, 1 ) ) {
+
+ $t->logFileAction( "fail", $dirName, $dirAttr );
+ return;
+ }
+
+ SCAN: while ( ($fileName, $fileAttr ) = each %$dirList ) {
+
+ $fileType = fileType2Text( $fileAttr->{type} );
+
+ if ( $fileType eq "dir" ) {
+ if ( $t->restoreDir( $fileName, $fileAttr ) ) {
+ $t->logWrite( "restored: $path/$fileName\n", 5 );
+ } else {
+ $t->logWrite( "restore failed: $path/$fileName\n", 3 );
+ }
+
+ } elsif ( $fileType eq "file" ) {
+ $t->restoreFile( $fileName, $fileAttr );
+
+ } elsif ( $fileType eq "hardlink" ) {
+ #
+ # Hardlinks cannot be restored. however, if we have the
+ # target file in the pool, we can restore that.
+ #
+ $t->restoreFile( $fileName, $fileAttr );
+
+ next SCAN;
+
+ } elsif ( $fileType eq "symlink" ) {
+ #
+ # Symlinks cannot be restored
+ #
+ next SCAN;
+
+ } else {
+ #
+ # Ignore all other types (devices, doors, etc)
+ #
+ next SCAN;
+ }
+ }
+}
+
+
+sub restoreFile
+{
+ my ($t, $fileName, $fileAttr ) = @_;
+
+ my $conf = $t->{conf};
+ my $ftp = $t->{ftp};
+
+ my $poolFile = $fileAttr->{fullPath};
+ my $fileDest = ( $conf->{ClientCharset} ne "" )
+ ? from_to( "$fileAttr->{relPath}/$fileName",
+ "utf8", $conf->{ClientCharset} )
+ : "$fileAttr->{relPath}/$fileName";
+
+ #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);
+ }
+}
+
+
+#
+# usage:
+# $t->backup($path);
+#
+# $t->backup() is a recursive function that takes a path as an
+# argument, and performs a backup on that folder consistent with the
+# configuration parameters. $path is considered rooted at
+# $t->{shareName}, so no $ftp->cwd() command is necessary.
+#
+sub backup
+{
+ my ($t) = @_;
+
+ my $ftp = $t->{ftp};
+ my $bpc = $t->{bpc};
+ my $conf = $t->{conf};
+ my $TopDir = $bpc->TopDir();
+ my $OutDir = "$TopDir/pc/$t->{client}/new/"
+ . $bpc->fileNameEltMangle( $t->{shareName} );
+
+ #
+ # Prepare the view object
+ #
+ $t->{view} = BackupPC::View->new( $bpc, $t->{client}, $t->{backups} );
+
+ #
+ # Prepare backup folder
+ #
+ unless ( mkpath( $OutDir, 0, 0755 ) ) {
+ $t->{_errStr} = "can't create OutDir: $OutDir";
+ $t->{xferErrCnt}++;
+ return;
+ }
+
+ #
+ # determine the filetype of the shareName and back it up
+ # appropriately. For now, assume that $t->{shareName} is a
+ # directory.
+ #
+ my $f = {
+ relPath => "",
+ fullName => $t->{shareName},
+ };
+
+ if ( $t->handleDir( $f, $OutDir ) ) {
+
+ $t->{xferOK} = 1;
+ return 1;
+
+ } else {
+
+ $t->{xferBadShareCnt}++;
+ return;
+ }
+}
+
+
+####################################################################################
+# FTP-specific functions
+####################################################################################
+
+
+#
+# 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
+# Net::FTP object.
+#
+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;
+}
+
+
+#
+# usage:
+# $dirList = $t->remotels($path);
+#
+# remotels() returns a reference to a list of hash references that
+# describe the contents of each file in the directory of the path
+# specified.
+#
+# In the future, I would like to make this function return objects in
+# Attrib format. That would be very optimal, and I could probably
+# release the code to CPAN.
+#
+sub remotels
+{
+ my ( $t, $path ) = @_;
+
+ my $ftp = $t->{ftp};
+ my $bpc = $t->{bpc};
+ my $conf = $t->{conf};
+
+ my ( $dirContents, $remoteDir, $f );
+
+ unless ( $dirContents = ($path =~ /^\.?$/ ) ? $ftp->dir() :
+ $ftp->dir("$path/") )
+ {
+ $t->{xferErrCnt}++;
+ return "can't retrieve remote directory contents of $path";
+ }
+
+ 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
+ #
+ $f->{utf8name} = $f->{name};
+ from_to( $f->{utf8name}, $conf->{ClientCharset}, "utf8" );
+
+ #
+ # construct the full name
+ #
+ $f->{fullName} = "$t->{sharePath}/$path/$f->{name}";
+ $f->{fullName} =~ s/\/+/\//g;
+
+ $f->{relPath} = ($path eq "") ? $f->{name} : "$path/$f->{name}";
+ $f->{relPath} =~ s/\/+/\//g;
+
+ push( @$remoteDir, $f );
+ }
+
+ return $remoteDir;
+}
+
+
+#
+# ignoreFileCheck() looks at the attributes of the arguments and the
+# backup types, and determines if the file should be skipped in this
+# backup.
+#
+sub ignoreFileCheck
+{
+ 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} ) );
+}
+
+
+#
+# handleSymlink() backs up a symlink.
+#
+sub handleSymlink
+{
+ my ( $t, $f, $OutDir, $attrib ) = @_;
+
+ my $conf = $t->{conf};
+ my $ftp = $t->{ftp};
+ my ( $target, $targetDesc );
+
+ my $attribInfo = {
+ type => BPC_FTYPE_SYMLINK,
+ mode => $f->{mode},
+ uid => undef, # unsupported
+ gid => undef, # unsupported
+ size => 0,
+ mtime => $f->{mtime},
+ };
+
+ #
+ # If we are following symlinks, back them up as the type of file
+ # they point to. Otherwise, backup the symlink.
+ #
+ if ( $conf->{FtpFollowSymlinks} ) {
+
+ #
+ # handle nested symlinks by recurring on the target until a
+ # file or directory is found.
+ #
+ $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);
+ return;
+ }
+ } else {
+
+ $t->("fail", $f);
+ return;
+ }
+
+ } else {
+
+ #
+ # If we are not following symlinks, record them normally.
+ #
+ $attrib->set( $f->{utf8name}, $attribInfo );
+ $t->logFileAction("create", $f->{utf8name}, $attribInfo);
+ }
+ return 1;
+}
+
+
+sub handleSymDir
+{
+ my ($t, $fSym, $OutDir, $attrib, $targetDesc) = @_;
+
+ return 1;
+ }
+
+
+sub handleSymFile
+{
+ my ( $t, $fSym, $OutDir, $attrib, $targetDesc ) = @_;
+
+ my $bpc = $t->{bpc};
+ my $conf = $t->{conf};
+
+ my $f = {
+ 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};
+
+ $f->{fullName} = "$t->{shareName}/$fSym->{relPath}/$fSym->{name}";
+ $f->{fullName} =~ s/\/+/\//g;
+
+ #
+ # since FTP servers follow symlinks, we can jsut do this:
+ #
+ return $t->handleFile( $f, $OutDir, $attrib );
+}
+
+
+#
+# handleDir() backs up a directory, and initiates a backup of its
+# contents.
+#
+sub handleDir
+{
+ my ( $t, $dir, $OutDir ) = @_;
+
+ my $ftp = $t->{ftp};
+ my $bpc = $t->{bpc};
+ my $conf = $t->{conf};
+ my $view = $t->{view};
+ my $stats = $t->{stats};
+
+ my ( $exists, $digest, $outSize, $errs );
+ my ( $poolWrite, $poolFile, $attribInfo );
+ my ( $localDir, $remoteDir, $attrib, %expectedFiles );
+
+ if ( exists($dir->{utf8name})) {
+ $OutDir .= "/" . $bpc->fileNameMangle( $dir->{utf8name} );
+ }
+
+ unless ( -d $OutDir ) {
+
+ mkpath( $OutDir, 0, 0755 );
+ $t->logFileAction( "create", $dir->{utf8name}, $dir );
+ }
+
+ $attrib = BackupPC::Attrib->new( { compress => $t->{Compress} } );
+ $remoteDir = $t->remotels( $dir->{relPath} );
+
+ if ( $t->{type} eq "incr" ) {
+ $localDir = $view->dirAttrib( $t->{incrBaseBkupNum},
+ $t->{shareName}, $dir->{relPath} );
+ %expectedFiles = map { $_ => 0 } sort keys %$localDir
+ }
+
+ #
+ # take care of each file in the directory
+ #
+ SCAN: foreach my $f ( @{$remoteDir} ) {
+
+ next SCAN if $t->ignoreFileCheck( $f, $attrib );
+
+ #
+ # handle based on filetype
+ #
+ if ( $f->{type} eq 'f' ) {
+ $t->handleFile( $f, $OutDir, $attrib );
+
+ } elsif ( $f->{type} eq 'd' ) {
+
+ $attribInfo = {
+ type => BPC_FTYPE_DIR,
+ mode => $f->{mode},
+ uid => undef, # unsupported
+ gid => undef, # unsupported
+ size => $f->{size},
+ mtime => $f->{mtime},
+ };
+
+ #print STDERR "$f->{utf8name}: ". Dumper($attribInfo);
+
+ if ( $t->handleDir($f, $OutDir) ) {
+ $attrib->set( $f->{utf8name}, $attribInfo);
+ }
+
+ } elsif ( $f->{type} =~ /^l (.*)/ ) {
+ $t->handleSymlink( $f, $OutDir, $attrib );
+
+ } else {
+ #
+ # do nothing
+ #
+ }
+
+ #
+ # Mark file as seen in expected files hash
+ #
+ $expectedFiles{ $f->{utf8name} }++ if ( $t->{type} eq "incr" );
+
+ } # end foreach (@{$remoteDir})
+
+ #
+ # If the backup type is incremental, mark the files that are not
+ # present on the server as deleted.
+ #
+ if ( $t->{type} eq "incr" ) {
+ while ( my ($f, $seen) = each %expectedFiles ) {
+ $attrib->set( $f, { type => BPC_FTYPE_DELETED } )
+ unless ($seen);
+ }
+ }
+
+ #
+ # print the directory attributes, now that the directory is done.
+ #
+ my $fileName = $attrib->fileName($OutDir);
+ my $data = $attrib->writeData();
+
+ $poolWrite = BackupPC::PoolWrite->new( $bpc, $fileName, length($data),
+ $t->{Compress} );
+ $poolWrite->write( \$data );
+ ( $exists, $digest, $outSize, $errs ) = $poolWrite->close();
+
+ #
+ # Explicit success
+ #
+ return 1;
+}
+
+
+#
+# handleFile() backs up a file.
+#
+sub handleFile
+{
+ my ( $t, $f, $OutDir, $attrib ) = @_;
+
+ my $bpc = $t->{bpc};
+ my $ftp = $t->{ftp};
+ my $view = $t->{view};
+ my $stats = $t->{stats};
+ my $newFilesFH = $t->{newFilesFH};
+
+ my ( $poolFile, $poolWrite, $data, $localSize );
+ my ( $exists, $digest, $outSize, $errs );
+ my ( $oldAttrib );
+ local *FTP;
+
+ #
+ # If this is an incremental backup and the file exists in a
+ # previous backup unchanged, write the attribInfo for the file
+ # accordingly.
+ #
+ if ( $t->{type} eq "incr" ) {
+ return 1 if $t->incrFileExistCheck( $f, $attrib );
+ }
+
+ my $attribInfo = {
+ type => BPC_FTYPE_FILE,
+ mode => $f->{mode},
+ uid => undef, # unsupported
+ gid => undef, # unsupported
+ size => $f->{size},
+ mtime => $f->{mtime},
+ };
+
+ #
+ # 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 );
+ $t->{xferBadFileCnt}++;
+ $stats->{errCnt}++;
+ return;
+ }
+
+ $poolFile = $OutDir . "/" . $bpc->fileNameMangle( $f->{name} );
+ $poolWrite = BackupPC::PoolWrite->new( $bpc, $poolFile, $f->{size},
+ $bpc->{xfer}{compress} );
+
+ $localSize = 0;
+ while (<FTP>) {
+
+ $localSize += length($_);
+ $poolWrite->write( \$_ );
+ }
+ ( $exists, $digest, $outSize, $errs ) = $poolWrite->close();
+
+ #
+ # calculate the file statistics
+ #
+ if (@$errs) {
+
+ $t->logFileAction( "fail", $f->{utf8name}, $attribInfo );
+ unlink($poolFile);
+ $t->{xferBadFileCnt}++;
+ $t->{errCnt} += scalar(@$errs);
+ return;
+ }
+
+ #
+ # this should never happen
+ #
+ if ( $localSize != $f->{size} ) {
+
+ $t->logFileAction( "fail", $f->{utf8name}, $attribInfo );
+ unklink($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;
+
+ #
+ # Cumulate the stats
+ #
+ $stats->{TotalFileCnt}++;
+ $stats->{ExistFileCnt}++;
+ $stats->{ExistFileCompSize} += -s $poolFile;
+ $stats->{ExistFileSize} += $f->{size};
+ $stats->{TotalFileSize} += $f->{size};
+
+ $t->{byteCnt} += $localSize;
+ $t->{fileCnt}++;
+}
+
+
+#
+# this function checks if the file has been modified on disk, and if
+# it has, returns. Otherwise, it updates the attrib values.
+#
+sub incrFileExistCheck
+{
+ my ($t, $f, $attrib) = @_;
+
+ my $view = $t->{view};
+
+ my $oldAttribInfo = $view->fileAttrib( $t->{incrBaseBkupNum},
+ $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";
+
+ return ( $oldAttribInfo->{mtime} == $f->{mtime}
+ && $oldAttribInfo->{size} == $f->{size} );
+}
+
+
+#
+# Generate a log file message for a completed file. Taken from
+# BackupPC_tarExtract. $f should be an attrib object.
+#
+sub logFileAction
+{
+ my ( $t, $action, $name, $attrib ) = @_;
+
+ my $owner = "$attrib->{uid}/$attrib->{gid}";
+ my $type =
+ ( ( "", "p", "c", "", "d", "", "b", "", "", "", "l", "", "s" ) )
+ [ ( $attrib->{mode} & S_IFMT ) >> 12 ];
+
+ $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 );
+
+ return $t->logWrite( $fileAction, 1 );
+}
+
+1;
--- /dev/null
+#============================================================= -*-perl-*-
+#
+# BackupPC::Xfer::Protocol package
+#
+# DESCRIPTION
+#
+# This library defines a BackupPC::Xfer::Protocol class which
+# defines standard methods for the transfer protocols in BackupPC.
+#
+# AUTHOR
+# Paul Mantz <pcmantz@zmanda.com>
+#
+# COPYRIGHT
+# Copyright (C) 2001-2007 Craig Barratt
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+#========================================================================
+#
+# Version 3.1.0, released 25 Nov 2007.
+#
+# See http://backuppc.sourceforge.net.
+#
+#========================================================================
+
+package BackupPC::Xfer::Protocol;
+
+use strict;
+use Data::Dumper;
+use Encode qw/from_to encode/;
+
+use BackupPC::Attrib qw(:all);
+
+#
+# usage:
+# $t = BackupPC::Xfer::Protocol->new($args);
+#
+# new() is the constructor. There's nothing special going on here.
+#
+sub new
+{
+ my($class, $bpc, $args) = @_;
+
+ $args ||= {};
+ my $t = bless {
+ bpc => $bpc,
+ conf => $bpc->{Conf},
+ host => "",
+ hostIP => "",
+ shareName => "",
+ pipeRH => undef,
+ pipeWH => undef,
+ badFiles => [],
+
+ #
+ # Various stats
+ #
+ byteCnt => 0,
+ fileCnt => 0,
+ xferErrCnt => 0,
+ xferBadShareCnt => 0,
+ xferBadFileCnt => 0,
+ xferOK => 0,
+
+ #
+ # User's args
+ #
+ %$args,
+ }, $class;
+
+ return $t;
+}
+
+#
+# usage:
+# $t->args($args);
+#
+# args() can be used to send additional argument to the Xfer object
+# via a hash reference.
+#
+sub args
+{
+ my($t, $args) = @_;
+
+ foreach my $arg ( keys(%$args) ) {
+ $t->{$arg} = $args->{$arg};
+ }
+}
+
+#
+# usage:
+# $t->start();
+#
+# start() executes the actual data transfer. Must be implemented by
+# the derived class.
+#
+sub start
+{
+ my($t) = @_;
+
+ $t->{_errStr} = "start() not implemented by ".ref($t);
+ return;
+}
+
+#
+#
+#
+sub run
+{
+ my($t) = @_;
+
+ $t->{_errStr} = "run() not implemented by ".ref($t);
+ return;
+}
+
+#
+# usage:
+# $t->readOutput();
+#
+# This function is only used when $t->useTar() == 1.
+#
+sub readOutput
+{
+ my($t) = @_;
+
+ $t->{_errStr} = "readOutput() not implemented by " . ref($t);
+ return;
+}
+
+#
+# usage:
+# $t->abort($reason);
+#
+# Aborts the current job.
+#
+sub abort
+{
+ my($t, $reason) = @_;
+ my @xferPid = $t->xferPid;
+
+ $t->{abort} = 1;
+ $t->{abortReason} = $reason;
+ if ( @xferPid ) {
+ kill($t->{bpc}->sigName2num("INT"), @xferPid);
+ }
+}
+
+#
+# usage:
+# $t->subSelectMask
+#
+# This function sets a mask for files when ($t->useTar == 1).
+#
+sub setSelectMask
+{
+ my($t) = @_;
+
+ $t->{_errStr} = "readOutput() not implemented by " . ref($t);
+}
+
+#
+# usage:
+# $t->errStr();
+#
+sub errStr
+{
+ my($t) = @_;
+
+ return $t->{_errStr};
+}
+
+#
+# usage:
+# $pid = $t->xferPid();
+#
+# xferPid() returns the process id of the child forked process.
+#
+sub xferPid
+{
+ my($t) = @_;
+
+ return ($t->{xferPid});
+}
+
+#
+# usage:
+# $t->logMsg($msg);
+#
+sub logMsg
+{
+ my ($t, $msg) = @_;
+
+ push(@{$t->{_logMsg}}, $msg);
+}
+
+#
+# usage:
+# $t->logMsgGet();
+#
+sub logMsgGet
+{
+ my($t) = @_;
+
+ return shift(@{$t->{_logMsg}});
+}
+
+#
+# usage:
+# $t->getStats();
+#
+# This function returns xfer statistics. It Returns a hash ref giving
+# various status information about the transfer.
+#
+sub getStats
+{
+ my ($t) = @_;
+
+ return {
+ map { $_ => $t->{$_} }
+ qw(byteCnt fileCnt xferErrCnt xferBadShareCnt xferBadFileCnt
+ xferOK hostAbort hostError lastOutputLine)
+ };
+}
+
+sub getBadFiles
+{
+ my ($t) = @_;
+
+ return @{$t->{badFiles}};
+}
+
+#
+# useTar function. In order to work correctly, the protocol in
+# question should overwrite the function if it needs to return true.
+#
+sub useTar
+{
+ return 0;
+}
+
+##############################################################################
+# Logging Functions
+##############################################################################
+
+#
+# usage:
+# $t->logWrite($msg [, $level])
+#
+# This function writes to XferLOG.
+#
+sub logWrite
+{
+ my($t, $msg, $level) = @_;
+
+ my $XferLOG = $t->{XferLOG};
+ $level = 3 if ( !defined($level) );
+
+ return ( $XferLOG->write(\$msg) ) if ( $level <= $t->{logLevel} );
+}
+
+
+##############################################################################
+# File Inclusion/Exclusion
+##############################################################################
+
+#
+# loadInclExclRegexps() places the appropriate file include/exclude regexps
+#
+sub loadInclExclRegexps
+{
+ my ( $t, $shareType ) = @_;
+ my $bpc = $t->{bpc};
+ my $conf = $t->{conf};
+
+ my @BackupFilesOnly = ();
+ my @BackupFilesExclude = ();
+ my ($shareName, $shareNameRE);
+
+ #
+ # $conf->{$shareType} shold be a reference to an array with one
+ # element, thanks to BackupFileConfFix().
+ #
+ $shareName = @{ $conf->{$shareType} }[0];
+ $shareName =~ s/\/*$//; # remove trailing slashes
+
+ $t->{shareName} = $shareName;
+ $t->{shareNameRE} = $bpc->glob2re($shareName);
+
+ #
+ # load all relevant values into @BackupFilesOnly
+ #
+ if ( ref( $conf->{BackupFilesOnly} ) eq "HASH" ) {
+
+ foreach my $share ( ( '*', $shareName ) ) {
+ push @BackupFilesOnly, @{ $conf->{BackupFilesOnly}{$share} }
+ if ( defined( $conf->{BackupFilesOnly}{$share} ) );
+ }
+
+ } elsif ( ref( $conf->{BackupFilesOnly} ) eq "ARRAY" ) {
+
+ push( @BackupFilesOnly, @{ $conf->{BackupFilesOnly} } );
+
+ } elsif ( !defined( $conf->{BackupFilesOnly} ) ) {
+
+ #
+ # do nothing
+ #
+
+ } else {
+
+ #
+ # not a legitimate entry for $conf->{BackupFilesOnly}
+ #
+ $t->{_errStr} = "Incorrect syntax in BackupFilesOnly for host $t->{Host}";
+
+ return;
+ }
+
+ #
+ # load all relevant values into @BackupFilesExclude
+ #
+ if ( ref( $conf->{BackupFilesExclude} ) eq "HASH" ) {
+
+ foreach my $share ( ( '*', $shareName ) ) {
+ push( @BackupFilesExclude,
+ map {
+ ( $_ =~ /^\// )
+ ? ( $t->{shareNameRE} . $bpc->glob2re($_) )
+ : ( '.*\/' . $bpc->glob2re($_) . '(?=\/.*)?' )
+ } @{ $conf->{BackupFilesExclude}{$share} }
+ ) if ( defined( $conf->{BackupFilesExclude}{$share} ) ) ;
+ }
+
+ } elsif ( ref( $conf->{BackupFilesExclude} ) eq "ARRAY" ) {
+
+ push( @BackupFilesExclude,
+ map {
+ ( $_ =~ /\// )
+ ? ( $bpc->glob2re($_) )
+ : ( '.*\/' . $bpc->glob2re($_) . '(?<=\/.*)?' )
+ } @{ $conf->{BackupFilesExclude} } );
+
+ } elsif ( !defined( $conf->{BackupFilesOnly} ) ) {
+
+ #
+ # do nothing here
+ #
+
+ } else {
+
+ #
+ # not a legitimate entry for $conf->{BackupFilesExclude}
+ #
+ $t->{_errStr} =
+ "Incorrect syntax in BackupFilesExclude for host $t->{Host}";
+ return;
+ }
+
+ #
+ # load the regular expressions into the xfer object
+ #
+ $t->{BackupFilesOnly} = ( @BackupFilesOnly > 0 ) ? \@BackupFilesOnly : undef;
+ $t->{BackupFilesExclude} = ( @BackupFilesExclude > 0 ) ? \@BackupFilesExclude : undef;
+
+ return 1;
+}
+
+
+sub checkIncludeExclude
+{
+ my ($t, $file) = @_;
+
+ return ( $t->checkIncludeMatch($file) && !$t->checkExcludeMatch($file) );
+}
+
+sub checkIncludeMatch
+{
+ my ($t, $file) = @_;
+
+ my $shareName = $t->{shareName};
+ my $includes = $t->{BackupFilesOnly} || return 1;
+ my $match = "";
+
+ foreach my $include ( @{$includes} ) {
+
+ #
+ # construct regexp elsewhere to avoid syntactical evil
+ #
+ $match = '^' . quotemeta( $shareName . $include ) . '(?=\/.*)?';
+
+ #
+ # return true if the include folder is a parent of the file,
+ # or the folder itself.
+ #
+ return 1 if ( $file =~ /$match/ );
+
+ $match = '^' . quotemeta($file) . '(?=\/.*)?';
+
+ #
+ # return true if the file is a parent of the include folder,
+ # or the folder itself.
+ #
+ return 1 if ( "$shareName$include" =~ /$match/ );
+ }
+ return 0;
+}
+
+sub checkExcludeMatch
+{
+ my ($t, $file) = @_;
+
+ my $shareName = $t->{shareName};
+ my $includes = $t->{BackupFilesOnly} || return 0;
+ my $match = "";
+
+ foreach my $include ( @{$includes} ) {
+
+ #
+ # construct regexp elsewhere to avoid syntactical evil
+ #
+ $match = '^' . quotemeta( $shareName . $include ) . '(?=\/.*)?';
+
+ #
+ # return true if the include folder is a parent of the file,
+ # or the folder itself.
+ #
+ return 1 if ( $file =~ /$match/ );
+
+ $match = '^' . quotemeta($file) . '(?=\/.*)?';
+
+ #
+ # return true if the file is a parent of the include folder,
+ # or the folder itself.
+ #
+ return 1 if ( "$shareName$include" =~ /$match/ );
+ }
+ return 0;
+}
+
+1;
use BackupPC::View;
use BackupPC::Xfer::RsyncFileIO;
use Encode qw/from_to encode/;
+use base qw(BackupPC::Xfer::Protocol);
use vars qw( $RsyncLibOK $RsyncLibErr );
if ( $File::RsyncP::VERSION < 0.68 ) {
$RsyncLibOK = 0;
$RsyncLibErr = "File::RsyncP module version"
- . " ($File::RsyncP::VERSION) too old: need 0.68";
+ . " ($File::RsyncP::VERSION) too old: need >= 0.68";
} else {
$RsyncLibOK = 1;
}
my($class, $bpc, $args) = @_;
return if ( !$RsyncLibOK );
- $args ||= {};
- my $t = bless {
- bpc => $bpc,
- conf => { $bpc->Conf },
- host => "",
- hostIP => "",
- shareName => "",
- badFiles => [],
-
- #
- # Various stats
- #
- byteCnt => 0,
- fileCnt => 0,
- xferErrCnt => 0,
- xferBadShareCnt => 0,
- xferBadFileCnt => 0,
- xferOK => 0,
-
- #
- # User's args
- #
- %$args,
- }, $class;
-
- return $t;
-}
-
-sub args
-{
- my($t, $args) = @_;
-
- foreach my $arg ( keys(%$args) ) {
- $t->{$arg} = $args->{$arg};
- }
-}
-
-sub useTar
-{
- return 0;
+ my $t = BackupPC::Xfer::Protocol->new($bpc, $args);
+ return bless($t, $class);
}
sub start
return 1;
}
-sub setSelectMask
-{
- my($t, $FDreadRef) = @_;
-}
-
sub errStr
{
my($t) = @_;
return ();
}
-sub logMsg
-{
- my($t, $msg) = @_;
-
- push(@{$t->{_logMsg}}, $msg);
-}
-
-sub logMsgGet
-{
- my($t) = @_;
-
- return shift(@{$t->{_logMsg}});
-}
-
-#
-# Returns a hash ref giving various status information about
-# the transfer.
-#
-sub getStats
-{
- my($t) = @_;
-
- return { map { $_ => $t->{$_} }
- qw(byteCnt fileCnt xferErrCnt xferBadShareCnt xferBadFileCnt
- xferOK hostAbort hostError lastOutputLine)
- };
-}
-
-sub getBadFiles
-{
- my($t) = @_;
-
- return @{$t->{badFiles}};
-}
-
1;
use strict;
use Encode qw/from_to encode/;
-
-sub new
-{
- my($class, $bpc, $args) = @_;
-
- $args ||= {};
- my $t = bless {
- bpc => $bpc,
- conf => { $bpc->Conf },
- host => "",
- hostIP => "",
- shareName => "",
- pipeRH => undef,
- pipeWH => undef,
- badFiles => [],
- %$args,
- }, $class;
-
- return $t;
-}
-
-sub args
-{
- my($t, $args) = @_;
-
- foreach my $arg ( keys(%$args) ) {
- $t->{$arg} = $args->{$arg};
- }
-}
+use base qw(BackupPC::Xfer::Protocol);
sub useTar
{
$t->{XferLOG}->write(\"$_\n") if ( $t->{logLevel} >= 0 );
} elsif ( /^\s*NT_STATUS_ACCESS_DENIED listing (.*)/
|| /^\s*ERRDOS - ERRnoaccess \(Access denied\.\) listing (.*)/ ) {
+ $t->{xferErrCnt}++;
my $badDir = $1;
$badDir =~ s{\\}{/}g;
$badDir =~ s{/+}{/}g;
return 1;
}
-sub abort
-{
- my($t, $reason) = @_;
-
- $t->{abort} = 1;
- $t->{abortReason} = $reason;
-}
-
sub setSelectMask
{
my($t, $FDreadRef) = @_;
vec($$FDreadRef, fileno($t->{pipeSMB}), 1) = 1;
}
-sub errStr
-{
- my($t) = @_;
-
- return $t->{_errStr};
-}
-
-sub xferPid
-{
- my($t) = @_;
-
- return ($t->{xferPid});
-}
-
-sub logMsg
-{
- my($t, $msg) = @_;
-
- push(@{$t->{_logMsg}}, $msg);
-}
-
-sub logMsgGet
-{
- my($t) = @_;
-
- return shift(@{$t->{_logMsg}});
-}
-
-#
-# Returns a hash ref giving various status information about
-# the transfer.
-#
-sub getStats
-{
- my($t) = @_;
-
- return { map { $_ => $t->{$_} }
- qw(byteCnt fileCnt xferErrCnt xferBadShareCnt xferBadFileCnt
- xferOK hostAbort hostError lastOutputLine)
- };
-}
-
-sub getBadFiles
-{
- my($t) = @_;
-
- return @{$t->{badFiles}};
-}
-
1;
use strict;
use Encode qw/from_to encode/;
-
-sub new
-{
- my($class, $bpc, $args) = @_;
-
- $args ||= {};
- my $t = bless {
- bpc => $bpc,
- conf => { $bpc->Conf },
- host => "",
- hostIP => "",
- shareName => "",
- pipeRH => undef,
- pipeWH => undef,
- badFiles => [],
- %$args,
- }, $class;
-
- return $t;
-}
-
-sub args
-{
- my($t, $args) = @_;
-
- foreach my $arg ( keys(%$args) ) {
- $t->{$arg} = $args->{$arg};
- }
-}
+use base qw(BackupPC::Xfer::Protocol);
sub useTar
{
return 1;
}
-sub abort
-{
- my($t, $reason) = @_;
- my @xferPid = $t->xferPid;
-
- $t->{abort} = 1;
- $t->{abortReason} = $reason;
- if ( @xferPid ) {
- kill($t->{bpc}->sigName2num("INT"), @xferPid);
- }
-}
-
sub setSelectMask
{
my($t, $FDreadRef) = @_;
vec($$FDreadRef, fileno($t->{pipeTar}), 1) = 1;
}
-sub errStr
-{
- my($t) = @_;
-
- return $t->{_errStr};
-}
-
-sub xferPid
-{
- my($t) = @_;
-
- return ($t->{xferPid});
-}
-
-sub logMsg
-{
- my($t, $msg) = @_;
-
- push(@{$t->{_logMsg}}, $msg);
-}
-
-sub logMsgGet
-{
- my($t) = @_;
-
- return shift(@{$t->{_logMsg}});
-}
-
-#
-# Returns a hash ref giving various status information about
-# the transfer.
-#
-sub getStats
-{
- my($t) = @_;
-
- return { map { $_ => $t->{$_} }
- qw(byteCnt fileCnt xferErrCnt xferBadShareCnt xferBadFileCnt
- xferOK hostAbort hostError lastOutputLine)
- };
-}
-
-sub getBadFiles
-{
- my($t) = @_;
-
- return @{$t->{badFiles}};
-}
-
1;
--- /dev/null
+package Net::FTP::AutoReconnect;
+our $VERSION = '0.2';
+
+use warnings;
+use strict;
+
+use Net::FTP;
+
+=head1 NAME
+
+Net::FTP::AutoReconnect - FTP client class with automatic reconnect on failure
+
+=head1 SYNOPSIS
+
+C<Net::FTP::AutoReconnect> is a wrapper module around C<Net::FTP>.
+For many commands, if anything goes wrong on the first try, it tries
+to disconnect and reconnect to the server, restore the state to the
+same as it was when the command was executed, then execute it again.
+The state includes login credentials, authorize credentials, transfer
+mode (ASCII or binary), current working directory, and any restart,
+passive, or port commands sent.
+
+=head1 DESCRIPTION
+
+The goal of this method is to hide some implementation details of FTP
+server systems from the programmer. In particular, many FTP systems
+will automatically disconnect a user after a relatively short idle
+time or after a transfer is aborted. In this case,
+C<Net::FTP::AutoReconnect> will simply reconnect, send the commands
+necessary to return your session to its previous state, then resend
+the command. If that fails, it will return the error.
+
+It makes no effort to determine what sorts of errors are likely to
+succeed when they're retried. Partly that's because it's hard to
+know; if you're retreiving a file from an FTP site with several
+mirrors and the file is not found, for example, maybe on the next try
+you'll connect to a different server and find it. But mostly it's
+from laziness; if you have some good ideas about how to determine when
+to retry and when not to bother, by all means send patches.
+
+This module contains an instance of C<Net::FTP>, which it passes most
+method calls along to.
+
+These methods also record their state: C<alloc>, C<ascii>,
+C<authorize>, C<binary>, C<cdup>, C<cwd>, C<hash>,
+C<login>,C<restart>, C<pasv>, C<port>. Directory changing commands
+execute a C<pwd> afterwards and store their new working directory.
+
+These methods are automatically retried: C<alloc>, C<appe>, C<append>,
+C<ascii>, C<binary>, C<cdup>, C<cwd>, C<delete>, C<dir>, C<get>,
+C<list>, C<ls>, C<mdtm>, C<mkdir>, C<nlst>, C<pasv>, C<port>, C<put>,
+C<put_unique>, C<pwd>, C<rename>, C<retr>, C<rmdir>, C<size>, C<stou>,
+C<supported>.
+
+These methods are tried just once: C<abort>, C<authorize>, C<hash>,
+C<login>, C<pasv_xfer>, C<pasv_xfer_unique>, C<pasv_wait>, C<quit>,
+C<restart>, C<site>, C<unique_name>. From C<Net::Cmd>: C<code>,
+C<message>, C<ok>, C<status>. C<restart> doesn't actually send any
+FTP commands (they're sent along with the command they apply to),
+which is why it's not restarted.
+
+Any other commands are unimplemented (or possibly misdocumented); if I
+missed one you'd like, please send a patch.
+
+=head2 CONSTRUCTOR
+
+=head3 new
+
+All parameters are passed along verbatim to C<Net::FTP>, as well as
+stored in case we have to reconnect.
+
+=cut
+ ;
+
+sub new {
+ my $self = {};
+ my $class = shift;
+ bless $self,$class;
+
+ $self->{newargs} = \@_;
+ $self->reconnect();
+
+ $self;
+}
+
+=head2 METHODS
+
+Most of the methods are those of L<Net::FTP|Net::FTP>. One additional
+method is available:
+
+=head3 reconnect()
+
+Abandon the current FTP connection and create a new one, restoring all
+the state we can.
+
+=cut
+ ;
+
+sub reconnect
+{
+ my $self = shift;
+
+ warn "Reconnecting!\n"
+ if ($ENV{DEBUG});
+
+ $self->{ftp} = Net::FTP->new(@{$self->{newargs}})
+ or die "Couldn't create new FTP object\n";
+
+ if ($self->{login})
+ {
+ $self->{ftp}->login(@{$self->{login}});
+ }
+ if ($self->{authorize})
+ {
+ $self->{ftp}->authorize(@{$self->{authorize}});
+ }
+ if ($self->{mode})
+ {
+ if ($self->{mode} eq 'ascii')
+ {
+ $self->{ftp}->ascii();
+ }
+ else
+ {
+ $self->{ftp}->binary();
+ }
+ }
+ if ($self->{cwd})
+ {
+ $self->{ftp}->cwd($self->{cwd});
+ }
+ if ($self->{hash})
+ {
+ $self->{ftp}->hash(@{$self->{hash}});
+ }
+ if ($self->{restart})
+ {
+ $self->{ftp}->restart(@{$self->{restart}});
+ }
+ if ($self->{alloc})
+ {
+ $self->{ftp}->restart(@{$self->{alloc}});
+ }
+ if ($self->{pasv})
+ {
+ $self->{ftp}->pasv(@{$self->{pasv}});
+ }
+ if ($self->{port})
+ {
+ $self->{ftp}->port(@{$self->{port}});
+ }
+}
+
+sub _auto_reconnect
+{
+ my $self = shift;
+ my($code)=@_;
+
+ my $ret = $code->();
+ if (!defined($ret))
+ {
+ $self->reconnect();
+ $ret = $code->();
+ }
+ $ret;
+}
+
+sub _after_pcmd
+{
+ my $self = shift;
+ my($r) = @_;
+ if ($r)
+ {
+ # succeeded
+ delete $self->{port};
+ delete $self->{pasv};
+ delete $self->{restart};
+ delete $self->{alloc};
+ }
+ $r;
+}
+
+
+sub login
+{
+ my $self = shift;
+
+ $self->{login} = \@_;
+ $self->{ftp}->login(@_);
+}
+
+sub authorize
+{
+ my $self = shift;
+ $self->{authorize} = \@_;
+ $self->{ftp}->authorize(@_);
+}
+
+sub site
+{
+ my $self = shift;
+ $self->{ftp}->site(@_);
+}
+
+sub ascii
+{
+ my $self = shift;
+ $self->{mode} = 'ascii';
+ $self->_auto_reconnect(sub { $self->{ftp}->ascii() });
+}
+
+sub binary
+{
+ my $self = shift;
+ $self->{mode} = 'binary';
+ $self->_auto_reconnect(sub { $self->{ftp}->binary() });
+}
+
+sub rename
+{
+ my $self = shift;
+ my @a = @_;
+ $self->_auto_reconnect(sub { $self->{ftp}->rename(@a) });
+}
+
+sub delete
+{
+ my $self = shift;
+ my @a = @_;
+ $self->_auto_reconnect(sub { $self->{ftp}->delete(@a) });
+}
+
+sub cwd
+{
+ my $self = shift;
+ my @a = @_;
+ my $ret = $self->_auto_reconnect(sub { $self->{ftp}->cwd(@a) });
+ if (defined($ret))
+ {
+ $self->{cwd} = $self->{ftp}->pwd()
+ or die "Couldn't get directory after cwd\n";
+ }
+ $ret;
+}
+
+sub cdup
+{
+ my $self = shift;
+ my @a = @_;
+ my $ret = $self->_auto_reconnect(sub { $self->{ftp}->cdup(@a) });
+ if (defined($ret))
+ {
+ $self->{cwd} = $self->{ftp}->pwd()
+ or die "Couldn't get directory after cdup\n";
+ }
+ $ret;
+}
+
+sub pwd
+{
+ my $self = shift;
+ my @a = @_;
+ $self->_auto_reconnect(sub { $self->{ftp}->pwd(@a) });
+}
+
+sub rmdir
+{
+ my $self = shift;
+ my @a = @_;
+ $self->_auto_reconnect(sub { $self->{ftp}->rmdir(@a) });
+}
+
+sub mkdir
+{
+ my $self = shift;
+ my @a = @_;
+ $self->_auto_reconnect(sub { $self->{ftp}->mkdir(@a) });
+}
+
+sub ls
+{
+ my $self = shift;
+ my @a = @_;
+ my $ret = $self->_auto_reconnect(sub { $self->{ftp}->ls(@a) });
+ return $ret ? (wantarray ? @$ret : $ret) : undef;
+}
+
+sub dir
+{
+ my $self = shift;
+ my @a = @_;
+ my $ret = $self->_auto_reconnect(sub { $self->{ftp}->dir(@a) });
+ return $ret ? (wantarray ? @$ret : $ret) : undef;
+}
+
+sub restart
+{
+ my $self = shift;
+ my @a = @_;
+ $self->{restart} = \@a;
+ $self->{ftp}->restart(@_);
+}
+
+sub retr
+{
+ my $self = shift;
+ my @a = @_;
+ $self->_after_pcmd($self->_auto_reconnect(sub { $self->{ftp}->retr(@a) }));
+}
+
+sub get
+{
+ my $self = shift;
+ my @a = @_;
+ $self->_auto_reconnect(sub { $self->{ftp}->get(@a) });
+}
+
+sub mdtm
+{
+ my $self = shift;
+ my @a = @_;
+ $self->_auto_reconnect(sub { $self->{ftp}->mdtm(@a) });
+}
+
+sub size
+{
+ my $self = shift;
+ my @a = @_;
+ $self->_auto_reconnect(sub { $self->{ftp}->size(@a) });
+}
+
+sub abort
+{
+ my $self = shift;
+ $self->{ftp}->abort();
+}
+
+sub quit
+{
+ my $self = shift;
+ $self->{ftp}->quit();
+}
+
+sub hash
+{
+ my $self = shift;
+ my @a = @_;
+ $self->{hash} = \@a;
+ $self->{ftp}->hash(@_);
+}
+
+sub alloc
+{
+ my $self = shift;
+ my @a = @_;
+ $self->{alloc} = \@a;
+ $self->_auto_reconnect(sub { $self->{ftp}->alloc(@a) });
+}
+
+sub put
+{
+ my $self = shift;
+ my @a = @_;
+ $self->_auto_reconnect(sub { $self->{ftp}->put(@a) });
+}
+
+sub put_unique
+{
+ my $self = shift;
+ my @a = @_;
+ $self->_auto_reconnect(sub { $self->{ftp}->put_unique(@a) });
+}
+
+sub append
+{
+ my $self = shift;
+ my @a = @_;
+ $self->_auto_reconnect(sub { $self->{ftp}->append(@a) });
+}
+
+sub unique_name
+{
+ my $self = shift;
+ $self->{ftp}->unique_name(@_);
+}
+
+sub supported
+{
+ my $self = shift;
+ my @a = @_;
+ $self->_auto_reconnect(sub { $self->{ftp}->supported(@a) });
+}
+
+sub port
+{
+ my $self = shift;
+ my @a = @_;
+ $self->{port} = \@a;
+ $self->_auto_reconnect(sub { $self->{ftp}->port(@a) });
+}
+
+sub pasv
+{
+ my $self = shift;
+ my @a = @_;
+ $self->{pasv} = \@a;
+ $self->_auto_reconnect(sub { $self->{ftp}->pasv(@a) });
+}
+
+sub nlst
+{
+ my $self = shift;
+ my @a = @_;
+ $self->_after_pcmd($self->_auto_reconnect(sub { $self->{ftp}->nlst(@a) }));
+}
+
+sub stou
+{
+ my $self = shift;
+ my @a = @_;
+ $self->_after_pcmd($self->_auto_reconnect(sub { $self->{ftp}->stou(@a) }));
+}
+
+sub appe
+{
+ my $self = shift;
+ my @a = @_;
+ $self->_after_pcmd($self->_auto_reconnect(sub { $self->{ftp}->appe(@a) }));
+}
+
+sub list
+{
+ my $self = shift;
+ my @a = @_;
+ $self->_after_pcmd($self->_auto_reconnect(sub { $self->{ftp}->list(@a) }));
+}
+
+sub pasv_xfer
+{
+ my $self = shift;
+ $self->{ftp}->pasv_xfer(@_);
+}
+
+sub pasv_xfer_unique
+{
+ my $self = shift;
+ $self->{ftp}->pasv_xfer_unique(@_);
+}
+
+sub pasv_wait
+{
+ my $self = shift;
+ $self->{ftp}->pasv_wait(@_);
+}
+
+sub message
+{
+ my $self = shift;
+ $self->{ftp}->message(@_);
+}
+
+sub code
+{
+ my $self = shift;
+ $self->{ftp}->code(@_);
+}
+
+sub ok
+{
+ my $self = shift;
+ $self->{ftp}->ok(@_);
+}
+
+sub status
+{
+ my $self = shift;
+ $self->{ftp}->status(@_);
+}
+
+=head1 AUTHOR
+
+Scott Gifford <sgifford@suspectclass.com>
+
+=head1 BUGS
+
+We should really be smarter about when to retry.
+
+We shouldn't be hardwired to use C<Net::FTP>, but any FTP-compatible
+class; that would allow all modules similar to this one to be chained
+together.
+
+Much of this is only lightly tested; it's hard to find an FTP server
+unreliable enough to test all aspects of it. It's mostly been tested
+with a server that dicsonnects after an aborted transfer, and the
+module seems to work OK.
+
+=head1 SEE ALSO
+
+L<Net::FTP>.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2006 Scott Gifford. All rights reserved. This program
+is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself.
+
+=cut
+
+1;
--- /dev/null
+package Net::FTP::RetrHandle;
+our $VERSION = '0.2';
+
+use warnings;
+use strict;
+
+use constant DEFAULT_MAX_SKIPSIZE => 1024 * 1024 * 2;
+use constant DEFAULT_BLOCKSIZE => 10240; # Net::FTP's default
+
+use base 'IO::Seekable';
+# We don't use base 'IO::Handle'; it currently confuses Archive::Zip.
+
+use Carp;
+use Scalar::Util;
+
+
+=head1 NAME
+
+Net::FTP::RetrHandle - Tied or IO::Handle-compatible interface to a file retrieved by FTP
+
+=head1 SYNOPSIS
+
+Provides a file reading interface for reading all or parts of files
+located on a remote FTP server, including emulation of C<seek> and
+support for downloading only the parts of the file requested.
+
+=head1 DESCRIPTION
+
+Support for skipping the beginning of the file is implemented with the
+FTP C<REST> command, which starts a retrieval at any point in the
+file. Support for skipping the end of the file is implemented with
+the FTP C<ABOR> command, which stops the transfer. With these two
+commands and some careful tracking of the current file position, we're
+able to reliably emulate a C<seek/read> pair, and get only the parts
+of the file that are actually read.
+
+This was originally designed for use with
+L<Archive::Zip|Archive::Zip>; it's reliable enough that the table of
+contents and individual files can be extracted from a remote ZIP
+archive without downloading the whole thing. See L<EXAMPLES> below.
+
+An interface compatible with L<IO::Handle|IO::Handle> is provided,
+along with a C<tie>-based interface.
+
+Remember that an FTP server can only do one thing at a time, so make
+sure to C<close> your connection before asking the FTP server to do
+nything else.
+
+=head1 CONSTRUCTOR
+
+=head2 new ( $ftp, $filename, options... )
+
+Creates a new L<IO::Handle|IO::Handle>-compatible object to fetch all
+or parts of C<$filename> using the FTP connection C<$ftp>.
+
+Available options:
+
+=over 4
+
+=item MaxSkipSize => $size
+
+If we need to move forward in a file or close the connection,
+sometimes it's faster to just read the bytes we don't need than to
+abort the connection and restart. This setting tells how many
+unnecessary bytes we're willing to read rather than abort. An
+appropriate setting depends on the speed of transferring files and the
+speed of reconnecting to the server.
+
+=item BlockSize => $size
+
+When doing buffered reads, how many bytes to read at once. The
+default is the same as the default for L<Net::FTP|Net::FTP>, so it's
+generally best to leave it alone.
+
+=item AlreadyBinary => $bool
+
+If set to a true value, we assume the server is already in binary
+mode, and don't try to set it.
+
+=back
+
+=cut
+use constant USAGE => "Usage: Net::FTP::RetrHandle\->new(ftp => \$ftp_obj, filename => \$filename)\n";
+sub new
+{
+ my $class = shift;
+ my $ftp = shift
+ or croak USAGE;
+ my $filename = shift
+ or croak USAGE;
+ my $self = { MaxSkipSize => DEFAULT_MAX_SKIPSIZE,
+ BlockSize => DEFAULT_BLOCKSIZE,
+ @_,
+ ftp => $ftp, filename => $filename,
+ pos => 0, nextpos => 0};
+ $self->{size} = $self->{ftp}->size($self->{filename})
+ or return undef;
+ $self->{ftp}->binary()
+ unless ($self->{AlreadyBinary});
+
+ bless $self,$class;
+}
+
+=head1 METHODS
+
+Most of the methods implemented behave exactly like those from
+L<IO::Handle|IO::Handle>.
+
+These methods are implemented: C<binmode>, C<clearerr>, C<close>, C<eof>,
+C<error>, C<getc>, C<getline>, C<getlines>, C<getpos>, C<read>,
+C<seek>, C<setpos>, C<sysseek>, C<tell>, C<ungetc>, C<opened>.
+
+=cut ;
+
+sub opened { 1; }
+
+sub seek
+{
+ my $self = shift;
+ my $pos = shift || 0;
+ my $whence = shift || 0;
+ warn " SEEK: self=$self, pos=$pos, whence=$whence\n"
+ if ($ENV{DEBUG});
+ my $curpos = $self->tell();
+ my $newpos = _newpos($self->tell(),$self->{size},$pos,$whence);
+ my $ret;
+ if ($newpos == $curpos)
+ {
+ return $curpos;
+ }
+ elsif (defined($self->{_buf}) and ($newpos > $curpos) and ($newpos < ($curpos + length($self->{_buf}))))
+ {
+ # Just seeking within the buffer (or not at all)
+ substr($self->{_buf},0,$newpos - $curpos,'');
+ $ret = $newpos;
+ }
+ else
+ {
+ $ret = $self->sysseek($newpos,0);
+ $self->{_buf} = '';
+ }
+ return $ret;
+}
+
+sub _newpos
+{
+
+ my($curpos,$size,$pos,$whence)=@_;
+ if ($whence == 0) # seek_set
+ {
+ return $pos;
+ }
+ elsif ($whence == 1) # seek_cur
+ {
+ return $curpos + $pos;
+ }
+ elsif ($whence == 2) # seek_end
+ {
+ return $size + $pos;
+ }
+ else
+ {
+ die "Invalid value $whence for whence!";
+ }
+}
+
+sub sysseek
+{
+ my $self = shift;
+ my $pos = shift || 0;
+ my $whence = shift || 0;
+ warn "SYSSEEK: self=$self, pos=$pos, whence=$whence\n"
+ if ($ENV{DEBUG});
+ my $newpos = _newpos($self->{nextpos},$self->{size},$pos,$whence);
+
+ $self->{eof}=undef;
+ return $self->{nextpos}=$newpos;
+}
+
+sub tell
+{
+ my $self = shift;
+ return $self->{nextpos} - (defined($self->{_buf}) ? length($self->{_buf}) : 0);
+}
+
+# WARNING: ASCII mode probably breaks seek.
+sub binmode
+{
+ my $self = shift;
+ my $mode = shift || ':raw';
+ return if (defined($self->{curmode}) && ($self->{curmode} eq $mode));
+ if (defined($mode) and $mode eq ':crlf')
+ {
+ $self->_finish_connection();
+ $self->{ftp}->ascii()
+ or return $self->seterr();
+ }
+ else
+ {
+ $self->_finish_connection();
+ $self->{ftp}->binary()
+ or return $self->seterr();
+ }
+ $self->{curmode} = $mode;
+}
+
+sub _min
+{
+ return $_[0] < $_[1] ? $_[0] : $_[1];
+}
+
+sub _max
+{
+ return $_[0] > $_[1] ? $_[0] : $_[1];
+}
+
+sub read
+{
+ my $self = shift;
+# return $self->sysread(@_);
+
+ my(undef,$len,$offset)=@_;
+ $offset ||= 0;
+ warn "READ(buf,$len,$offset)\n"
+ if ($ENV{DEBUG});
+
+ if (!defined($self->{_buf}) || length($self->{_buf}) <= 0)
+ {
+ $self->sysread($self->{_buf},_max($len,$self->{BlockSize}))
+ or return 0;
+ }
+ elsif (length($self->{_buf}) < $len)
+ {
+ $self->sysread($self->{_buf},_max($len-length($self->{_buf}),$self->{BlockSize}),length($self->{_buf}));
+ }
+ my $ret = _min($len,length($self->{_buf}));
+ if (!defined($_[0])) { $_[0] = '' }
+ substr($_[0],$offset) = substr($self->{_buf},0,$len,'');
+ $self->{read_count}++;
+
+ return $ret;
+}
+
+sub sysread
+{
+ my $self = shift;
+ if ($self->{eof})
+ {
+ return 0;
+ }
+
+ my(undef,$len,$offset) = @_;
+ $offset ||= 0;
+
+ warn "SYSREAD(buf,$len,$offset)\n"
+ if ($ENV{DEBUG});
+ if ($self->{nextpos} >= $self->{size})
+ {
+ $self->{eof} = 1;
+ $self->{pos} = $self->{nextpos};
+ return 0;
+ }
+
+ if ($self->{pos} != $self->{nextpos})
+ {
+ # They seeked.
+ if ($self->{ftp_running})
+ {
+ warn "Seek detected, nextpos=$self->{nextpos}, pos=$self->{pos}, MaxSkipSize=$self->{MaxSkipSize}\n"
+ if ($ENV{DEBUG});
+ if ($self->{nextpos} > $self->{pos} and ($self->{nextpos} - $self->{pos}) < $self->{MaxSkipSize})
+ {
+ my $br = $self->{nextpos}-$self->{pos};
+ warn "Reading $br bytes to skip ahead\n"
+ if ($ENV{DEBUG});
+ my $junkbuff;
+ while ($br > 0)
+ {
+ warn "Trying to read $br more bytes\n"
+ if ($ENV{DEBUG});
+ my $b = $self->{ftp_data}->read($junkbuff,$br);
+ if ($b == 0)
+ {
+ $self->_at_eof();
+ return 0;
+ }
+ elsif (!defined($b) || $b < 0)
+ {
+ return $self->seterr();
+ }
+ else
+ {
+ $br -= $b;
+ }
+ }
+ $self->{pos}=$self->{nextpos};
+ }
+ else
+ {
+ warn "Aborting connection to move to new position\n"
+ if ($ENV{DEBUG});
+ $self->_finish_connection();
+ }
+ }
+ }
+
+ if (!$self->{ftp_running})
+ {
+ $self->{ftp}->restart($self->{nextpos});
+ $self->{ftp_data} = $self->{ftp}->retr($self->{filename})
+ or return $self->seterr();
+ $self->{ftp_running} = 1;
+ $self->{pos}=$self->{nextpos};
+ }
+
+ my $tmpbuf;
+ my $rb = $self->{ftp_data}->read($tmpbuf,$len);
+ if ($rb == 0)
+ {
+ $self->_at_eof();
+ return 0;
+ }
+ elsif (!defined($rb) || $rb < 0)
+ {
+ return $self->seterr();
+ }
+
+ if (!defined($_[0])) { $_[0] = '' }
+ substr($_[0],$offset) = $tmpbuf;
+ $self->{pos} += $rb;
+ $self->{nextpos} += $rb;
+
+ $self->{sysread_count}++;
+ $rb;
+}
+
+sub _at_eof
+{
+ my $self = shift;
+ $self->{eof}=1;
+ $self->_finish_connection();
+# $self->{ftp_data}->_close();
+ $self->{ftp_running} = $self->{ftp_data} = undef;
+}
+
+sub _finish_connection
+{
+ my $self = shift;
+ warn "_finish_connection\n"
+ if ($ENV{DEBUG});
+ return unless ($self->{ftp_running});
+
+ if ($self->{size} - $self->{pos} < $self->{MaxSkipSize})
+ {
+ warn "Skipping " . ($self->{size}-$self->{pos}) . " bytes\n"
+ if ($ENV{DEBUG});
+ my $junkbuff;
+ my $br;
+ while(($br = $self->{ftp_data}->read($junkbuff,8192)))
+ {
+ # Read until EOF or error
+ }
+ defined($br)
+ or $self->seterr();
+ }
+ warn "Shutting down existing FTP DATA session...\n"
+ if ($ENV{DEBUG});
+
+ my $closeret;
+ {
+ eval {
+ $closeret = $self->{ftp_data}->close();
+ };
+ # Work around a timeout bug in Net::FTP
+ if ($@ && $@ =~ /^Timeout /)
+ {
+ warn "Timeout closing connection, retrying...\n"
+ if ($ENV{DEBUG});
+ select(undef,undef,undef,1);
+ redo;
+ }
+ }
+
+ $self->{ftp_running} = $self->{ftp_data} = undef;
+ return $closeret ? 1 : $self->seterr();
+}
+
+sub write
+{
+ die "Only reading currently supported";
+}
+
+sub close
+{
+ my $self = shift;
+ return $self->{ftp_data} ? $self->_finish_connection()
+ : 1;
+}
+
+sub eof
+{
+ my $self = shift;
+ if ($self->{eof})
+ {
+ return 1;
+ }
+
+ my $c = $self->getc;
+ if (!defined($c))
+ {
+ return 1;
+ }
+ $self->ungetc(ord($c));
+ return undef;
+}
+
+sub getc
+{
+ my $self = shift;
+ my $c;
+ my $rb = $self->read($c,1);
+ if ($rb < 1)
+ {
+ return undef;
+ }
+ return $c;
+}
+
+sub ungetc
+{
+ my $self = shift;
+ # Note that $c is the ordinal value of a character, not the
+ # character itself (for some reason)
+ my($c)=@_;
+ $self->{_buf} = chr($c) . $self->{_buf};
+}
+
+sub getline
+{
+ my $self = shift;
+ if (!defined($/))
+ {
+ my $buf;
+ while($self->read($buf,$self->{BlockSize},length($buf)) > 0)
+ {
+ # Keep going
+ }
+ return $buf;
+ }
+ elsif (ref($/) && looks_like_number ${$/} )
+ {
+ my $buf;
+ $self->read($buf,${$/})
+ or return undef;
+ return $buf;
+ }
+
+ my $rs;
+ if ($/ eq '')
+ {
+ $rs = "\n\n";
+ }
+ else
+ {
+ $rs = $/;
+ }
+ my $eol;
+ if (!defined($self->{_buf})) { $self->{_buf} = '' }
+ while (($eol=index($self->{_buf},$rs)) < $[)
+ {
+ if ($self->{eof})
+ {
+ # return what's left
+ if (length($self->{_buf}) == 0)
+ {
+ return undef;
+ }
+ else
+ {
+ return substr($self->{_buf},0,length($self->{_buf}),'');
+ }
+ }
+ else
+ {
+ $self->sysread($self->{_buf},$self->{BlockSize},length($self->{_buf}));
+ }
+ }
+ # OK, we should have a match.
+ my $tmpbuf = substr($self->{_buf},0,$eol+length($rs),'');
+ while ($/ eq '' and substr($self->{_buf},0,1) eq "\n")
+ {
+ substr($self->{_buf},0,1)='';
+ }
+ return $tmpbuf;
+}
+
+sub getlines
+{
+ my $self = shift;
+ my @lines;
+ my $line;
+ while (defined($line = $self->getline()))
+ {
+ push(@lines,$line);
+ }
+ @lines;
+}
+
+sub error
+{
+ return undef;
+}
+
+sub seterr
+{
+ my $self = shift;
+ $self->{_error} = 1;
+ return undef;
+}
+
+sub clearerr
+{
+ my $self = shift;
+ $self->{_error} = undef;
+ return 0;
+}
+
+sub getpos
+{
+ my $self = shift;
+ return $self->tell();
+}
+
+sub setpos
+{
+ my $self = shift;
+ return $self->seek(@_);
+}
+
+sub DESTROY
+{
+ my $self = shift;
+ if (UNIVERSAL::isa($self,'GLOB'))
+ {
+ $self = tied *$self
+ or die "$self not tied?...";
+ }
+ if ($self->{ftp_data})
+ {
+ $self->_finish_connection();
+ }
+ warn "sysread called ".$self->{sysread_count}." times.\n"
+ if ($ENV{DEBUG});
+}
+
+=head1 TIED INTERFACE
+
+Instead of a L<IO::Handle|IO::Handle>-compatible interface, you can
+use a C<tie>-based interface to use the standard Perl I/O operators.
+You can use it like this:
+
+ use Net::FTP::RetrHandle;
+ # Create FTP object in $ftp
+ # Store filename in $filename
+ tie *FH, 'Net::FTP::RetrHandle', $ftp, $filename
+ or die "Error in tie!\n";
+
+=cut
+ ;
+sub TIEHANDLE
+{
+ my $class = shift;
+ my $obj = $class->new(@_);
+ $obj;
+}
+
+sub READ
+{
+ my $self = shift;
+ $self->read(@_);
+}
+
+sub READLINE
+{
+ my $self = shift;
+ return wantarray ? $self->getlines(@_)
+ : $self->getline(@_);
+}
+
+sub GETC
+{
+ my $self = shift;
+ return $self->getc(@_);
+}
+
+sub SEEK
+{
+ my $self = shift;
+ return $self->seek(@_);
+}
+
+sub SYSSEEK
+{
+ my $self = shift;
+ return $self->sysseek(@_);
+}
+
+sub TELL
+{
+ my $self = shift;
+ return $self->tell();
+}
+
+sub CLOSE
+{
+ my $self = shift;
+ return $self->close(@_);
+}
+
+sub EOF
+{
+ my $self = shift;
+ return $self->eof(@_);
+
+}
+sub UNTIE
+{
+ tied($_[0])->close(@_);
+}
+
+=head1 EXAMPLE
+
+Here's an example of listing a Zip file without downloading the whole
+thing:
+
+ #!/usr/bin/perl
+
+ use warnings;
+ use strict;
+
+ use Net::FTP;
+ use Net::FTP::AutoReconnect;
+ use Net::FTP::RetrHandle;
+ use Archive::Zip;
+
+ my $ftp = Net::FTP::AutoReconnect->new("ftp.info-zip.com", Debug => $ENV{DEBUG})
+ or die "connect error\n";
+ $ftp->login('anonymous','example@example.com')
+ or die "login error\n";
+ $ftp->cwd('/pub/infozip/UNIX/LINUX')
+ or die "cwd error\n";
+ my $fh = Net::FTP::RetrHandle->new($ftp,'unz551x-glibc.zip')
+ or die "Couldn't get handle to remote file\n";
+ my $zip = Archive::Zip->new($fh)
+ or die "Couldn't create Zip object\n";
+ foreach my $fn ($zip->memberNames())
+ {
+ print "unz551-glibc.zip: $fn\n";
+ }
+
+
+=head1 AUTHOR
+
+Scott Gifford <sgifford@suspectclass.com>
+
+=head1 BUGS
+
+The distinction between tied filehandles and C<IO::Handle>-compatible
+filehandles should be blurrier. It seems like other file handle
+objects you can freely mix method calls and traditional Perl
+operations, but I can't figure out how to do it.
+
+Many FTP servers don't like frequent connection aborts. If that's the
+case, try L<Net::FTP::AutoReconnect>, which will hide much of that
+from you.
+
+If the filehandle is tied and created with C<gensym>, C<readline>
+doesn't work with older versions of Perl. No idea why.
+
+=head1 SEE ALSO
+
+L<Net::FTP>, L<Net::FTP::AutoReconnect>, L<IO::Handle>.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2006 Scott Gifford. All rights reserved. This program
+is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself.
+
+=cut
+
+1;
-#!/bin/perl
+#!/usr/bin/env perl
#
# makeDist: Build a BackupPC distribution
#
umask(0022);
-my $Version = "3.1.0";
-my $ReleaseDate = "25 Nov 2007";
+my $Version = "3.2.0";
+my $ReleaseDate = "31 Dec 2008";
my $DistDir = "dist/BackupPC-$Version";
my @PerlSrc = qw(
lib/BackupPC/Lang/pt_br.pm
lib/BackupPC/Lang/zh_CN.pm
lib/BackupPC/Storage/Text.pm
+ lib/BackupPC/Xfer.pm
lib/BackupPC/Xfer/Archive.pm
lib/BackupPC/Xfer/BackupPCd.pm
- lib/BackupPC/Xfer/Smb.pm
- lib/BackupPC/Xfer/Tar.pm
+ lib/BackupPC/Xfer/Ftp.pm
+ lib/BackupPC/Xfer/Protocol.pm
lib/BackupPC/Xfer/Rsync.pm
lib/BackupPC/Xfer/RsyncDigest.pm
lib/BackupPC/Xfer/RsyncFileIO.pm
+ lib/BackupPC/Xfer/Smb.pm
+ lib/BackupPC/Xfer/Tar.pm
lib/BackupPC/Zip/FileMember.pm
+ lib/Net/FTP/AutoReconnect.pm
+ lib/Net/FTP/RetrHandle.pm
cgi-bin/BackupPC_Admin
);
$ConfVars->{BlackoutWeekDays} = 2;
$ConfVars->{RsyncLogLevel} = 2;
+system("perl -Ilib -c conf/config.pl >& /dev/null")
+ && die("$0: conf/config.pl contains a syntax error\n");
foreach my $file ( @PerlSrc ) {
+ system("perl -Ilib -c $file >& /dev/null")
+ && die("$0: $file contains a syntax error\n");
$errCnt += CheckConfigParams($file, $ConfVars, 1);
}
if ( !$opts{l} ) {
rmtree($DistDir, 0, 0);
mkpath($DistDir, 0, 0777);
-foreach my $dir ( qw(bin doc conf images init.d/src cgi-bin
+foreach my $dir ( qw(bin doc conf images init.d/src cgi-bin httpd/src
lib/BackupPC/CGI
lib/BackupPC/Config
lib/BackupPC/Lang
lib/BackupPC/Storage
lib/BackupPC/Xfer
lib/BackupPC/Zip
+ lib/Net/FTP
) ) {
mkpath("$DistDir/$dir", 0, 0777);
}
init.d/src/slackware-backuppc
init.d/src/solaris-backuppc
init.d/src/suse-backuppc
+ httpd/src/BackupPC.conf
doc/BackupPC.pod
doc/BackupPC.html
README
use File::Find;
use File::Path;
-my $BaseVersion = "2.1.2";
-my $PatchLevel = "pl1";
+my $BaseVersion = "3.2.0";
+my $PatchLevel = "pl0";
my $PatchVersion = "$BaseVersion$PatchLevel";
my $Base = "/home/craig/admin/packages/BackupPC-$BaseVersion";
projects / BackupPC.git / commitdiff