From 5b79f9a3c01bca16dd4d211e76fc53daa549e421 Mon Sep 17 00:00:00 2001 From: cbarratt Date: Fri, 26 Dec 2008 13:12:23 +0000 Subject: [PATCH] * Added BackupPC::Xfer::Protocol as a common class for each Xfer method. This simplifies some of the xfer specific code. Implemented by Paul Mantz. MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit * 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. --- ChangeLog | 43 ++ bin/BackupPC_archive | 2 +- bin/BackupPC_archiveHost | 19 +- bin/BackupPC_dump | 141 ++--- bin/BackupPC_restore | 42 +- bin/BackupPC_sendEmail | 6 +- conf/config.pl | 94 ++- configure.pl | 39 +- httpd/src/BackupPC.conf | 33 ++ lib/BackupPC/CGI/EditConfig.pm | 30 +- lib/BackupPC/CGI/RSS.pm | 2 +- lib/BackupPC/Config/Meta.pm | 57 +- lib/BackupPC/Lang/de.pm | 5 +- lib/BackupPC/Lang/en.pm | 1 + lib/BackupPC/Lang/es.pm | 1 + lib/BackupPC/Lang/fr.pm | 1 + lib/BackupPC/Lang/it.pm | 1 + lib/BackupPC/Lang/nl.pm | 1 + lib/BackupPC/Lang/pl.pm | 1 + lib/BackupPC/Lang/pt_br.pm | 3 +- lib/BackupPC/Lang/zh_CN.pm | 1 + lib/BackupPC/Lib.pm | 84 ++- lib/BackupPC/Xfer.pm | 152 +++++ lib/BackupPC/Xfer/Archive.pm | 67 +-- lib/BackupPC/Xfer/BackupPCd.pm | 58 +- lib/BackupPC/Xfer/Ftp.pm | 1019 ++++++++++++++++++++++++++++++++ lib/BackupPC/Xfer/Protocol.pm | 452 ++++++++++++++ lib/BackupPC/Xfer/Rsync.pm | 85 +-- lib/BackupPC/Xfer/Smb.pm | 88 +-- lib/BackupPC/Xfer/Tar.pm | 91 +-- lib/Net/FTP/AutoReconnect.pm | 509 ++++++++++++++++ lib/Net/FTP/RetrHandle.pm | 692 ++++++++++++++++++++++ makeDist | 23 +- makePatch | 4 +- 34 files changed, 3298 insertions(+), 549 deletions(-) create mode 100644 httpd/src/BackupPC.conf create mode 100644 lib/BackupPC/Xfer.pm create mode 100644 lib/BackupPC/Xfer/Ftp.pm create mode 100644 lib/BackupPC/Xfer/Protocol.pm create mode 100644 lib/Net/FTP/AutoReconnect.pm create mode 100644 lib/Net/FTP/RetrHandle.pm diff --git a/ChangeLog b/ChangeLog index 2840ee2..28ab594 100644 --- a/ChangeLog +++ b/ChangeLog @@ -21,6 +21,49 @@ # 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 #------------------------------------------------------------------------ diff --git a/bin/BackupPC_archive b/bin/BackupPC_archive index 7d38e81..87ed842 100644 --- a/bin/BackupPC_archive +++ b/bin/BackupPC_archive @@ -64,7 +64,7 @@ if ( @ARGV != 3 ) { } $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); } diff --git a/bin/BackupPC_archiveHost b/bin/BackupPC_archiveHost index f5535f1..2416df3 100755 --- a/bin/BackupPC_archiveHost +++ b/bin/BackupPC_archiveHost @@ -86,8 +86,9 @@ my $mesg = "Writing tar archive for host $host, backup #$bkupNum"; # # 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 @@ -112,8 +113,8 @@ if ( -b $outLoc || -c $outLoc || -f $outLoc ) { # # 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 ) { @@ -121,11 +122,11 @@ if ( -b $outLoc || -c $outLoc || -f $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"); @@ -147,7 +148,7 @@ if ( $ret ) { 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"); diff --git a/bin/BackupPC_dump b/bin/BackupPC_dump index b54c208..3e212d0 100755 --- a/bin/BackupPC_dump +++ b/bin/BackupPC_dump @@ -82,10 +82,7 @@ use lib "/usr/local/BackupPC/lib"; 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; @@ -458,6 +455,28 @@ if ( @Backups == 0 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" @@ -566,17 +585,7 @@ my $sizeTotal = 0; 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 @@ -617,40 +626,14 @@ for my $shareName ( @$ShareNames ) { 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; @@ -789,43 +772,41 @@ for my $shareName ( @$ShareNames ) { # 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"); diff --git a/bin/BackupPC_restore b/bin/BackupPC_restore index f23afe8..4549ccf 100755 --- a/bin/BackupPC_restore +++ b/bin/BackupPC_restore @@ -40,10 +40,7 @@ no utf8; 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; @@ -236,37 +233,14 @@ if ( $? && $Conf{UserCmdCheckStatus} ) { } $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 ) { diff --git a/bin/BackupPC_sendEmail b/bin/BackupPC_sendEmail index 390093a..055884a 100755 --- a/bin/BackupPC_sendEmail +++ b/bin/BackupPC_sendEmail @@ -42,6 +42,7 @@ no utf8; use lib "/usr/local/BackupPC/lib"; use BackupPC::Lib; use BackupPC::FileZIO; +use Encode; use Data::Dumper; use Getopt::Std; @@ -363,6 +364,8 @@ sub user2name sub sendUserEmail { my($user, $host, $mesg, $subj, $vars) = @_; + return if ( $Conf{BackupsDisable} ); + $vars->{user} = $user; $vars->{host} = $host; $vars->{headers} = $Conf{EMailHeaders}; @@ -370,7 +373,7 @@ sub sendUserEmail $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; @@ -388,6 +391,7 @@ sub SendMail if ( $opts{t} ) { binmode(STDOUT, ":utf8") if ( $utf8 ); + print("#" x 75, "\n"); print $mesg; return; diff --git a/conf/config.pl b/conf/config.pl index a807a79..abdcd32 100644 --- a/conf/config.pl +++ b/conf/config.pl @@ -888,6 +888,10 @@ $Conf{ClientCharset} = ''; # $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. @@ -987,6 +991,10 @@ $Conf{SmbClientRestoreCmd} = '$smbClientPath \\\\$host\\$shareName' . ' $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 @@ -1130,6 +1138,10 @@ $Conf{TarClientRestoreCmd} = '$sshPath -q -x -l root $host' # $Conf{TarClientPath} = ''; +########################################################################### +# Rsync/Rsyncd Configuration +# (can be overwritten in the per-PC log file) +########################################################################### # # Path to rsync executable on the client # @@ -1324,6 +1336,73 @@ $Conf{RsyncRestoreArgs} = [ # ]; +########################################################################### +# 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'. @@ -1384,7 +1463,10 @@ $Conf{BackupPCdCmd} = '$bpcdPath $host $shareName $poolDir XXXX $poolCompress $t # $Conf{BackupPCdRestoreCmd} = '$bpcdPath TODO'; - +########################################################################### +# Archive Configuration +# (can be overwritten in the per-PC log file) +########################################################################### # # Archive Destination # @@ -2128,6 +2210,16 @@ $Conf{CgiUserConfigEdit} = { 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, diff --git a/configure.pl b/configure.pl index 7ec545c..e0923d2 100755 --- a/configure.pl +++ b/configure.pl @@ -1,4 +1,4 @@ -#!/bin/perl +#!/usr/bin/env perl #============================================================= -*-perl-*- # # configure.pl: Configuration and installation program for BackupPC @@ -97,6 +97,7 @@ if ( !GetOptions( "cgi-dir=s", "compress-level=i", "config-path=s", + "config-override=s%", "config-dir=s", "data-dir=s", "dest-dir=s", @@ -230,10 +231,15 @@ EOF # 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"; } # @@ -528,6 +534,7 @@ foreach my $dir ( qw(bin doc 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); @@ -616,6 +623,9 @@ foreach my $init ( qw(gentoo-backuppc gentoo-backuppc.conf linux-backuppc 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); @@ -792,6 +802,23 @@ if ( defined($Conf{CgiUserConfigEdit}) ) { =~ 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 # @@ -930,6 +957,8 @@ sub InstallFile 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). diff --git a/httpd/src/BackupPC.conf b/httpd/src/BackupPC.conf new file mode 100644 index 0000000..163bff9 --- /dev/null +++ b/httpd/src/BackupPC.conf @@ -0,0 +1,33 @@ +# +# DESCRIPTION +# +# This file controls access and configuration for the BackupPC CGI +# interface. +# +# Distributed with BackupPC version 3.1.1, released 22 Dec 2008. + + + +# +# 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 + + + +Alias __IMAGEDIRURL__ __IMAGEDIR__ +ScriptAlias /BackupPC_Admin __CGIDIR__/BackupPC_Admin diff --git a/lib/BackupPC/CGI/EditConfig.pm b/lib/BackupPC/CGI/EditConfig.pm index edc4526..9b78b15 100644 --- a/lib/BackupPC/CGI/EditConfig.pm +++ b/lib/BackupPC/CGI/EditConfig.pm @@ -28,7 +28,7 @@ # #======================================================================== # -# Version 3.1.0, released 25 Nov 2007. +# Version 3.1.1, released 22 Dec 2008. # # See http://backuppc.sourceforge.net. # @@ -173,6 +173,7 @@ our %ConfigMenu = ( {name => "ClientCharset"}, {name => "ClientCharsetLegacy"}, + ### Smb Settings {text => "CfgEdit_Title_Smb_Settings", visible => sub { return $_[0]->{XferMethod} eq "smb"; } }, {name => "SmbShareName", @@ -182,11 +183,13 @@ our %ConfigMenu = ( {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", @@ -202,6 +205,25 @@ our %ConfigMenu = ( {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", @@ -213,6 +235,7 @@ our %ConfigMenu = ( {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", @@ -224,6 +247,7 @@ our %ConfigMenu = ( {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", @@ -231,6 +255,7 @@ our %ConfigMenu = ( {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", @@ -242,6 +267,7 @@ our %ConfigMenu = ( {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", @@ -255,6 +281,7 @@ our %ConfigMenu = ( {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", @@ -272,6 +299,7 @@ our %ConfigMenu = ( {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", diff --git a/lib/BackupPC/CGI/RSS.pm b/lib/BackupPC/CGI/RSS.pm index 2c63508..f773157 100644 --- a/lib/BackupPC/CGI/RSS.pm +++ b/lib/BackupPC/CGI/RSS.pm @@ -135,7 +135,7 @@ sub action $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; } diff --git a/lib/BackupPC/Config/Meta.pm b/lib/BackupPC/Config/Meta.pm index 133ddd0..17833c7 100644 --- a/lib/BackupPC/Config/Meta.pm +++ b/lib/BackupPC/Config/Meta.pm @@ -28,7 +28,7 @@ # #======================================================================== # -# Version 3.1.0, released 25 Nov 2007. +# Version 3.1.1, released 22 Dec 2008. # # See http://backuppc.sourceforge.net. # @@ -194,13 +194,16 @@ use vars qw(%ConfigMeta); ###################################################################### 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", @@ -212,6 +215,9 @@ use vars qw(%ConfigMeta); SmbClientIncrCmd => "string", SmbClientRestoreCmd => {type => "string", undefIfEmpty => 1}, + ###################################################################### + # Tar Configuration + ###################################################################### TarShareName => { type => "list", child => "string", @@ -222,6 +228,9 @@ use vars qw(%ConfigMeta); TarClientRestoreCmd => {type => "string", undefIfEmpty => 1}, TarClientPath => {type => "string", undefIfEmpty => 1}, + ###################################################################### + # Rsync Configuration + ###################################################################### RsyncShareName => { type => "list", child => "string", @@ -230,11 +239,17 @@ use vars qw(%ConfigMeta); RsyncClientCmd => "string", RsyncClientRestoreCmd => "string", + ###################################################################### + # Rsyncd Configuration + ###################################################################### RsyncdClientPort => "integer", RsyncdUserName => "string", RsyncdPasswd => "string", RsyncdAuthRequired => "boolean", + ###################################################################### + # Rsync(d) Options + ###################################################################### RsyncCsumCacheVerifyProb => "float", RsyncArgs => { type => "list", @@ -248,11 +263,34 @@ use vars qw(%ConfigMeta); 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", @@ -262,6 +300,9 @@ use vars qw(%ConfigMeta); ArchiveSplit => "float", ArchiveClientCmd => "string", + ###################################################################### + # Other Client Configuration + ###################################################################### NmbLookupCmd => "string", NmbLookupFindHostCmd => "string", @@ -408,6 +449,16 @@ use vars qw(%ConfigMeta); 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", diff --git a/lib/BackupPC/Lang/de.pm b/lib/BackupPC/Lang/de.pm index 06a1b6b..06673ad 100644 --- a/lib/BackupPC/Lang/de.pm +++ b/lib/BackupPC/Lang/de.pm @@ -141,8 +141,8 @@ $Lang{BackupPC_Summary}=<Dieser Status wurde am \$now generiert.
  • 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?)

    @@ -1391,6 +1391,7 @@ $Lang{CfgEdit_Title_Smb_Settings} = "Smb Einstellungen"; $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"; diff --git a/lib/BackupPC/Lang/en.pm b/lib/BackupPC/Lang/en.pm index 1b72d71..6154232 100644 --- a/lib/BackupPC/Lang/en.pm +++ b/lib/BackupPC/Lang/en.pm @@ -1383,6 +1383,7 @@ $Lang{CfgEdit_Title_Smb_Settings} = "Smb Settings"; $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"; diff --git a/lib/BackupPC/Lang/es.pm b/lib/BackupPC/Lang/es.pm index 63cd9c2..25bb73a 100644 --- a/lib/BackupPC/Lang/es.pm +++ b/lib/BackupPC/Lang/es.pm @@ -1387,6 +1387,7 @@ $Lang{CfgEdit_Title_Smb_Settings} = "Smb Settings"; $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"; diff --git a/lib/BackupPC/Lang/fr.pm b/lib/BackupPC/Lang/fr.pm index c9fc8ff..0109692 100644 --- a/lib/BackupPC/Lang/fr.pm +++ b/lib/BackupPC/Lang/fr.pm @@ -1384,6 +1384,7 @@ $Lang{CfgEdit_Title_Smb_Settings} = "Param $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"; diff --git a/lib/BackupPC/Lang/it.pm b/lib/BackupPC/Lang/it.pm index d26dcf4..f9b81fb 100644 --- a/lib/BackupPC/Lang/it.pm +++ b/lib/BackupPC/Lang/it.pm @@ -1398,6 +1398,7 @@ $Lang{CfgEdit_Title_Smb_Settings} = "Configurazione Smb"; $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"; diff --git a/lib/BackupPC/Lang/nl.pm b/lib/BackupPC/Lang/nl.pm index 36adada..943ebe5 100644 --- a/lib/BackupPC/Lang/nl.pm +++ b/lib/BackupPC/Lang/nl.pm @@ -1396,6 +1396,7 @@ $Lang{CfgEdit_Title_Smb_Settings} = "Smb instellingen"; $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"; diff --git a/lib/BackupPC/Lang/pl.pm b/lib/BackupPC/Lang/pl.pm index b4cec29..9963371 100644 --- a/lib/BackupPC/Lang/pl.pm +++ b/lib/BackupPC/Lang/pl.pm @@ -1377,6 +1377,7 @@ $Lang{CfgEdit_Title_Smb_Settings} = "Ustawienia Smb"; $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ń"; diff --git a/lib/BackupPC/Lang/pt_br.pm b/lib/BackupPC/Lang/pt_br.pm index 7086d8e..ec3c06b 100644 --- a/lib/BackupPC/Lang/pt_br.pm +++ b/lib/BackupPC/Lang/pt_br.pm @@ -1384,9 +1384,10 @@ $Lang{CfgEdit_Title_User_Config_Editing} = "Edi $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"; diff --git a/lib/BackupPC/Lang/zh_CN.pm b/lib/BackupPC/Lang/zh_CN.pm index 62aedb1..24c97e6 100644 --- a/lib/BackupPC/Lang/zh_CN.pm +++ b/lib/BackupPC/Lang/zh_CN.pm @@ -1351,6 +1351,7 @@ $Lang{CfgEdit_Title_Smb_Settings} = "Smb 设置"; $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} = "包含／排除"; diff --git a/lib/BackupPC/Lib.pm b/lib/BackupPC/Lib.pm index 3e320ba..8665c29 100644 --- a/lib/BackupPC/Lib.pm +++ b/lib/BackupPC/Lib.pm @@ -29,7 +29,7 @@ # #======================================================================== # -# Version 3.1.0, released 25 Nov 2007. +# Version 3.2.0, released 31 Dec 2008. # # See http://backuppc.sourceforge.net. # @@ -51,7 +51,7 @@ use Digest::MD5; 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; @@ -72,20 +72,7 @@ require DynaLoader; 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 ( !$@ ); }; # @@ -115,7 +102,7 @@ sub new # # 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 "" ); # @@ -128,7 +115,7 @@ sub new 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 { @@ -143,7 +130,7 @@ sub new my $bpc = bless { %$paths, - Version => '3.1.0', + Version => '3.2.0', }, $class; $bpc->{storage} = BackupPC::Storage->new($paths); @@ -152,8 +139,6 @@ sub new # 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; @@ -167,6 +152,8 @@ sub new $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 @@ -486,6 +473,26 @@ sub dirRead 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 @@ -1463,7 +1470,40 @@ sub sortedPCLogFiles } 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/(? +# +# 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; diff --git a/lib/BackupPC/Xfer/Archive.pm b/lib/BackupPC/Xfer/Archive.pm index e7b0e2b..cb18db7 100644 --- a/lib/BackupPC/Xfer/Archive.pm +++ b/lib/BackupPC/Xfer/Archive.pm @@ -38,40 +38,7 @@ 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 { @@ -130,36 +97,4 @@ sub run 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; diff --git a/lib/BackupPC/Xfer/BackupPCd.pm b/lib/BackupPC/Xfer/BackupPCd.pm index f8552c0..e6dd5b0 100644 --- a/lib/BackupPC/Xfer/BackupPCd.pm +++ b/lib/BackupPC/Xfer/BackupPCd.pm @@ -38,6 +38,7 @@ package BackupPC::Xfer::BackupPCd; use strict; +use base qw(BackupPC::Xfer::Protocol); sub new { @@ -71,20 +72,6 @@ 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) = @_; @@ -221,47 +208,4 @@ sub run } } -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; diff --git a/lib/BackupPC/Xfer/Ftp.pm b/lib/BackupPC/Xfer/Ftp.pm new file mode 100644 index 0000000..2b3c001 --- /dev/null +++ b/lib/BackupPC/Xfer/Ftp.pm @@ -0,0 +1,1019 @@ +#============================================================= -*-perl-*- +# +# BackupPC::Xfer::Ftp package +# +# DESCRIPTION +# +# This library defines a BackupPC::Xfer::Ftp class for transferring +# data from a FTP client. +# +# AUTHOR +# Paul Mantz +# +# 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 () { + + $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; diff --git a/lib/BackupPC/Xfer/Protocol.pm b/lib/BackupPC/Xfer/Protocol.pm new file mode 100644 index 0000000..ae6b4c4 --- /dev/null +++ b/lib/BackupPC/Xfer/Protocol.pm @@ -0,0 +1,452 @@ +#============================================================= -*-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 +# +# 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; diff --git a/lib/BackupPC/Xfer/Rsync.pm b/lib/BackupPC/Xfer/Rsync.pm index 3110f87..ff24cd5 100644 --- a/lib/BackupPC/Xfer/Rsync.pm +++ b/lib/BackupPC/Xfer/Rsync.pm @@ -41,6 +41,7 @@ use strict; use BackupPC::View; use BackupPC::Xfer::RsyncFileIO; use Encode qw/from_to encode/; +use base qw(BackupPC::Xfer::Protocol); use vars qw( $RsyncLibOK $RsyncLibErr ); @@ -59,7 +60,7 @@ BEGIN { 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; } @@ -71,46 +72,8 @@ sub new 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 @@ -480,11 +443,6 @@ sub abort return 1; } -sub setSelectMask -{ - my($t, $FDreadRef) = @_; -} - sub errStr { my($t) = @_; @@ -500,39 +458,4 @@ sub xferPid 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; diff --git a/lib/BackupPC/Xfer/Smb.pm b/lib/BackupPC/Xfer/Smb.pm index acfe195..baaeccb 100644 --- a/lib/BackupPC/Xfer/Smb.pm +++ b/lib/BackupPC/Xfer/Smb.pm @@ -39,35 +39,7 @@ package BackupPC::Xfer::Smb; 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 { @@ -284,6 +256,7 @@ sub readOutput $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; @@ -349,14 +322,6 @@ sub readOutput return 1; } -sub abort -{ - my($t, $reason) = @_; - - $t->{abort} = 1; - $t->{abortReason} = $reason; -} - sub setSelectMask { my($t, $FDreadRef) = @_; @@ -364,53 +329,4 @@ sub setSelectMask 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; diff --git a/lib/BackupPC/Xfer/Tar.pm b/lib/BackupPC/Xfer/Tar.pm index f6f0be1..4ab61e7 100644 --- a/lib/BackupPC/Xfer/Tar.pm +++ b/lib/BackupPC/Xfer/Tar.pm @@ -39,35 +39,7 @@ package BackupPC::Xfer::Tar; 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 { @@ -270,18 +242,6 @@ sub readOutput 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) = @_; @@ -289,53 +249,4 @@ sub setSelectMask 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; diff --git a/lib/Net/FTP/AutoReconnect.pm b/lib/Net/FTP/AutoReconnect.pm new file mode 100644 index 0000000..b2c82d7 --- /dev/null +++ b/lib/Net/FTP/AutoReconnect.pm @@ -0,0 +1,509 @@ +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 is a wrapper module around C. +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 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, which it passes most +method calls along to. + +These methods also record their state: C, C, +C, C, C, C, C, +C,C, C, C. Directory changing commands +execute a C afterwards and store their new working directory. + +These methods are automatically retried: C, C, C, +C, C, C, C, C, C, C, +C, C, C, C, C, C, C, C, +C, C, C, C, C, C, C, +C. + +These methods are tried just once: C, C, C, +C, C, C, C, C, +C, C, C. From C: C, +C, C, C. C 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, 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. 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 + +=head1 BUGS + +We should really be smarter about when to retry. + +We shouldn't be hardwired to use C, 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. + +=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; diff --git a/lib/Net/FTP/RetrHandle.pm b/lib/Net/FTP/RetrHandle.pm new file mode 100644 index 0000000..70ae6fe --- /dev/null +++ b/lib/Net/FTP/RetrHandle.pm @@ -0,0 +1,692 @@ +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 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 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 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 pair, and get only the parts +of the file that are actually read. + +This was originally designed for use with +L; 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 below. + +An interface compatible with L is provided, +along with a C-based interface. + +Remember that an FTP server can only do one thing at a time, so make +sure to C your connection before asking the FTP server to do +nything else. + +=head1 CONSTRUCTOR + +=head2 new ( $ftp, $filename, options... ) + +Creates a new L-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, 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. + +These methods are implemented: C, C, C, C, +C, C, C, C, C, C, +C, C, C, C, C, C. + +=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-compatible interface, you can +use a C-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 + +=head1 BUGS + +The distinction between tied filehandles and C-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, which will hide much of that +from you. + +If the filehandle is tied and created with C, C +doesn't work with older versions of Perl. No idea why. + +=head1 SEE ALSO + +L, L, L. + +=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; diff --git a/makeDist b/makeDist index c247b84..28071a2 100755 --- a/makeDist +++ b/makeDist @@ -1,4 +1,4 @@ -#!/bin/perl +#!/usr/bin/env perl # # makeDist: Build a BackupPC distribution # @@ -53,8 +53,8 @@ die("BackupPC::Lib->new failed\n") 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( @@ -117,14 +117,19 @@ 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 ); @@ -169,7 +174,11 @@ $ConfVars->{BlackoutHourEnd} = 2; $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} ) { @@ -195,13 +204,14 @@ if ( $errCnt ) { 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); } @@ -237,6 +247,7 @@ foreach my $file ( (@PerlSrc, 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 diff --git a/makePatch b/makePatch index a7681f5..132206d 100755 --- a/makePatch +++ b/makePatch @@ -8,8 +8,8 @@ use strict; 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"; -- 2.20.1