* Added BackupPC::Xfer::Protocol as a common class for each Xfer
authorcbarratt <cbarratt>
Fri, 26 Dec 2008 13:12:23 +0000 (13:12 +0000)
committercbarratt <cbarratt>
Fri, 26 Dec 2008 13:12:23 +0000 (13:12 +0000)
  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.

34 files changed:
ChangeLog
bin/BackupPC_archive
bin/BackupPC_archiveHost
bin/BackupPC_dump
bin/BackupPC_restore
bin/BackupPC_sendEmail
conf/config.pl
configure.pl
httpd/src/BackupPC.conf [new file with mode: 0644]
lib/BackupPC/CGI/EditConfig.pm
lib/BackupPC/CGI/RSS.pm
lib/BackupPC/Config/Meta.pm
lib/BackupPC/Lang/de.pm
lib/BackupPC/Lang/en.pm
lib/BackupPC/Lang/es.pm
lib/BackupPC/Lang/fr.pm
lib/BackupPC/Lang/it.pm
lib/BackupPC/Lang/nl.pm
lib/BackupPC/Lang/pl.pm
lib/BackupPC/Lang/pt_br.pm
lib/BackupPC/Lang/zh_CN.pm
lib/BackupPC/Lib.pm
lib/BackupPC/Xfer.pm [new file with mode: 0644]
lib/BackupPC/Xfer/Archive.pm
lib/BackupPC/Xfer/BackupPCd.pm
lib/BackupPC/Xfer/Ftp.pm [new file with mode: 0644]
lib/BackupPC/Xfer/Protocol.pm [new file with mode: 0644]
lib/BackupPC/Xfer/Rsync.pm
lib/BackupPC/Xfer/Smb.pm
lib/BackupPC/Xfer/Tar.pm
lib/Net/FTP/AutoReconnect.pm [new file with mode: 0644]
lib/Net/FTP/RetrHandle.pm [new file with mode: 0644]
makeDist
makePatch

index 2840ee2..28ab594 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
 # Version __VERSION__, __RELEASEDATE__
 #------------------------------------------------------------------------
 
 # 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
 #------------------------------------------------------------------------
 #------------------------------------------------------------------------
 # Version 3.1.0, 25 Nov 2007
 #------------------------------------------------------------------------
index 7d38e81..87ed842 100644 (file)
@@ -64,7 +64,7 @@ if ( @ARGV != 3 ) {
 }
 $user = $1 if ( $ARGV[0] =~ /(.+)/ );
 $client = $1 if ( $ARGV[1] =~ /(.+)/ );
 }
 $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);
 }
     print("$0: bad reqFileName (arg #3): $ARGV[2]\n");
     exit(1);
 }
index f5535f1..2416df3 100755 (executable)
@@ -86,8 +86,9 @@ my $mesg = "Writing tar archive for host $host, backup #$bkupNum";
 #
 # Build the command we will run
 #
 #
 # 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
 
 #
 # 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
     #
     #
     # 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 ) {
 } 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 ) {
         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 {
     } 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");
     }
 }
 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");
 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");
         $ret = system($parCmd);
         if ( $ret ) {
            print("Executing: $parCmd\n");
index b54c208..3e212d0 100755 (executable)
@@ -82,10 +82,7 @@ use lib "/usr/local/BackupPC/lib";
 use BackupPC::Lib;
 use BackupPC::FileZIO;
 use BackupPC::Storage;
 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;
 use Encode;
 use Socket;
 use File::Path;
@@ -458,6 +455,28 @@ if ( @Backups == 0
     NothingToDo($needLink);
 }
 
     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"
 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;
 
 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
 
 #
 # Run an optional pre-dump command
@@ -617,40 +626,14 @@ for my $shareName ( @$ShareNames ) {
         exit(1);
     }
 
         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;
     }
 
     my $useTar = $xfer->useTar;
@@ -789,43 +772,41 @@ for my $shareName ( @$ShareNames ) {
        # we use a select.
        #
        my($FDread, $tarOut, $mesg);
        # 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);
        $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");
            last if ( !$xfer->readOutput(\$FDread, $rout) );
            while ( my $str = $xfer->logMsgGet ) {
                print(LOG $bpc->timeStamp, "xfer: $str\n");
index f23afe8..4549ccf 100755 (executable)
@@ -40,10 +40,7 @@ no  utf8;
 use lib "/usr/local/BackupPC/lib";
 use BackupPC::Lib;
 use BackupPC::FileZIO;
 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;
 use Socket;
 
 use File::Path;
@@ -236,37 +233,14 @@ if ( $? && $Conf{UserCmdCheckStatus} ) {
 }
 $NeedPostCmd = 1;
 
 }
 $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 ) {
 my $useTar = $xfer->useTar;
 
 if ( $useTar ) {
index 390093a..055884a 100755 (executable)
@@ -42,6 +42,7 @@ no  utf8;
 use lib "/usr/local/BackupPC/lib";
 use BackupPC::Lib;
 use BackupPC::FileZIO;
 use lib "/usr/local/BackupPC/lib";
 use BackupPC::Lib;
 use BackupPC::FileZIO;
+use Encode;
 
 use Data::Dumper;
 use Getopt::Std;
 
 use Data::Dumper;
 use Getopt::Std;
@@ -363,6 +364,8 @@ sub user2name
 sub sendUserEmail
 {
     my($user, $host, $mesg, $subj, $vars) = @_;
 sub sendUserEmail
 {
     my($user, $host, $mesg, $subj, $vars) = @_;
+    return if ( $Conf{BackupsDisable} );
+
     $vars->{user}     = $user;
     $vars->{host}     = $host;
     $vars->{headers}  = $Conf{EMailHeaders};
     $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->{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;
     $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 );
 
     if ( $opts{t} ) {
         binmode(STDOUT, ":utf8") if ( $utf8 );
+        
         print("#" x 75, "\n");
         print $mesg;
         return;
         print("#" x 75, "\n");
         print $mesg;
         return;
index a807a79..abdcd32 100644 (file)
@@ -888,6 +888,10 @@ $Conf{ClientCharset} = '';
 #
 $Conf{ClientCharsetLegacy} = 'iso-8859-1';
 
 #
 $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.
 #
 # 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 -';
 
             . ' $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
 #
 # 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} = '';
 
 #
 $Conf{TarClientPath} = '';
 
+###########################################################################
+# Rsync/Rsyncd Configuration
+# (can be overwritten in the per-PC log file)
+###########################################################################
 #
 # Path to rsync executable on the client
 #
 #
 # 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'.
 #
 # 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';
 
 #
 $Conf{BackupPCdRestoreCmd} = '$bpcdPath TODO';
 
-
+###########################################################################
+# Archive Configuration
+# (can be overwritten in the per-PC log file)
+###########################################################################
 #
 # Archive Destination
 #
 #
 # Archive Destination
 #
@@ -2128,6 +2210,16 @@ $Conf{CgiUserConfigEdit} = {
         RsyncClientCmd            => 0,
         RsyncClientRestoreCmd     => 0,
         RsyncClientPath           => 0,
         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,
         ArchiveDest               => 1,
         ArchiveComp               => 1,
         ArchivePar                => 1,
index 7ec545c..e0923d2 100755 (executable)
@@ -1,4 +1,4 @@
-#!/bin/perl
+#!/usr/bin/env perl
 #============================================================= -*-perl-*-
 #
 # configure.pl: Configuration and installation program for BackupPC
 #============================================================= -*-perl-*-
 #
 # configure.pl: Configuration and installation program for BackupPC
@@ -97,6 +97,7 @@ if ( !GetOptions(
             "cgi-dir=s",
             "compress-level=i",
             "config-path=s",
             "cgi-dir=s",
             "compress-level=i",
             "config-path=s",
+            "config-override=s%",
             "config-dir=s",
             "data-dir=s",
             "dest-dir=s",
             "config-dir=s",
             "data-dir=s",
             "dest-dir=s",
@@ -230,10 +231,15 @@ EOF
 # Create defaults for FHS setup
 #
 if ( $opts{fhs} ) {
 # 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/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);
                 ) ) {
     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);
 }
 
     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);
 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;
 }
 
             =~ 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
 #
 #
 # 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;
                                     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).
            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 (file)
index 0000000..163bff9
--- /dev/null
@@ -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.
+
+<Directory      __CGIDIR__ >
+
+#
+# This section tells apache which machines can access the interface.
+# You can change the allow line to allow access from your local
+# network, or comment out this region to allow access from all
+# machines.
+#
+order deny,allow
+deny from all
+allow from 127.0.0.1
+
+#
+# You can change the authorization method to LDAP or another method
+# besides htaccess here if you are so inclined.
+#
+AuthType Basic
+AuthUserFile __CONFDIR__/BackupPC.users
+AuthName "BackupPC Community Edition Administrative Interface"
+require valid-user
+
+</Directory>
+
+Alias           __IMAGEDIRURL__         __IMAGEDIR__
+ScriptAlias     /BackupPC_Admin         __CGIDIR__/BackupPC_Admin
index edc4526..9b78b15 100644 (file)
@@ -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.
 #
 #
 # See http://backuppc.sourceforge.net.
 #
@@ -173,6 +173,7 @@ our %ConfigMenu = (
             {name => "ClientCharset"},
             {name => "ClientCharsetLegacy"},
 
             {name => "ClientCharset"},
             {name => "ClientCharsetLegacy"},
 
+            ### Smb Settings
             {text => "CfgEdit_Title_Smb_Settings",
                 visible => sub { return $_[0]->{XferMethod} eq "smb"; } },
             {name => "SmbShareName",
             {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"; } },
 
             {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"; } },
 
             {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",
             {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/; } },
 
             {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",
             {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"; } },
 
             {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",
             {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"; } },
 
             {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",
             {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"; } },
 
             {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",
             {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"; } },
 
             {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",
             {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"; } },
 
             {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",
             {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/; } },
 
             {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",
             {text => "CfgEdit_Title_Archive_Paths_Commands",
                 visible => sub { return $_[0]->{XferMethod} eq "archive"; } },
             {name => "ArchiveClientCmd",
index 2c63508..f773157 100644 (file)
@@ -135,7 +135,7 @@ sub action
     $incrSizeTot = sprintf("%.2f", $incrSizeTot / 1000);
     my $now      = timeStamp2(time);
 
     $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;
 
 }
           $rss->as_string;
 
 }
index 133ddd0..17833c7 100644 (file)
@@ -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.
 #
 #
 # See http://backuppc.sourceforge.net.
 #
@@ -194,13 +194,16 @@ use vars qw(%ConfigMeta);
     ######################################################################
     XferMethod => {
            type   => "select",
     ######################################################################
     XferMethod => {
            type   => "select",
-           values => [qw(archive rsync rsyncd smb tar)],
+           values => [qw(archive ftp rsync rsyncd smb tar)],
     },
     XferLogLevel       => "integer",
 
     ClientCharset       => "string",
     ClientCharsetLegacy => "string",
 
     },
     XferLogLevel       => "integer",
 
     ClientCharset       => "string",
     ClientCharsetLegacy => "string",
 
+    ######################################################################
+    # Smb Configuration
+    ######################################################################
     SmbShareName       => {
            type   => "list",
            child  => "string",
     SmbShareName       => {
            type   => "list",
            child  => "string",
@@ -212,6 +215,9 @@ use vars qw(%ConfigMeta);
     SmbClientIncrCmd   => "string",
     SmbClientRestoreCmd => {type => "string", undefIfEmpty => 1},
 
     SmbClientIncrCmd   => "string",
     SmbClientRestoreCmd => {type => "string", undefIfEmpty => 1},
 
+    ######################################################################
+    # Tar Configuration
+    ######################################################################
     TarShareName       => {
            type   => "list",
            child  => "string",
     TarShareName       => {
            type   => "list",
            child  => "string",
@@ -222,6 +228,9 @@ use vars qw(%ConfigMeta);
     TarClientRestoreCmd        => {type => "string", undefIfEmpty => 1},
     TarClientPath      => {type => "string", undefIfEmpty => 1},
 
     TarClientRestoreCmd        => {type => "string", undefIfEmpty => 1},
     TarClientPath      => {type => "string", undefIfEmpty => 1},
 
+    ######################################################################
+    # Rsync Configuration
+    ######################################################################
     RsyncShareName     => {
            type   => "list",
            child  => "string",
     RsyncShareName     => {
            type   => "list",
            child  => "string",
@@ -230,11 +239,17 @@ use vars qw(%ConfigMeta);
     RsyncClientCmd     => "string",
     RsyncClientRestoreCmd => "string",
 
     RsyncClientCmd     => "string",
     RsyncClientRestoreCmd => "string",
 
+    ######################################################################
+    # Rsyncd Configuration
+    ######################################################################
     RsyncdClientPort   => "integer",
     RsyncdUserName     => "string",
     RsyncdPasswd       => "string",
     RsyncdAuthRequired => "boolean",
 
     RsyncdClientPort   => "integer",
     RsyncdUserName     => "string",
     RsyncdPasswd       => "string",
     RsyncdAuthRequired => "boolean",
 
+    ######################################################################
+    # Rsync(d) Options
+    ######################################################################
     RsyncCsumCacheVerifyProb => "float",
     RsyncArgs          => {
            type         => "list",
     RsyncCsumCacheVerifyProb => "float",
     RsyncArgs          => {
            type         => "list",
@@ -248,11 +263,34 @@ use vars qw(%ConfigMeta);
            child        => "string",
     },
 
            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",
     BackupPCdCmd        => "string",
     BackupPCdPath       => "string",
-    BackupPCdShareName  => "string",
     BackupPCdRestoreCmd => "string",
 
     BackupPCdRestoreCmd => "string",
 
+    ######################################################################
+    # Archive Configuration
+    ######################################################################
     ArchiveDest        => "string",
     ArchiveComp                => {
            type   => "select",
     ArchiveDest        => "string",
     ArchiveComp                => {
            type   => "select",
@@ -262,6 +300,9 @@ use vars qw(%ConfigMeta);
     ArchiveSplit       => "float",
     ArchiveClientCmd   => "string",
 
     ArchiveSplit       => "float",
     ArchiveClientCmd   => "string",
 
+    ######################################################################
+    # Other Client Configuration
+    ######################################################################
     NmbLookupCmd       => "string",
     NmbLookupFindHostCmd => "string",
 
     NmbLookupCmd       => "string",
     NmbLookupFindHostCmd => "string",
 
@@ -408,6 +449,16 @@ use vars qw(%ConfigMeta);
                 RsyncClientCmd            => "boolean",
                 RsyncClientPath           => "boolean",
                 RsyncClientRestoreCmd     => "boolean",
                 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",
                 ArchiveDest               => "boolean",
                 ArchiveComp               => "boolean",
                 ArchivePar                => "boolean",
index 06a1b6b..06673ad 100644 (file)
@@ -141,8 +141,8 @@ $Lang{BackupPC_Summary}=<<EOF;
 <li>Dieser Status wurde am \$now generiert.
 <li>Das Pool Filesystem (Backup-Speicherplatz) ist zu \$Info{DUlastValue}%
     (\$DUlastTime) voll, das Maximum heute ist \$Info{DUDailyMax}% (\$DUmaxTime)
 <li>Dieser Status wurde am \$now generiert.
 <li>Das Pool Filesystem (Backup-Speicherplatz) ist zu \$Info{DUlastValue}%
     (\$DUlastTime) voll, das Maximum heute ist \$Info{DUDailyMax}% (\$DUmaxTime)
-    und das Maximum gestern war \$Info{DUDailyMaxPrev}%. (Hinweis: Sollten ca. 70% ?berschritten werden, so
-    ist evtl. bald eine Erweiterung des Backupspeichers erforderlich. Ist weitere Planung n?tig?)
+    und das Maximum gestern war \$Info{DUDailyMaxPrev}%. (Hinweis: Sollten ca. 70% überschritten werden, so
+    ist evtl. bald eine Erweiterung des Backupspeichers erforderlich. Ist weitere Planung nötig?)
 </ul>
 </p>
 
 </ul>
 </p>
 
@@ -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_Tar_Settings} = "Tar Einstellungen";
 $Lang{CfgEdit_Title_Rsync_Settings} = "Rsync Einstellungen";
 $Lang{CfgEdit_Title_Rsyncd_Settings} = "Rsyncd Einstellungen";
+$Lang{CfgEdit_Title_Ftp_Settings} = "FTP Einstellungen";
 $Lang{CfgEdit_Title_BackupPCd_Settings} = "BackupPCd Einstellungen";
 $Lang{CfgEdit_Title_Archive_Settings} = "Archive Einstellungen";
 $Lang{CfgEdit_Title_Include_Exclude} = "Include/Exclude";
 $Lang{CfgEdit_Title_BackupPCd_Settings} = "BackupPCd Einstellungen";
 $Lang{CfgEdit_Title_Archive_Settings} = "Archive Einstellungen";
 $Lang{CfgEdit_Title_Include_Exclude} = "Include/Exclude";
index 1b72d71..6154232 100644 (file)
@@ -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_Tar_Settings} = "Tar Settings";
 $Lang{CfgEdit_Title_Rsync_Settings} = "Rsync Settings";
 $Lang{CfgEdit_Title_Rsyncd_Settings} = "Rsyncd Settings";
+$Lang{CfgEdit_Title_Ftp_Settings} = "FTP Settings";
 $Lang{CfgEdit_Title_BackupPCd_Settings} = "BackupPCd Settings";
 $Lang{CfgEdit_Title_Archive_Settings} = "Archive Settings";
 $Lang{CfgEdit_Title_Include_Exclude} = "Include/Exclude";
 $Lang{CfgEdit_Title_BackupPCd_Settings} = "BackupPCd Settings";
 $Lang{CfgEdit_Title_Archive_Settings} = "Archive Settings";
 $Lang{CfgEdit_Title_Include_Exclude} = "Include/Exclude";
index 63cd9c2..25bb73a 100644 (file)
@@ -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_Tar_Settings} = "Tar Settings";
 $Lang{CfgEdit_Title_Rsync_Settings} = "Rsync Settings";
 $Lang{CfgEdit_Title_Rsyncd_Settings} = "Rsyncd Settings";
+$Lang{CfgEdit_Title_Ftp_Settings} = "FTP Settings";
 $Lang{CfgEdit_Title_BackupPCd_Settings} = "BackupPCd Settings";
 $Lang{CfgEdit_Title_Archive_Settings} = "Archive Settings";
 $Lang{CfgEdit_Title_Include_Exclude} = "Include/Exclude";
 $Lang{CfgEdit_Title_BackupPCd_Settings} = "BackupPCd Settings";
 $Lang{CfgEdit_Title_Archive_Settings} = "Archive Settings";
 $Lang{CfgEdit_Title_Include_Exclude} = "Include/Exclude";
index c9fc8ff..0109692 100644 (file)
@@ -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_Tar_Settings} = "Paramètres de Tar";
 $Lang{CfgEdit_Title_Rsync_Settings} = "Paramètres de Rsync";
 $Lang{CfgEdit_Title_Rsyncd_Settings} = "Paramètres de Rsyncd";
+$Lang{CfgEdit_Title_Ftp_Settings} = "Paramètres de FTP";
 $Lang{CfgEdit_Title_BackupPCd_Settings} = "Paramètres de BackupPCd";
 $Lang{CfgEdit_Title_Archive_Settings} = "Paramètres d'archivage";
 $Lang{CfgEdit_Title_Include_Exclude} = "Inclure/Exclure";
 $Lang{CfgEdit_Title_BackupPCd_Settings} = "Paramètres de BackupPCd";
 $Lang{CfgEdit_Title_Archive_Settings} = "Paramètres d'archivage";
 $Lang{CfgEdit_Title_Include_Exclude} = "Inclure/Exclure";
index d26dcf4..f9b81fb 100644 (file)
@@ -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_Tar_Settings} = "Configurazione Tar";
 $Lang{CfgEdit_Title_Rsync_Settings} = "Configurazione Rsync";
 $Lang{CfgEdit_Title_Rsyncd_Settings} = "Configurazione Rsyncd";
+$Lang{CfgEdit_Title_Ftp_Settings} = "Configurazione FTP";
 $Lang{CfgEdit_Title_BackupPCd_Settings} = "Configurazione BackupPCd";
 $Lang{CfgEdit_Title_Archive_Settings} = "Configurazione Archivi";
 $Lang{CfgEdit_Title_Include_Exclude} = "Includi/Escludi";
 $Lang{CfgEdit_Title_BackupPCd_Settings} = "Configurazione BackupPCd";
 $Lang{CfgEdit_Title_Archive_Settings} = "Configurazione Archivi";
 $Lang{CfgEdit_Title_Include_Exclude} = "Includi/Escludi";
index 36adada..943ebe5 100644 (file)
@@ -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_Tar_Settings} = "Tar instellingen";
 $Lang{CfgEdit_Title_Rsync_Settings} = "Rsync instellingen";
 $Lang{CfgEdit_Title_Rsyncd_Settings} = "Rsyncd instellingen";
+$Lang{CfgEdit_Title_Ftp_Settings} = "FTP instellingen";
 $Lang{CfgEdit_Title_BackupPCd_Settings} = "BackupPCd instellingen";
 $Lang{CfgEdit_Title_Archive_Settings} = "Archivering instellingen";
 $Lang{CfgEdit_Title_Include_Exclude} = "Inclusief/Exclusief";
 $Lang{CfgEdit_Title_BackupPCd_Settings} = "BackupPCd instellingen";
 $Lang{CfgEdit_Title_Archive_Settings} = "Archivering instellingen";
 $Lang{CfgEdit_Title_Include_Exclude} = "Inclusief/Exclusief";
index b4cec29..9963371 100644 (file)
@@ -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_Tar_Settings} = "Ustawienia Tar";
 $Lang{CfgEdit_Title_Rsync_Settings} = "Ustawienia Rsync";
 $Lang{CfgEdit_Title_Rsyncd_Settings} = "Ustawienia Rsyncd";
+$Lang{CfgEdit_Title_Ftp_Settings} = "Ustawienia FTP";
 $Lang{CfgEdit_Title_BackupPCd_Settings} = "Ustawienia BackupPCd";
 $Lang{CfgEdit_Title_Archive_Settings} = "Ustawienia Archiwizacji";
 $Lang{CfgEdit_Title_Include_Exclude} = "Dodaj/Usuń";
 $Lang{CfgEdit_Title_BackupPCd_Settings} = "Ustawienia BackupPCd";
 $Lang{CfgEdit_Title_Archive_Settings} = "Ustawienia Archiwizacji";
 $Lang{CfgEdit_Title_Include_Exclude} = "Dodaj/Usuń";
index 7086d8e..ec3c06b 100644 (file)
@@ -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_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_Rsync_Settings} = "Configurações do Rsync";
 $Lang{CfgEdit_Title_Rsyncd_Settings} = "Configurações do Rsyncd";
+$Lang{CfgEdit_Title_Ftp_Settings} = "Configurações do FTP";
 $Lang{CfgEdit_Title_BackupPCd_Settings} = "Configurações do BackupPCd";
 $Lang{CfgEdit_Title_Archive_Settings} = "Configurações do Archive";
 $Lang{CfgEdit_Title_Include_Exclude} = "Inclui/Exclui";
 $Lang{CfgEdit_Title_BackupPCd_Settings} = "Configurações do BackupPCd";
 $Lang{CfgEdit_Title_Archive_Settings} = "Configurações do Archive";
 $Lang{CfgEdit_Title_Include_Exclude} = "Inclui/Exclui";
index 62aedb1..24c97e6 100644 (file)
@@ -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_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} = "包含/排除";
 $Lang{CfgEdit_Title_BackupPCd_Settings} = "BackupPCd 设置";
 $Lang{CfgEdit_Title_Archive_Settings} = "备档设置";
 $Lang{CfgEdit_Title_Include_Exclude} = "包含/排除";
index 3e320ba..8665c29 100644 (file)
@@ -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.
 #
 #
 # See http://backuppc.sourceforge.net.
 #
@@ -51,7 +51,7 @@ use Digest::MD5;
 use Config;
 use Encode qw/from_to encode_utf8/;
 
 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;
 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 );";
 
 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.
     #
     #
     # 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 "" );
 
     #
     $installDir = '/usr/local/BackupPC'    if ( $installDir eq "" );
 
     #
@@ -128,7 +115,7 @@ sub new
             useFHS     => $useFHS,
             TopDir     => $topDir,
             InstallDir => $installDir,
             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 {
             LogDir     => '/var/log/BackupPC',
         };
     } else {
@@ -143,7 +130,7 @@ sub new
 
     my $bpc = bless {
        %$paths,
 
     my $bpc = bless {
        %$paths,
-        Version => '3.1.0',
+        Version => '3.2.0',
     }, $class;
 
     $bpc->{storage} = BackupPC::Storage->new($paths);
     }, $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)};
     # 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;
     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);
         $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
 
     #
     # 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) );
     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
     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);
     }
         }
         closedir(DIR);
     }
-    return sort(compareLOGName @files);
+    return sort compareLOGName @files;
+}
+
+#
+# converts a glob-style pattern into a perl regular expression.
+#
+sub glob2re
+{
+    my ( $bpc, $glob ) = @_;
+    my ( $char, $subst );
+
+    # $escapeChars escapes characters with no special glob meaning but
+    # have meaning in regexps.
+    my $escapeChars = [ '.', '/', ];
+
+    # $charMap is where we implement the special meaning of glob
+    # patterns and translate them to regexps.
+    my $charMap = {
+                    '?' => '[^/]',
+                    '*' => '[^/]*', };
+
+    # multiple forward slashes are equivalent to one slash.  We should
+    # never have to use this.
+    $glob =~ s/\/+/\//;
+
+    foreach $char (@$escapeChars) {
+        $glob =~ s/\Q$char\E/\\$char/g;
+    }
+
+    while ( ( $char, $subst ) = each(%$charMap) ) {
+        $glob =~ s/(?<!\\)\Q$char\E/$subst/g;
+    }
+
+    return $glob;
 }
 
 1;
 }
 
 1;
diff --git a/lib/BackupPC/Xfer.pm b/lib/BackupPC/Xfer.pm
new file mode 100644 (file)
index 0000000..b585e25
--- /dev/null
@@ -0,0 +1,152 @@
+#============================================================= -*-perl-*-
+#
+# BackupPC::Xfer package
+#
+# DESCRIPTION
+#
+#   This library defines a Factory for invoking transfer protocols in
+#   a polymorphic manner.  This libary allows for easier expansion of
+#   supported protocols.
+#
+# AUTHOR
+#   Paul Mantz  <pcmantz@zmanda.com>
+#
+# COPYRIGHT
+#   Copyright (C) 2008  Zmanda
+#
+#   This program is free software; you can redistribute it and/or modify
+#   it under the terms of the GNU General Public License as published by
+#   the Free Software Foundation; either version 2 of the License, or
+#   (at your option) any later version.
+#
+#   This program is distributed in the hope that it will be useful,
+#   but WITHOUT ANY WARRANTY; without even the implied warranty of
+#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#   GNU General Public License for more details.
+#
+#   You should have received a copy of the GNU General Public License
+#   along with this program; if not, write to the Free Software
+#   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+#
+#========================================================================
+#
+# Version 3.1.0+
+#
+# See http://backuppc.sourceforge.net.
+#
+#========================================================================
+
+
+package BackupPC::Xfer;
+
+use strict;
+use Encode qw/from_to encode/;
+
+use BackupPC::Xfer::Archive;
+use BackupPC::Xfer::BackupPCd;
+use BackupPC::Xfer::Ftp;
+use BackupPC::Xfer::Protocol;
+use BackupPC::Xfer::Rsync;
+use BackupPC::Xfer::Smb;
+use BackupPC::Xfer::Tar;
+
+use vars qw( $errStr );
+
+sub create
+{
+    my($protocol, $bpc, $args) = @_;
+    my $xfer;
+
+    $errStr = undef;
+
+    if ( $protocol eq 'archive' ) {
+
+        $xfer = BackupPC::Xfer::Archive->new( $bpc, $args );
+        $errStr = BackupPC::Xfer::Archive::errStr() if ( !defined($xfer) );
+        return $xfer;
+
+    } elsif ( $protocol eq 'backuppcd' ) {
+
+        $xfer = BackupPC::Xfer::BackupPCd->new( $bpc, $args );
+        $errStr = BackupPC::Xfer::BackupPCd::errStr() if ( !defined($xfer) );
+        return $xfer;
+
+    } elsif ( $protocol eq 'ftp' ) {
+
+        $xfer = BackupPC::Xfer::Ftp->new( $bpc, $args );
+        $errStr = BackupPC::Xfer::Ftp::errStr() if ( !defined($xfer) );
+        return $xfer;
+
+    } elsif ( $protocol eq 'rsync' || $protocol eq 'rsyncd' ) {
+
+        $xfer = BackupPC::Xfer::Rsync->new( $bpc, $args );
+        $errStr = BackupPC::Xfer::Rsync::errStr() if ( !defined($xfer) );
+        return $xfer;
+
+    } elsif ( $protocol eq 'smb' ) {
+
+        $xfer = BackupPC::Xfer::Smb->new( $bpc, $args );
+        $errStr = BackupPC::Xfer::Smb::errStr() if ( !defined($xfer) );
+        return $xfer;
+
+    } elsif ( $protocol eq 'tar' ) {
+
+        $xfer = BackupPC::Xfer::Tar->new( $bpc, $args );
+        $errStr = BackupPC::Xfer::Tar::errStr() if ( !defined($xfer) );
+        return $xfer;
+
+    } elsif ( $protocol eq 'protocol') {
+
+        $xfer = BackupPC::Xfer::Protocol->new( $bpc, $args );
+        $errStr = BackupPC::Xfer::Protocol::errStr() if ( !defined($xfer) );
+        return $xfer;
+
+    } else {
+
+       $xfer = undef;
+        $errStr = "$protocol is not a supported protocol.";
+       return $xfer;
+    }
+}
+
+#
+# getShareNames() loads the correct shares dependent on the
+# transfer type.
+#
+sub getShareNames
+{
+    my($conf) = @_;
+    my $ShareNames;
+
+    if ( $conf->{XferMethod} eq "tar" ) {
+        $ShareNames = $conf->{TarShareName};
+
+    } elsif ( $conf->{XferMethod} eq "ftp" ) {
+        $ShareNames = $conf->{FtpShareName};
+
+    } elsif ( $conf->{XferMethod} eq "rsync" || $conf->{XferMethod} eq "rsyncd" ) {
+        $ShareNames = $conf->{RsyncShareName};
+
+    } elsif ( $conf->{XferMethod} eq "backuppcd" ) {
+        $ShareNames = $conf->{BackupPCdShareName};
+
+    } elsif ( $conf->{XferMethod} eq "smb" ) {
+        $ShareNames = $conf->{SmbShareName};
+
+    } else {
+        #
+        # default to smb shares
+        #
+        $ShareNames = $conf->{SmbShareName};
+    }
+
+    $ShareNames = [$ShareNames] unless ref($ShareNames) eq "ARRAY";
+    return $ShareNames;
+}
+
+sub errStr
+{
+    return $errStr;
+}
+
+1;
index e7b0e2b..cb18db7 100644 (file)
 package BackupPC::Xfer::Archive;
 
 use strict;
 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
 {
 
 sub start
 {
@@ -130,36 +97,4 @@ sub run
     return "Completed Archive";
 }
 
     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;
 1;
index f8552c0..e6dd5b0 100644 (file)
@@ -38,6 +38,7 @@
 package BackupPC::Xfer::BackupPCd;
 
 use strict;
 package BackupPC::Xfer::BackupPCd;
 
 use strict;
+use base qw(BackupPC::Xfer::Protocol);
 
 sub new
 {
 
 sub new
 {
@@ -71,20 +72,6 @@ sub new
     return $t;
 }
 
     return $t;
 }
 
-sub args
-{
-    my($t, $args) = @_;
-
-    foreach my $arg ( keys(%$args) ) {
-       $t->{$arg} = $args->{$arg};
-    }
-}
-
-sub useTar
-{
-    return 0;
-}
-
 sub start
 {
     my($t) = @_;
 sub 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;
 1;
diff --git a/lib/BackupPC/Xfer/Ftp.pm b/lib/BackupPC/Xfer/Ftp.pm
new file mode 100644 (file)
index 0000000..2b3c001
--- /dev/null
@@ -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 <pcmantz@zmanda.com>
+#
+# COPYRIGHT
+#   (C) 2008, Zmanda Inc.
+#
+#   This program is free software; you can redistribute it and/or
+#   modify it under the terms of the GNU General Public License as
+#   published by the Free Software Foundation; either version 2 of the
+#   License, or (at your option) any later version.
+#
+#   This program is distributed in the hope that it will be useful,
+#   but WITHOUT ANY WARRANTY; without even the implied warranty of
+#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+#   General Public License for more details.
+#
+#   You should have received a copy of the GNU General Public License
+#   along with this program; if not, write to the Free Software
+#   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+#   02111-1307 USA
+#
+#
+#========================================================================
+#
+# Unreleased, planned release in 3.2 (or 3.1.1)
+#
+# See http://backuppc.sourceforge.net.
+#
+#========================================================================
+
+
+package BackupPC::Xfer::Ftp;
+
+use strict;
+
+use BackupPC::View;
+use BackupPC::Attrib qw(:all);
+
+use Encode qw/from_to encode/;
+use File::Listing qw/parse_dir/;
+use File::Path;
+use Data::Dumper;
+use base qw(BackupPC::Xfer::Protocol);
+
+use vars qw( $FTPLibOK $FTPLibErr $ARCLibOK );
+
+use constant S_IFMT => 0170000;
+
+BEGIN {
+
+    $FTPLibOK = 1;
+    $ARCLibOK = 0;
+
+    #
+    # clear eval error variable
+    #
+    my @FTPLibs = qw( Net::FTP Net::FTP::RetrHandle );
+
+    foreach my $module ( @FTPLibs ) {
+
+        undef $@;
+        eval "use $module;";
+
+        if ( $@ ) {
+            $FTPLibOK = 0;
+            $FTPLibErr = "module $module doesn't exist: $@";
+            last;
+        }
+    }
+
+    eval "use Net::FTP::AutoReconnect;";
+    $ARCLibOK = (defined($@)) ? 1 : 0;
+};
+
+##############################################################################
+# Constructor
+##############################################################################
+
+
+#
+#   usage:
+#     $xfer = new BackupPC::Xfer::Ftp( $bpc, %args );
+#
+# new() is your default class constructor.  it also calls the
+# constructor for Protocol as well.
+#
+sub new
+{
+    my ( $class, $bpc, $args ) = @_;
+    $args ||= {};
+
+    my $t = BackupPC::Xfer::Protocol->new(
+        $bpc,
+        {
+           ftp   => undef,
+           stats => {
+               errorCnt          => 0,
+               TotalFileCnt      => 0,
+               TotalFileSize     => 0,
+               ExistFileCnt      => 0,
+               ExistFileSize     => 0,
+               ExistFileCompSize => 0,
+           },
+           %$args,
+        } );
+    return bless( $t, $class );
+}
+
+
+##############################################################################
+# Methods
+##############################################################################
+
+#
+#   usage:
+#     $xfer->start();
+#
+# start() is called to configure and initiate a dump or restore,
+# depending on the configured options.
+#
+sub start
+{
+    my ($t) = @_;
+
+    my $bpc  = $t->{bpc};
+    my $conf = $t->{conf};
+
+    my ( @fileList, $logMsg, $incrDate, $args, $dumpText );
+
+    #
+    # initialize the statistics returned by getStats()
+    #
+    foreach ( qw/byteCnt fileCnt xferErrCnt xferBadShareCnt
+                 xferBadFileCnt xferOK hostAbort hostError
+                 lastOutputLine/ )
+    {
+        $t->{$_} = 0;
+    }
+
+    #
+    # Net::FTP::RetrHandle is necessary.
+    #
+    if ( !$FTPLibOK ) {
+        $t->{_errStr} = "Error: FTP transfer selected but module"
+          . " Net::FTP::RetrHandle is not installed.";
+        $t->{xferErrCnt}++;
+        return;
+    }
+
+    #
+    # standardize the file include/exclude settings if necessary
+    #
+    unless ( $t->{type} eq 'restore' ) {
+        $bpc->backupFileConfFix( $conf, "FtpShareName" );
+       $t->loadInclExclRegexps("FtpShareName");
+    }
+
+    #
+    # Convert the encoding type of the names if at all possible
+    #
+    from_to( $args->{shareName}, "utf8", $conf->{ClientCharset} )
+        if ( $conf->{ClientCharset} ne "" );
+
+    #
+    # Collect FTP configuration arguments and translate them for
+    # passing to the FTP module.
+    #
+    $args = $t->getFTPArgs();
+
+    #
+    # Create the Net::FTP::AutoReconnect or Net::FTP object.
+    #
+    unless ( $t->{ftp} = ($ARCLibOK) ? Net::FTP::AutoReconnect->new(%$args)
+                                     : Net::FTP->new(%$args) )
+    {
+        $t->{_errStr} = "Can't open connection to $args->{Host}";
+        $t->{xferErrCnt}++;
+        return;
+    }
+
+    #
+    # Log in to the ftp server and set appropriate path information.
+    #
+    unless ( $t->{ftp}->login( $conf->{FtpUserName}, $conf->{FtpPasswd} ) ) {
+        $t->{_errStr} = "Can't login to $args->{Host}";
+        $t->{xferErrCnt}++;
+        return;
+    }
+
+    unless ( $t->{ftp}->binary() ) {
+        $t->{_errStr} = "Can't enable binary transfer mode to $args->{Host}";
+        $t->{xferErrCnt}++;
+        return;
+    }
+
+    unless (    ( $t->{shareName} =~ m/^\.?$/ )
+             || ( $t->{ftp}->cwd( $t->{shareName} ) ) )
+    {
+        $t->{_errStr} = "Can't change working directory to $t->{shareName}";
+        $t->{xferErrCnt}++;
+        return;
+    }
+
+    unless  ( $t->{sharePath} = $t->{ftp}->pwd() ) {
+        $t->{_errStr} = "Can't retrieve full working directory of $t->{shareName}";
+        $t->{xferErrCnt}++;
+        return;
+    }
+
+    #
+    # log the beginning of action based on type
+    #
+    if ( $t->{type} eq 'restore' ) {
+        $logMsg = "restore started on directory $t->{shareName}";
+
+    } elsif ( $t->{type} eq 'full' ) {
+        $logMsg = "full backup started on directory $t->{shareName}";
+
+    } elsif ( $t->{type} eq 'incr' ) {
+
+        $incrDate = $bpc->timeStamp( $t->{incrBaseTime} - 3600, 1 );
+        $logMsg = "incremental backup started back to $incrDate" .
+            " (backup #$t->{incrBaseBkupNum}) for directory" . "
+            $t->{shareName}";
+    }
+
+    #
+    # call the recursive function based on the type of action
+    #
+    if ( $t->{type} eq 'restore' ) {
+
+        $t->restore();
+        $logMsg = "Restore of $args->{Host} complete";
+
+    } elsif ( $t->{type} eq 'incr' ) {
+
+        $t->backup();
+        $logMsg = "Incremental backup of $args->{Host} complete";
+
+    } elsif ( $t->{type} eq 'full' ) {
+
+        $t->backup();
+        $logMsg = "Full backup of $args->{Host} complete";
+    }
+
+    delete $t->{_errStr};
+    return $logMsg;
+}
+
+
+#
+#
+#
+sub run
+{
+    my ($t) = @_;
+    my $stats = $t->{stats};
+
+    my ( $tarErrs,      $nFilesExist, $sizeExist,
+         $sizeExistCom, $nFilesTotal, $sizeTotal );
+
+    #
+    # TODO: replace the $stats array with variables at the top level,
+    # ones returned by $getStats.  They should be identical.
+    #
+    $tarErrs      = 0;
+    $nFilesExist  = $stats->{ExistFileCnt};
+    $sizeExist    = $stats->{ExistFileSize};
+    $sizeExistCom = $stats->{ExistFileCompSize};
+    $nFilesTotal  = $stats->{TotalFileCnt};
+    $sizeTotal    = $stats->{TotalFileSize};
+
+    if ( $t->{type} eq "restore" ) {
+        return ( $t->{fileCnt}, $t->{byteCnt}, 0, 0 );
+
+    } else {
+        return \( $tarErrs,      $nFilesExist, $sizeExist,
+                  $sizeExistCom, $nFilesTotal, $sizeTotal );
+    }
+}
+
+
+#
+#   usage:
+#     $t->restore();
+#
+# TODO: finish or scuttle this function.  It is not necessary for a
+# release.
+#
+sub restore
+{
+    my $t = @_;
+
+    my $bpc = $t->{bpc};
+    my $fileList = $t->{fileList};
+
+    my ($path, $fileName, $fileAttr, $fileType );
+
+    #print STDERR "BackupPC::Xfer::Ftp->restore()";
+
+    #
+    # Prepare the view object
+    #
+    $t->{view} = BackupPC::View->new( $bpc, $t->{bkupSrcHost},
+                                      $t->{backups} );
+    my $view = $t->{view};
+
+  SCAN: foreach my $f ( @$fileList ) {
+
+        #print STDERR "restoring $f...\n";
+
+        $f =~ /(.*)\/([^\/]*)/;
+        $path     = $1;
+        $fileName = $2;
+
+        $view->dirCache($path);
+
+        $fileAttr = $view->fileAttrib($fileName);
+        $fileType = fileType2Text( $fileAttr->{type} );
+
+        if ( $fileType eq "dir") {
+            $t->restoreDir($fileName, $fileAttr);
+
+        } elsif ( $fileType eq "file" ) {
+            $t->restoreFile($fileName, $fileAttr);
+
+        } elsif ( $fileType eq "symlink" ) {
+            #
+            # ignore
+            #
+        } else {
+            #
+            # ignore
+            #
+        }
+    } # end SCAN
+}
+
+
+sub restoreDir
+{
+    my ( $t, $dirName, $dirAttr ) = @_;
+
+    my $ftp    = $t->{ftp};
+    my $bpc    = $t->{bpc};
+    my $conf   = $t->{conf};
+    my $view   = $t->{view};
+    my $TopDir = $bpc->TopDir();
+
+    my $path    = "$dirAttr->{relPath}/$dirName";
+    my $dirList = $view->dirAttrib( -1, $t->{shareName}, $path );
+
+    my ( $fileName, $fileAttr, $fileType );
+
+    #print STDERR "BackupPC::Xfer::Ftp->restore($dirName)\n";
+
+    #
+    # Create the remote directory
+    #
+    unless ( $ftp->mkdir( $path, 1 ) ) {
+
+        $t->logFileAction( "fail", $dirName, $dirAttr );
+        return;
+    }
+
+ SCAN: while ( ($fileName, $fileAttr ) = each %$dirList ) {
+
+        $fileType = fileType2Text( $fileAttr->{type} );
+
+        if ( $fileType eq "dir" ) {
+            if ( $t->restoreDir( $fileName, $fileAttr ) ) {
+                $t->logWrite( "restored: $path/$fileName\n", 5 );
+            } else {
+                $t->logWrite( "restore failed: $path/$fileName\n", 3 );
+            }
+
+        } elsif ( $fileType eq "file" ) {
+            $t->restoreFile( $fileName, $fileAttr );
+
+        } elsif ( $fileType eq "hardlink" ) {
+            #
+            # Hardlinks cannot be restored.  however, if we have the
+            # target file in the pool, we can restore that.
+            #
+            $t->restoreFile( $fileName, $fileAttr );
+
+            next SCAN;
+
+        } elsif ( $fileType eq "symlink" ) {
+            #
+            # Symlinks cannot be restored
+            #
+            next SCAN;
+
+        } else {
+            #
+            # Ignore all other types (devices, doors, etc)
+            #
+            next SCAN;
+        }
+    }
+}
+
+
+sub restoreFile
+{
+    my ($t, $fileName, $fileAttr ) = @_;
+
+    my $conf = $t->{conf};
+    my $ftp  = $t->{ftp};
+
+    my $poolFile = $fileAttr->{fullPath};
+    my $fileDest = ( $conf->{ClientCharset} ne "" )
+                 ? from_to( "$fileAttr->{relPath}/$fileName",
+                            "utf8", $conf->{ClientCharset} )
+                 : "$fileAttr->{relPath}/$fileName";
+
+    #print STDERR "BackupPC::Xfer::Ftp->restoreFile($fileName)\n";
+
+    #
+    # Note: is logging necessary here?
+    #
+    if ( $ftp->put( $poolFile, $fileDest ) ) {
+        $t->logFileAction("restore", $fileName, $fileAttr);
+
+    } else {
+        $t->logFileAction("fail", $fileName, $fileAttr);
+    }
+}
+
+
+#
+#  usage:
+#   $t->backup($path);
+#
+# $t->backup() is a recursive function that takes a path as an
+# argument, and performs a backup on that folder consistent with the
+# configuration parameters.  $path is considered rooted at
+# $t->{shareName}, so no $ftp->cwd() command is necessary.
+#
+sub backup
+{
+    my ($t) =  @_;
+
+    my $ftp    = $t->{ftp};
+    my $bpc    = $t->{bpc};
+    my $conf   = $t->{conf};
+    my $TopDir = $bpc->TopDir();
+    my $OutDir = "$TopDir/pc/$t->{client}/new/"
+      . $bpc->fileNameEltMangle( $t->{shareName} );
+
+    #
+    # Prepare the view object
+    #
+    $t->{view} = BackupPC::View->new( $bpc, $t->{client}, $t->{backups} );
+
+    #
+    # Prepare backup folder
+    #
+    unless ( mkpath( $OutDir, 0, 0755 ) ) {
+        $t->{_errStr} = "can't create OutDir: $OutDir";
+        $t->{xferErrCnt}++;
+        return;
+    }
+
+    #
+    # determine the filetype of the shareName and back it up
+    # appropriately.  For now, assume that $t->{shareName} is a
+    # directory.
+    #
+    my $f = {
+              relPath  => "",
+              fullName => $t->{shareName},
+            };
+
+    if ( $t->handleDir( $f, $OutDir ) ) {
+
+        $t->{xferOK} = 1;
+        return 1;
+
+    } else {
+
+        $t->{xferBadShareCnt}++;
+        return;
+    }
+}
+
+
+####################################################################################
+# FTP-specific functions
+####################################################################################
+
+
+#
+# This is an encapulation of the logic necessary to grab the arguments
+# from %Conf and throw it in a hash pointer to be passed to the
+# Net::FTP object.
+#
+sub getFTPArgs
+{
+    my ($t)  = @_;
+    my $bpc  = $t->{bpc};
+    my $conf = $t->{conf};
+
+    #
+    # accepted default key => value pairs to Net::FTP
+    #
+    my $args = {
+                 Host         => undef,
+                 Firewall     => undef,          # not used
+                 FirewallType => undef,          # not used
+                 BlockSize    => 10240,
+                 Port         => 21,
+                 Timeout      => 120,
+                 Debug        => 0,              # do not touch
+                 Passive      => 1,              # do not touch
+                 Hash         => undef,          # do not touch
+                 LocalAddr    => "localhost",    # do not touch
+               };
+
+    #
+    # This is mostly to fool makeDist
+    #
+    exists( $conf->{ClientNameAlias} ) && exists( $conf->{FtpBlockSize} ) &&
+    exists( $conf->{FtpPort} )         && exists( $conf->{FtpTimeout} )
+        or die "Configuration variables for FTP not present in config.pl";
+
+    #
+    # map of options from %Conf in the config.pl scripts to options
+    # the Net::FTP::AutoReconnect object.
+    #
+    my $argMap = {
+                   "Host"      => "ClientNameAlias",
+                   "BlockSize" => "FtpBlockSize",
+                   "Port"      => "FtpPort",
+                   "Timeout"   => "FtpTimeout",
+                 };
+
+    foreach my $key ( keys(%$args) ) {
+        $args->{$key} = $conf->{ $argMap->{$key} } || $args->{$key};
+    }
+
+    #
+    # Fix for $args->{Host} since it can be in more than one location.
+    # Note the precedence here, this may need to be fixed.  Order of
+    # precedence:
+    #   $conf->{ClientNameAlias}
+    #   $t->{hostIP}
+    #   $t->{host}
+    #
+    $args->{Host} ||= $t->{hostIP};
+    $args->{Host} ||= $t->{host};
+
+    #
+    # return the reference to the hash of items
+    #
+    return $args;
+}
+
+
+#
+#   usage:
+#     $dirList = $t->remotels($path);
+#
+# remotels() returns a reference to a list of hash references that
+# describe the contents of each file in the directory of the path
+# specified.
+#
+# In the future, I would like to make this function return objects in
+# Attrib format.  That would be very optimal, and I could probably
+# release the code to CPAN.
+#
+sub remotels
+{
+    my ( $t, $path ) = @_;
+
+    my $ftp  = $t->{ftp};
+    my $bpc  = $t->{bpc};
+    my $conf = $t->{conf};
+
+    my ( $dirContents, $remoteDir, $f );
+
+    unless ( $dirContents = ($path =~ /^\.?$/ ) ? $ftp->dir() :
+                                                  $ftp->dir("$path/") )
+    {
+        $t->{xferErrCnt}++;
+        return "can't retrieve remote directory contents of $path";
+    }
+
+    foreach my $info ( @{parse_dir($dirContents)} ) {
+
+        $f = {
+              name   => $info->[0],
+              type   => $info->[1],
+              size   => $info->[2],
+              mtime  => $info->[3],
+              mode   => $info->[4],
+            };
+
+       #
+       # convert & store utf8 version of filename
+        #
+        $f->{utf8name} = $f->{name};
+        from_to( $f->{utf8name}, $conf->{ClientCharset}, "utf8" );
+
+       #
+       # construct the full name
+       #
+       $f->{fullName} = "$t->{sharePath}/$path/$f->{name}";
+       $f->{fullName} =~ s/\/+/\//g;
+
+       $f->{relPath} = ($path eq "") ? $f->{name} : "$path/$f->{name}";
+       $f->{relPath} =~ s/\/+/\//g;
+
+        push( @$remoteDir, $f );
+    }
+
+    return $remoteDir;
+}
+
+
+#
+# ignoreFileCheck() looks at the attributes of the arguments and the
+# backup types, and determines if the file should be skipped in this
+# backup.
+#
+sub ignoreFileCheck
+{
+    my ( $t, $f, $attrib ) = @_;
+
+    #
+    # case for ignoring the files '.' & '..'
+    #
+    if ( $f->{name} =~ /^\.\.?$/ ) {
+        return 1;
+    }
+
+    #
+    # Check the include/exclude lists.  the function returns true if
+    # the file should be backed up, so return the opposite.
+    #
+    return ( !$t->checkIncludeExclude( $f->{fullName} ) );
+}
+
+
+#
+# handleSymlink() backs up a symlink.
+#
+sub handleSymlink
+{
+    my ( $t, $f, $OutDir, $attrib ) = @_;
+
+    my $conf = $t->{conf};
+    my $ftp  = $t->{ftp};
+    my ( $target, $targetDesc );
+
+    my $attribInfo = {
+        type  => BPC_FTYPE_SYMLINK,
+        mode  => $f->{mode},
+        uid   => undef,            # unsupported
+        gid   => undef,            # unsupported
+        size  => 0,
+        mtime => $f->{mtime},
+    };
+
+    #
+    # If we are following symlinks, back them up as the type of file
+    # they point to. Otherwise, backup the symlink.
+    #
+    if ( $conf->{FtpFollowSymlinks} ) {
+
+        #
+        # handle nested symlinks by recurring on the target until a
+        # file or directory is found.
+        #
+        $f->{type} =~ /^l (.*)/;
+        $target = $1;
+
+        if ( $targetDesc = $ftp->dir("$target/") ) {
+            $t->handleSymDir( $f, $OutDir, $attrib, $targetDesc );
+
+        } elsif ( $targetDesc = $ftp->dir($target) ) {
+            if ( $targetDesc->[4] eq 'file' ) {
+                $t->handleSymFile( $f, $OutDir, $attrib );
+
+            } elsif ( $targetDesc->[4] =~ /l (.*)/) {
+
+                $t->logFileAction("fail", $f->{utf8name}, $attribInfo);
+                return;
+            }
+        } else {
+
+            $t->("fail", $f);
+            return;
+        }
+
+    } else {
+
+        #
+        # If we are not following symlinks, record them normally.
+        #
+        $attrib->set( $f->{utf8name}, $attribInfo );
+        $t->logFileAction("create", $f->{utf8name}, $attribInfo);
+    }
+    return 1;
+}
+
+
+sub handleSymDir
+{
+    my ($t, $fSym, $OutDir, $attrib, $targetDesc) = @_;
+
+    return 1;
+ }
+
+
+sub handleSymFile
+{
+    my ( $t, $fSym, $OutDir, $attrib, $targetDesc ) = @_;
+
+    my $bpc  = $t->{bpc};
+    my $conf = $t->{conf};
+
+    my $f = {
+              name  => $fSym->{name},
+              type  => $targetDesc->[1],
+              size  => $targetDesc->[2],
+              mtime => $targetDesc->[3],
+              mode  => $targetDesc->[4]
+            };
+
+    $f->{utf8name} = $fSym->{name};
+    from_to( $f->{utf8name}, $conf->{ClientCharset}, "utf8" );
+
+    $f->{relPath} = $fSym->{relPath};
+
+    $f->{fullName} = "$t->{shareName}/$fSym->{relPath}/$fSym->{name}";
+    $f->{fullName} =~ s/\/+/\//g;
+
+    #
+    # since FTP servers follow symlinks, we can jsut do this:
+    #
+    return $t->handleFile( $f, $OutDir, $attrib );
+}
+
+
+#
+# handleDir() backs up a directory, and initiates a backup of its
+# contents.
+#
+sub handleDir
+{
+    my ( $t, $dir, $OutDir ) = @_;
+
+    my $ftp   = $t->{ftp};
+    my $bpc   = $t->{bpc};
+    my $conf  = $t->{conf};
+    my $view  = $t->{view};
+    my $stats = $t->{stats};
+
+    my ( $exists, $digest, $outSize, $errs );
+    my ( $poolWrite, $poolFile, $attribInfo );
+    my ( $localDir, $remoteDir, $attrib, %expectedFiles );
+
+    if ( exists($dir->{utf8name})) {
+        $OutDir .= "/" . $bpc->fileNameMangle( $dir->{utf8name} );
+    }
+
+    unless ( -d $OutDir ) {
+
+        mkpath( $OutDir, 0, 0755 );
+        $t->logFileAction( "create", $dir->{utf8name}, $dir );
+    }
+
+    $attrib    = BackupPC::Attrib->new( { compress => $t->{Compress} } );
+    $remoteDir = $t->remotels( $dir->{relPath} );
+
+    if ( $t->{type} eq "incr" ) {
+        $localDir  = $view->dirAttrib( $t->{incrBaseBkupNum},
+                                       $t->{shareName}, $dir->{relPath} );
+        %expectedFiles = map { $_ => 0 } sort keys %$localDir
+    }
+
+    #
+    # take care of each file in the directory
+    #
+ SCAN: foreach my $f ( @{$remoteDir} ) {
+
+        next SCAN if $t->ignoreFileCheck( $f, $attrib );
+
+        #
+        # handle based on filetype
+        #
+        if ( $f->{type} eq 'f' ) {
+            $t->handleFile( $f, $OutDir, $attrib );
+
+        } elsif ( $f->{type} eq 'd' ) {
+
+            $attribInfo = {
+                type  => BPC_FTYPE_DIR,
+                mode  => $f->{mode},
+                uid   => undef,           # unsupported
+                gid   => undef,           # unsupported
+                size  => $f->{size},
+                mtime => $f->{mtime},
+            };
+
+            #print STDERR "$f->{utf8name}: ". Dumper($attribInfo);
+
+            if ( $t->handleDir($f, $OutDir) ) {
+                $attrib->set( $f->{utf8name}, $attribInfo);
+            }
+
+        } elsif ( $f->{type} =~ /^l (.*)/ ) {
+            $t->handleSymlink( $f, $OutDir, $attrib );
+
+        } else {
+            #
+            # do nothing
+            #
+        }
+
+        #
+        # Mark file as seen in expected files hash
+        #
+        $expectedFiles{ $f->{utf8name} }++ if ( $t->{type} eq "incr" );
+
+    } # end foreach (@{$remoteDir})
+
+    #
+    # If the backup type is incremental, mark the files that are not
+    # present on the server as deleted.
+    #
+    if ( $t->{type} eq "incr" ) {
+        while ( my ($f, $seen) = each %expectedFiles ) {
+            $attrib->set( $f, { type => BPC_FTYPE_DELETED } )
+                unless ($seen);
+        }
+    }
+
+    #
+    # print the directory attributes, now that the directory is done.
+    #
+    my $fileName = $attrib->fileName($OutDir);
+    my $data     = $attrib->writeData();
+
+    $poolWrite = BackupPC::PoolWrite->new( $bpc, $fileName, length($data),
+                                           $t->{Compress} );
+    $poolWrite->write( \$data );
+    ( $exists, $digest, $outSize, $errs ) = $poolWrite->close();
+
+    #
+    # Explicit success
+    #
+    return 1;
+}
+
+
+#
+# handleFile() backs up a file.
+#
+sub handleFile
+{
+    my ( $t, $f, $OutDir, $attrib ) = @_;
+
+    my $bpc        = $t->{bpc};
+    my $ftp        = $t->{ftp};
+    my $view       = $t->{view};
+    my $stats      = $t->{stats};
+    my $newFilesFH = $t->{newFilesFH};
+
+    my ( $poolFile, $poolWrite, $data, $localSize );
+    my ( $exists, $digest, $outSize, $errs );
+    my ( $oldAttrib );
+    local *FTP;
+
+    #
+    # If this is an incremental backup and the file exists in a
+    # previous backup unchanged, write the attribInfo for the file
+    # accordingly.
+    #
+    if ( $t->{type} eq "incr" ) {
+        return 1 if $t->incrFileExistCheck( $f, $attrib );
+    }
+
+    my $attribInfo = {
+                       type  => BPC_FTYPE_FILE,
+                       mode  => $f->{mode},
+                       uid   => undef,            # unsupported
+                       gid   => undef,            # unsupported
+                       size  => $f->{size},
+                       mtime => $f->{mtime},
+                     };
+
+    #
+    # If this is a full backup or the file has changed on the host,
+    # back it up.
+    #
+    unless ( tie( *FTP, 'Net::FTP::RetrHandle', $ftp, $f->{fullName} ) ) {
+
+        $t->handleFileAction( "fail", $attribInfo );
+        $t->{xferBadFileCnt}++;
+        $stats->{errCnt}++;
+        return;
+    }
+
+    $poolFile  = $OutDir . "/" . $bpc->fileNameMangle( $f->{name} );
+    $poolWrite = BackupPC::PoolWrite->new( $bpc, $poolFile, $f->{size},
+                                           $bpc->{xfer}{compress} );
+
+    $localSize = 0;
+    while (<FTP>) {
+
+        $localSize += length($_);
+        $poolWrite->write( \$_ );
+    }
+    ( $exists, $digest, $outSize, $errs ) = $poolWrite->close();
+
+    #
+    # calculate the file statistics
+    #
+    if (@$errs) {
+
+        $t->logFileAction( "fail", $f->{utf8name}, $attribInfo );
+        unlink($poolFile);
+        $t->{xferBadFileCnt}++;
+        $t->{errCnt} += scalar(@$errs);
+        return;
+    }
+
+    #
+    # this should never happen
+    #
+    if ( $localSize != $f->{size} ) {
+
+        $t->logFileAction( "fail", $f->{utf8name}, $attribInfo );
+        unklink($poolFile);
+        $stats->{xferBadFileCnt}++;
+        $stats->{errCnt}++;
+        return;
+    }
+
+    #
+    # Perform logging
+    #
+    $attrib->set( $f->{utf8name}, $attribInfo );
+    $t->logFileAction( $exists ? "pool" : "create", $f->{utf8name}, $attribInfo );
+    print $newFilesFH "$digest $f->{size} $poolFile\n" unless $exists;
+
+    #
+    # Cumulate the stats
+    #
+    $stats->{TotalFileCnt}++;
+    $stats->{ExistFileCnt}++;
+    $stats->{ExistFileCompSize} += -s $poolFile;
+    $stats->{ExistFileSize}     += $f->{size};
+    $stats->{TotalFileSize}     += $f->{size};
+
+    $t->{byteCnt} += $localSize;
+    $t->{fileCnt}++;
+}
+
+
+#
+# this function checks if the file has been modified on disk, and if
+# it has, returns.  Otherwise, it updates the attrib values.
+#
+sub incrFileExistCheck
+{
+    my ($t, $f, $attrib) = @_;
+
+    my $view = $t->{view};
+
+    my $oldAttribInfo = $view->fileAttrib( $t->{incrBaseBkupNum},
+                                       $t->{shareName}, $f->{relPath} );
+
+    #print STDERR "*" x 50 . "\n";
+    #print STDERR "Old data:\n" . Dumper($oldAttribInfo);
+    #print STDERR "New data:\n" . Dumper($f);
+    #print STDERR "$f->{fullName}: $oldAttribInfo->{mtime} ?= $f->{mtime}, $oldAttribInfo->{size} ?= $f->{size}\n";
+
+    return ( $oldAttribInfo->{mtime} == $f->{mtime}
+          && $oldAttribInfo->{size} == $f->{size} );
+}
+
+
+#
+# Generate a log file message for a completed file.  Taken from
+# BackupPC_tarExtract. $f should be an attrib object.
+#
+sub logFileAction
+{
+    my ( $t, $action, $name, $attrib ) = @_;
+
+    my $owner = "$attrib->{uid}/$attrib->{gid}";
+    my $type =
+      ( ( "", "p", "c", "", "d", "", "b", "", "", "", "l", "", "s" ) )
+      [ ( $attrib->{mode} & S_IFMT ) >> 12 ];
+
+    $name  = "."   if ( $name  eq "" );
+    $owner = "-/-" if ( $owner eq "/" );
+
+    my $fileAction = sprintf( "  %-6s %1s%4o %9s %11.0f %s\n",
+                              $action, $type, $attrib->{mode} & 07777,
+                              $owner, $attrib->{size}, $name );
+
+    return $t->logWrite( $fileAction, 1 );
+}
+
+1;
diff --git a/lib/BackupPC/Xfer/Protocol.pm b/lib/BackupPC/Xfer/Protocol.pm
new file mode 100644 (file)
index 0000000..ae6b4c4
--- /dev/null
@@ -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    <pcmantz@zmanda.com>
+#
+# COPYRIGHT
+#   Copyright (C) 2001-2007  Craig Barratt
+#
+#   This program is free software; you can redistribute it and/or modify
+#   it under the terms of the GNU General Public License as published by
+#   the Free Software Foundation; either version 2 of the License, or
+#   (at your option) any later version.
+#
+#   This program is distributed in the hope that it will be useful,
+#   but WITHOUT ANY WARRANTY; without even the implied warranty of
+#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#   GNU General Public License for more details.
+#
+#   You should have received a copy of the GNU General Public License
+#   along with this program; if not, write to the Free Software
+#   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+#
+#========================================================================
+#
+# Version 3.1.0, released 25 Nov 2007.
+#
+# See http://backuppc.sourceforge.net.
+#
+#========================================================================
+
+package BackupPC::Xfer::Protocol;
+
+use strict;
+use Data::Dumper;
+use Encode qw/from_to encode/;
+
+use BackupPC::Attrib qw(:all);
+
+#    
+#  usage: 
+#    $t = BackupPC::Xfer::Protocol->new($args);
+#
+# new() is the constructor.  There's nothing special going on here.
+#    
+sub new
+{
+    my($class, $bpc, $args) = @_;
+
+    $args ||= {};
+    my $t = bless {
+        bpc       => $bpc,
+        conf      => $bpc->{Conf},
+        host      => "",
+        hostIP    => "",
+        shareName => "",
+        pipeRH    => undef,
+        pipeWH    => undef,
+        badFiles  => [],
+
+        #
+        # Various stats
+        #
+        byteCnt         => 0,
+        fileCnt         => 0,
+        xferErrCnt      => 0,
+        xferBadShareCnt => 0,
+        xferBadFileCnt  => 0,
+        xferOK          => 0,
+
+        #
+        # User's args
+        #
+        %$args,
+    }, $class;
+
+    return $t;
+}
+
+#    
+#  usage:
+#    $t->args($args);
+#
+# args() can be used to send additional argument to the Xfer object
+# via a hash reference.
+#    
+sub args
+{
+    my($t, $args) = @_;
+
+    foreach my $arg ( keys(%$args) ) {
+        $t->{$arg} = $args->{$arg};
+    }
+}
+
+#
+#  usage:
+#    $t->start();
+#
+# start() executes the actual data transfer.  Must be implemented by
+# the derived class.
+#
+sub start
+{
+    my($t) = @_;
+
+    $t->{_errStr} = "start() not implemented by ".ref($t);
+    return;
+}
+
+#
+#
+#
+sub run
+{
+    my($t) = @_;
+
+    $t->{_errStr} = "run() not implemented by ".ref($t);
+    return;
+}
+
+#
+#  usage:
+#    $t->readOutput();
+#
+# This function is only used when $t->useTar() == 1.
+#
+sub readOutput
+{
+    my($t) = @_;
+
+    $t->{_errStr} = "readOutput() not implemented by " . ref($t);
+    return;
+}
+
+#
+#  usage:
+#    $t->abort($reason);
+#
+# Aborts the current job.
+#
+sub abort
+{
+    my($t, $reason) = @_;
+    my @xferPid = $t->xferPid;
+
+    $t->{abort}       = 1;
+    $t->{abortReason} = $reason;
+    if ( @xferPid ) {
+        kill($t->{bpc}->sigName2num("INT"), @xferPid);
+    }
+}
+
+#
+#  usage:
+#    $t->subSelectMask
+#
+# This function sets a mask for files when ($t->useTar == 1).
+#
+sub setSelectMask
+{
+    my($t) = @_;
+
+    $t->{_errStr} = "readOutput() not implemented by " . ref($t);
+}
+
+#
+#  usage:
+#    $t->errStr();
+#
+sub errStr
+{
+    my($t) = @_;
+
+    return $t->{_errStr};
+}
+
+#
+#  usage:
+#   $pid = $t->xferPid();
+#
+# xferPid() returns the process id of the child forked process.
+#
+sub xferPid
+{
+    my($t) = @_;
+
+    return ($t->{xferPid});
+}
+
+#
+#  usage:
+#    $t->logMsg($msg);
+#
+sub logMsg
+{
+    my ($t, $msg) = @_;
+
+    push(@{$t->{_logMsg}}, $msg);
+}
+
+#
+#  usage:
+#    $t->logMsgGet();
+#
+sub logMsgGet
+{
+    my($t) = @_;
+
+    return shift(@{$t->{_logMsg}});
+}
+
+#
+#  usage:
+#    $t->getStats();
+#
+# This function returns xfer statistics.  It Returns a hash ref giving
+# various status information about the transfer.
+#
+sub getStats
+{
+    my ($t) = @_;
+
+    return {
+        map { $_ => $t->{$_} }
+          qw(byteCnt fileCnt xferErrCnt xferBadShareCnt xferBadFileCnt
+             xferOK hostAbort hostError lastOutputLine)
+    };
+}
+
+sub getBadFiles
+{
+    my ($t) = @_;
+
+    return @{$t->{badFiles}};
+}
+
+#
+# useTar function.  In order to work correctly, the protocol in
+# question should overwrite the function if it needs to return true.
+#
+sub useTar
+{
+    return 0;
+}
+
+##############################################################################
+# Logging Functions
+##############################################################################
+
+#
+# usage:
+#   $t->logWrite($msg [, $level])
+#
+# This function writes to XferLOG.
+#
+sub logWrite
+{
+    my($t, $msg, $level) = @_;
+
+    my $XferLOG = $t->{XferLOG};
+    $level = 3 if ( !defined($level) );
+    
+    return ( $XferLOG->write(\$msg) ) if ( $level <= $t->{logLevel} );
+}
+
+
+##############################################################################
+# File Inclusion/Exclusion
+##############################################################################
+
+#
+# loadInclExclRegexps() places the appropriate file include/exclude regexps 
+#
+sub loadInclExclRegexps
+{
+    my ( $t, $shareType ) = @_;
+    my $bpc  = $t->{bpc};
+    my $conf = $t->{conf};
+    
+    my @BackupFilesOnly    = ();
+    my @BackupFilesExclude = ();
+    my ($shareName, $shareNameRE);
+    
+    #
+    # $conf->{$shareType} shold be a reference to an array with one
+    # element, thanks to BackupFileConfFix().
+    #
+    $shareName = @{ $conf->{$shareType} }[0];
+    $shareName =~ s/\/*$//;    # remove trailing slashes
+
+    $t->{shareName}   = $shareName;
+    $t->{shareNameRE} = $bpc->glob2re($shareName);
+
+    #
+    # load all relevant values into @BackupFilesOnly
+    #
+    if ( ref( $conf->{BackupFilesOnly} ) eq "HASH" ) {
+
+        foreach my $share ( ( '*', $shareName ) ) {
+           push @BackupFilesOnly, @{ $conf->{BackupFilesOnly}{$share} } 
+               if ( defined( $conf->{BackupFilesOnly}{$share} ) );
+        }
+       
+    } elsif ( ref( $conf->{BackupFilesOnly} ) eq "ARRAY" ) {
+       
+        push( @BackupFilesOnly, @{ $conf->{BackupFilesOnly} } );
+       
+    } elsif ( !defined( $conf->{BackupFilesOnly} ) ) {
+
+        #
+        # do nothing 
+        #
+       
+    } else {
+
+        #
+        # not a legitimate entry for $conf->{BackupFilesOnly}
+        #
+        $t->{_errStr} = "Incorrect syntax in BackupFilesOnly for host $t->{Host}";
+          
+        return;
+    }
+    
+    #
+    # load all relevant values into @BackupFilesExclude
+    #
+    if ( ref( $conf->{BackupFilesExclude} ) eq "HASH" ) {
+
+        foreach my $share ( ( '*', $shareName ) ) {
+            push( @BackupFilesExclude,
+                map {
+                        ( $_ =~ /^\// )
+                      ? ( $t->{shareNameRE} . $bpc->glob2re($_) )
+                      : ( '.*\/' . $bpc->glob2re($_) . '(?=\/.*)?' )
+                  } @{ $conf->{BackupFilesExclude}{$share} }
+                ) if ( defined( $conf->{BackupFilesExclude}{$share} ) ) ;
+        }
+
+    } elsif ( ref( $conf->{BackupFilesExclude} ) eq "ARRAY" ) {
+
+        push( @BackupFilesExclude,
+            map {
+                    ( $_ =~ /\// )
+                  ? ( $bpc->glob2re($_) )
+                  : ( '.*\/' . $bpc->glob2re($_) . '(?<=\/.*)?' )
+              } @{ $conf->{BackupFilesExclude} } );
+
+    } elsif ( !defined( $conf->{BackupFilesOnly} ) ) {
+
+        #
+        # do nothing here
+        #
+
+    } else {
+
+        #
+        # not a legitimate entry for $conf->{BackupFilesExclude}
+        #
+        $t->{_errStr} =
+          "Incorrect syntax in BackupFilesExclude for host $t->{Host}";
+        return;
+    }
+
+    #
+    # load the regular expressions into the xfer object
+    #
+    $t->{BackupFilesOnly} = ( @BackupFilesOnly > 0 ) ? \@BackupFilesOnly : undef;
+    $t->{BackupFilesExclude} = ( @BackupFilesExclude > 0 ) ? \@BackupFilesExclude : undef;
+
+    return 1;
+}
+
+
+sub checkIncludeExclude
+{
+    my ($t, $file) = @_;
+
+    return ( $t->checkIncludeMatch($file) && !$t->checkExcludeMatch($file) );
+}
+    
+sub checkIncludeMatch
+{
+    my ($t, $file) = @_;
+
+    my $shareName = $t->{shareName};
+    my $includes  = $t->{BackupFilesOnly} || return 1;
+    my $match = "";
+    
+    foreach my $include ( @{$includes} ) {
+      
+        #
+        # construct regexp elsewhere to avoid syntactical evil
+        #
+        $match = '^' . quotemeta( $shareName . $include ) . '(?=\/.*)?';
+
+       #
+        # return true if the include folder is a parent of the file,
+        # or the folder itself.
+       #
+        return 1 if ( $file =~ /$match/ );
+
+        $match = '^' . quotemeta($file) . '(?=\/.*)?';
+
+       #
+        # return true if the file is a parent of the include folder,
+        # or the folder itself.
+       #
+        return 1 if ( "$shareName$include" =~ /$match/ );
+    }
+    return 0;
+}
+
+sub checkExcludeMatch
+{
+    my ($t, $file) = @_;
+
+    my $shareName = $t->{shareName};
+    my $includes  = $t->{BackupFilesOnly} || return 0;
+    my $match = "";
+
+    foreach my $include ( @{$includes} ) {
+
+        #
+        # construct regexp elsewhere to avoid syntactical evil
+        #
+        $match = '^' . quotemeta( $shareName . $include ) . '(?=\/.*)?';
+
+       #
+        # return true if the include folder is a parent of the file,
+        # or the folder itself.
+       #
+        return 1 if ( $file =~ /$match/ );
+
+        $match = '^' . quotemeta($file) . '(?=\/.*)?';
+                
+       #
+        # return true if the file is a parent of the include folder,
+        # or the folder itself.
+       #
+        return 1 if ( "$shareName$include" =~ /$match/ );
+    }
+    return 0;
+}
+
+1;
index 3110f87..ff24cd5 100644 (file)
@@ -41,6 +41,7 @@ use strict;
 use BackupPC::View;
 use BackupPC::Xfer::RsyncFileIO;
 use Encode qw/from_to encode/;
 use BackupPC::View;
 use BackupPC::Xfer::RsyncFileIO;
 use Encode qw/from_to encode/;
+use base qw(BackupPC::Xfer::Protocol);
 
 use vars qw( $RsyncLibOK $RsyncLibErr );
 
 
 use vars qw( $RsyncLibOK $RsyncLibErr );
 
@@ -59,7 +60,7 @@ BEGIN {
         if ( $File::RsyncP::VERSION < 0.68 ) {
             $RsyncLibOK = 0;
             $RsyncLibErr = "File::RsyncP module version"
         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;
         }
         } else {
             $RsyncLibOK = 1;
         }
@@ -71,46 +72,8 @@ sub new
     my($class, $bpc, $args) = @_;
 
     return if ( !$RsyncLibOK );
     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
 }
 
 sub start
@@ -480,11 +443,6 @@ sub abort
     return 1;
 }
 
     return 1;
 }
 
-sub setSelectMask
-{
-    my($t, $FDreadRef) = @_;
-}
-
 sub errStr
 {
     my($t) = @_;
 sub errStr
 {
     my($t) = @_;
@@ -500,39 +458,4 @@ sub xferPid
     return ();
 }
 
     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;
 1;
index acfe195..baaeccb 100644 (file)
@@ -39,35 +39,7 @@ package BackupPC::Xfer::Smb;
 
 use strict;
 use Encode qw/from_to encode/;
 
 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
 {
 
 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->{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;
            my $badDir = $1;
            $badDir =~ s{\\}{/}g;
            $badDir =~ s{/+}{/}g;
@@ -349,14 +322,6 @@ sub readOutput
     return 1;
 }
 
     return 1;
 }
 
-sub abort
-{
-    my($t, $reason) = @_;
-
-    $t->{abort} = 1;
-    $t->{abortReason} = $reason;
-}
-
 sub setSelectMask
 {
     my($t, $FDreadRef) = @_;
 sub setSelectMask
 {
     my($t, $FDreadRef) = @_;
@@ -364,53 +329,4 @@ sub setSelectMask
     vec($$FDreadRef, fileno($t->{pipeSMB}), 1) = 1;
 }
 
     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;
 1;
index f6f0be1..4ab61e7 100644 (file)
@@ -39,35 +39,7 @@ package BackupPC::Xfer::Tar;
 
 use strict;
 use Encode qw/from_to encode/;
 
 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
 {
 
 sub useTar
 {
@@ -270,18 +242,6 @@ sub readOutput
     return 1;
 }
 
     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) = @_;
 sub setSelectMask
 {
     my($t, $FDreadRef) = @_;
@@ -289,53 +249,4 @@ sub setSelectMask
     vec($$FDreadRef, fileno($t->{pipeTar}), 1) = 1;
 }
 
     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;
 1;
diff --git a/lib/Net/FTP/AutoReconnect.pm b/lib/Net/FTP/AutoReconnect.pm
new file mode 100644 (file)
index 0000000..b2c82d7
--- /dev/null
@@ -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<Net::FTP::AutoReconnect> is a wrapper module around C<Net::FTP>.
+For many commands, if anything goes wrong on the first try, it tries
+to disconnect and reconnect to the server, restore the state to the
+same as it was when the command was executed, then execute it again.
+The state includes login credentials, authorize credentials, transfer
+mode (ASCII or binary), current working directory, and any restart,
+passive, or port commands sent.
+
+=head1 DESCRIPTION
+
+The goal of this method is to hide some implementation details of FTP
+server systems from the programmer.  In particular, many FTP systems
+will automatically disconnect a user after a relatively short idle
+time or after a transfer is aborted.  In this case,
+C<Net::FTP::AutoReconnect> will simply reconnect, send the commands
+necessary to return your session to its previous state, then resend
+the command.  If that fails, it will return the error.
+
+It makes no effort to determine what sorts of errors are likely to
+succeed when they're retried.  Partly that's because it's hard to
+know; if you're retreiving a file from an FTP site with several
+mirrors and the file is not found, for example, maybe on the next try
+you'll connect to a different server and find it.  But mostly it's
+from laziness; if you have some good ideas about how to determine when
+to retry and when not to bother, by all means send patches.
+
+This module contains an instance of C<Net::FTP>, which it passes most
+method calls along to.
+
+These methods also record their state: C<alloc>, C<ascii>,
+C<authorize>, C<binary>, C<cdup>, C<cwd>, C<hash>,
+C<login>,C<restart>, C<pasv>, C<port>.  Directory changing commands
+execute a C<pwd> afterwards and store their new working directory.
+
+These methods are automatically retried: C<alloc>, C<appe>, C<append>,
+C<ascii>, C<binary>, C<cdup>, C<cwd>, C<delete>, C<dir>, C<get>,
+C<list>, C<ls>, C<mdtm>, C<mkdir>, C<nlst>, C<pasv>, C<port>, C<put>,
+C<put_unique>, C<pwd>, C<rename>, C<retr>, C<rmdir>, C<size>, C<stou>,
+C<supported>.
+
+These methods are tried just once: C<abort>, C<authorize>, C<hash>,
+C<login>, C<pasv_xfer>, C<pasv_xfer_unique>, C<pasv_wait>, C<quit>,
+C<restart>, C<site>, C<unique_name>.  From C<Net::Cmd>: C<code>,
+C<message>, C<ok>, C<status>.  C<restart> doesn't actually send any
+FTP commands (they're sent along with the command they apply to),
+which is why it's not restarted.
+
+Any other commands are unimplemented (or possibly misdocumented); if I
+missed one you'd like, please send a patch.
+
+=head2 CONSTRUCTOR
+
+=head3 new
+
+All parameters are passed along verbatim to C<Net::FTP>, as well as
+stored in case we have to reconnect.
+
+=cut
+  ;
+
+sub new {
+  my $self = {};
+  my $class = shift;
+  bless $self,$class;
+
+  $self->{newargs} = \@_;
+  $self->reconnect();
+
+  $self;
+}
+
+=head2 METHODS
+
+Most of the methods are those of L<Net::FTP|Net::FTP>.  One additional
+method is available:
+
+=head3 reconnect()
+
+Abandon the current FTP connection and create a new one, restoring all
+the state we can.
+
+=cut
+  ;
+
+sub reconnect
+{
+  my $self = shift;
+
+  warn "Reconnecting!\n"
+    if ($ENV{DEBUG});
+
+  $self->{ftp} = Net::FTP->new(@{$self->{newargs}})
+    or die "Couldn't create new FTP object\n";
+
+  if ($self->{login})
+  {
+    $self->{ftp}->login(@{$self->{login}});
+  }
+  if ($self->{authorize})
+  {
+    $self->{ftp}->authorize(@{$self->{authorize}});
+  }
+  if ($self->{mode})
+  {
+    if ($self->{mode} eq 'ascii')
+    {
+      $self->{ftp}->ascii();
+    }
+    else
+    {
+      $self->{ftp}->binary();
+    }
+  }
+  if ($self->{cwd})
+  {
+    $self->{ftp}->cwd($self->{cwd});
+  }
+  if ($self->{hash})
+  {
+    $self->{ftp}->hash(@{$self->{hash}});
+  }
+  if ($self->{restart})
+  {
+    $self->{ftp}->restart(@{$self->{restart}});
+  }
+  if ($self->{alloc})
+  {
+    $self->{ftp}->restart(@{$self->{alloc}});
+  }
+  if ($self->{pasv})
+  {
+    $self->{ftp}->pasv(@{$self->{pasv}});
+  }
+  if ($self->{port})
+  {
+    $self->{ftp}->port(@{$self->{port}});
+  }
+}
+
+sub _auto_reconnect
+{
+  my $self = shift;
+  my($code)=@_;
+
+  my $ret = $code->();
+  if (!defined($ret))
+  {
+    $self->reconnect();
+    $ret = $code->();
+  }
+  $ret;
+}
+
+sub _after_pcmd
+{
+  my $self = shift;
+  my($r) = @_;
+  if ($r)
+  {
+    # succeeded
+    delete $self->{port};
+    delete $self->{pasv};
+    delete $self->{restart};
+    delete $self->{alloc};
+  }
+  $r;
+}
+
+
+sub login
+{
+  my $self = shift;
+
+  $self->{login} = \@_;
+  $self->{ftp}->login(@_);
+}
+
+sub authorize
+{
+  my $self = shift;
+  $self->{authorize} = \@_;
+  $self->{ftp}->authorize(@_);
+}
+
+sub site
+{
+  my $self = shift;
+  $self->{ftp}->site(@_);
+}
+
+sub ascii
+{
+  my $self = shift;
+  $self->{mode} = 'ascii';
+  $self->_auto_reconnect(sub { $self->{ftp}->ascii() });
+}
+
+sub binary
+{
+  my $self = shift;
+  $self->{mode} = 'binary';
+  $self->_auto_reconnect(sub { $self->{ftp}->binary() });
+}
+
+sub rename
+{
+  my $self = shift;
+  my @a = @_;
+  $self->_auto_reconnect(sub { $self->{ftp}->rename(@a) });
+}
+
+sub delete
+{
+  my $self = shift;
+  my @a = @_;
+  $self->_auto_reconnect(sub { $self->{ftp}->delete(@a) });
+}
+
+sub cwd
+{
+  my $self = shift;
+  my @a = @_;
+  my $ret = $self->_auto_reconnect(sub { $self->{ftp}->cwd(@a) });
+  if (defined($ret))
+  {
+    $self->{cwd} = $self->{ftp}->pwd()
+      or die "Couldn't get directory after cwd\n";
+  }
+  $ret;
+}
+
+sub cdup
+{
+  my $self = shift;
+  my @a = @_;
+  my $ret = $self->_auto_reconnect(sub { $self->{ftp}->cdup(@a) });
+  if (defined($ret))
+  {
+    $self->{cwd} = $self->{ftp}->pwd()
+      or die "Couldn't get directory after cdup\n";
+  }
+  $ret;
+}
+
+sub pwd
+{
+  my $self = shift;
+  my @a = @_;
+  $self->_auto_reconnect(sub { $self->{ftp}->pwd(@a) });
+}
+
+sub rmdir
+{
+  my $self = shift;
+  my @a = @_;
+  $self->_auto_reconnect(sub { $self->{ftp}->rmdir(@a) });
+}
+
+sub mkdir
+{
+  my $self = shift;
+  my @a = @_;
+  $self->_auto_reconnect(sub { $self->{ftp}->mkdir(@a) });
+}
+
+sub ls
+{
+  my $self = shift;
+  my @a = @_;
+  my $ret = $self->_auto_reconnect(sub { $self->{ftp}->ls(@a) });
+  return $ret ? (wantarray ? @$ret : $ret) : undef;
+}
+
+sub dir
+{
+  my $self = shift;
+  my @a = @_;
+  my $ret = $self->_auto_reconnect(sub { $self->{ftp}->dir(@a) });
+  return $ret ? (wantarray ? @$ret : $ret) : undef;
+}
+
+sub restart
+{
+  my $self = shift;
+  my @a = @_;
+  $self->{restart} = \@a;
+  $self->{ftp}->restart(@_);
+}
+
+sub retr
+{
+  my $self = shift;
+  my @a = @_;
+  $self->_after_pcmd($self->_auto_reconnect(sub { $self->{ftp}->retr(@a) }));
+}
+
+sub get
+{
+  my $self = shift;
+  my @a = @_;
+  $self->_auto_reconnect(sub { $self->{ftp}->get(@a) });
+}
+
+sub mdtm
+{
+  my $self = shift;
+  my @a = @_;
+  $self->_auto_reconnect(sub { $self->{ftp}->mdtm(@a) });
+}
+
+sub size
+{
+  my $self = shift;
+  my @a = @_;
+  $self->_auto_reconnect(sub { $self->{ftp}->size(@a) });
+}
+
+sub abort
+{
+  my $self = shift;
+  $self->{ftp}->abort();
+}
+
+sub quit
+{
+  my $self = shift;
+  $self->{ftp}->quit();
+}
+
+sub hash
+{
+  my $self = shift;
+  my @a = @_;
+  $self->{hash} = \@a;
+  $self->{ftp}->hash(@_);
+}
+
+sub alloc
+{
+  my $self = shift;
+  my @a = @_;
+  $self->{alloc} = \@a;
+  $self->_auto_reconnect(sub { $self->{ftp}->alloc(@a) });
+}
+
+sub put
+{
+  my $self = shift;
+  my @a = @_;
+  $self->_auto_reconnect(sub { $self->{ftp}->put(@a) });
+}
+
+sub put_unique
+{
+  my $self = shift;
+  my @a = @_;
+  $self->_auto_reconnect(sub { $self->{ftp}->put_unique(@a) });
+}
+
+sub append
+{
+  my $self = shift;
+  my @a = @_;
+  $self->_auto_reconnect(sub { $self->{ftp}->append(@a) });
+}
+
+sub unique_name
+{
+  my $self = shift;
+  $self->{ftp}->unique_name(@_);
+}
+
+sub supported
+{
+  my $self = shift;
+  my @a = @_;
+  $self->_auto_reconnect(sub { $self->{ftp}->supported(@a) });
+}
+
+sub port
+{
+  my $self = shift;
+  my @a = @_;
+  $self->{port} = \@a;
+  $self->_auto_reconnect(sub { $self->{ftp}->port(@a) });
+}
+
+sub pasv
+{
+  my $self = shift;
+  my @a = @_;
+  $self->{pasv} = \@a;
+  $self->_auto_reconnect(sub { $self->{ftp}->pasv(@a) });
+}
+
+sub nlst
+{
+  my $self = shift;
+  my @a = @_;
+  $self->_after_pcmd($self->_auto_reconnect(sub { $self->{ftp}->nlst(@a) }));
+}
+
+sub stou
+{
+  my $self = shift;
+  my @a = @_;
+  $self->_after_pcmd($self->_auto_reconnect(sub { $self->{ftp}->stou(@a) }));
+}
+
+sub appe
+{
+  my $self = shift;
+  my @a = @_;
+  $self->_after_pcmd($self->_auto_reconnect(sub { $self->{ftp}->appe(@a) }));
+}
+
+sub list
+{
+  my $self = shift;
+  my @a = @_;
+  $self->_after_pcmd($self->_auto_reconnect(sub { $self->{ftp}->list(@a) }));
+}
+
+sub pasv_xfer
+{
+  my $self = shift;
+  $self->{ftp}->pasv_xfer(@_);
+}
+
+sub pasv_xfer_unique
+{
+  my $self = shift;
+  $self->{ftp}->pasv_xfer_unique(@_);
+}
+
+sub pasv_wait
+{
+  my $self = shift;
+  $self->{ftp}->pasv_wait(@_);
+}
+
+sub message
+{
+  my $self = shift;
+  $self->{ftp}->message(@_);
+}
+
+sub code
+{
+  my $self = shift;
+  $self->{ftp}->code(@_);
+}
+
+sub ok
+{
+  my $self = shift;
+  $self->{ftp}->ok(@_);
+}
+
+sub status
+{
+  my $self = shift;
+  $self->{ftp}->status(@_);
+}
+
+=head1 AUTHOR
+
+Scott Gifford <sgifford@suspectclass.com>
+
+=head1 BUGS
+
+We should really be smarter about when to retry.
+
+We shouldn't be hardwired to use C<Net::FTP>, but any FTP-compatible
+class; that would allow all modules similar to this one to be chained
+together.
+
+Much of this is only lightly tested; it's hard to find an FTP server
+unreliable enough to test all aspects of it.  It's mostly been tested
+with a server that dicsonnects after an aborted transfer, and the
+module seems to work OK.
+
+=head1 SEE ALSO
+
+L<Net::FTP>.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2006 Scott Gifford. All rights reserved.  This program
+is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Net/FTP/RetrHandle.pm b/lib/Net/FTP/RetrHandle.pm
new file mode 100644 (file)
index 0000000..70ae6fe
--- /dev/null
@@ -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<seek> and
+support for downloading only the parts of the file requested.
+
+=head1 DESCRIPTION
+
+Support for skipping the beginning of the file is implemented with the
+FTP C<REST> command, which starts a retrieval at any point in the
+file.  Support for skipping the end of the file is implemented with
+the FTP C<ABOR> command, which stops the transfer.  With these two
+commands and some careful tracking of the current file position, we're
+able to reliably emulate a C<seek/read> pair, and get only the parts
+of the file that are actually read.
+
+This was originally designed for use with
+L<Archive::Zip|Archive::Zip>; it's reliable enough that the table of
+contents and individual files can be extracted from a remote ZIP
+archive without downloading the whole thing.  See L<EXAMPLES> below.
+
+An interface compatible with L<IO::Handle|IO::Handle> is provided,
+along with a C<tie>-based interface.
+
+Remember that an FTP server can only do one thing at a time, so make
+sure to C<close> your connection before asking the FTP server to do
+nything else.
+
+=head1 CONSTRUCTOR
+
+=head2 new ( $ftp, $filename, options... )
+
+Creates a new L<IO::Handle|IO::Handle>-compatible object to fetch all
+or parts of C<$filename> using the FTP connection C<$ftp>.
+
+Available options:
+
+=over 4
+
+=item MaxSkipSize => $size
+
+If we need to move forward in a file or close the connection,
+sometimes it's faster to just read the bytes we don't need than to
+abort the connection and restart. This setting tells how many
+unnecessary bytes we're willing to read rather than abort.  An
+appropriate setting depends on the speed of transferring files and the
+speed of reconnecting to the server.
+
+=item BlockSize => $size
+
+When doing buffered reads, how many bytes to read at once.  The
+default is the same as the default for L<Net::FTP|Net::FTP>, so it's
+generally best to leave it alone.
+
+=item AlreadyBinary => $bool
+
+If set to a true value, we assume the server is already in binary
+mode, and don't try to set it.
+
+=back
+
+=cut
+use constant USAGE => "Usage: Net::FTP::RetrHandle\->new(ftp => \$ftp_obj, filename => \$filename)\n";
+sub new
+{
+  my $class = shift;
+  my $ftp = shift
+    or croak USAGE;
+  my $filename = shift
+    or croak USAGE;
+  my $self = { MaxSkipSize => DEFAULT_MAX_SKIPSIZE,
+              BlockSize => DEFAULT_BLOCKSIZE,
+              @_,
+              ftp => $ftp, filename => $filename,
+              pos => 0, nextpos => 0};
+  $self->{size} = $self->{ftp}->size($self->{filename})
+    or return undef;
+  $self->{ftp}->binary()
+    unless ($self->{AlreadyBinary});
+
+  bless $self,$class;
+}
+
+=head1 METHODS
+
+Most of the methods implemented behave exactly like those from
+L<IO::Handle|IO::Handle>.
+
+These methods are implemented: C<binmode>, C<clearerr>, C<close>, C<eof>,
+C<error>, C<getc>, C<getline>, C<getlines>, C<getpos>, C<read>,
+C<seek>, C<setpos>, C<sysseek>, C<tell>, C<ungetc>, C<opened>.
+
+=cut ;
+
+sub opened { 1; }
+
+sub seek
+{
+  my $self = shift;
+  my $pos = shift || 0;
+  my $whence = shift || 0;
+  warn "   SEEK: self=$self, pos=$pos, whence=$whence\n"
+    if ($ENV{DEBUG});
+  my $curpos = $self->tell();
+  my $newpos = _newpos($self->tell(),$self->{size},$pos,$whence);
+  my $ret;
+  if ($newpos == $curpos)
+  {
+    return $curpos;
+  }
+  elsif (defined($self->{_buf}) and ($newpos > $curpos) and ($newpos < ($curpos + length($self->{_buf}))))
+  {
+    # Just seeking within the buffer (or not at all)
+    substr($self->{_buf},0,$newpos - $curpos,'');
+    $ret = $newpos;
+  }
+  else
+  {
+    $ret = $self->sysseek($newpos,0);
+    $self->{_buf} = '';
+  }
+  return $ret;
+}
+
+sub _newpos
+{
+  
+  my($curpos,$size,$pos,$whence)=@_;
+  if ($whence == 0) # seek_set
+  {
+    return $pos;
+  }
+  elsif ($whence == 1) # seek_cur
+  {
+    return $curpos + $pos;
+  }
+  elsif ($whence == 2) # seek_end
+  {
+    return $size + $pos;
+  }
+  else
+  {
+    die "Invalid value $whence for whence!";
+  }
+}
+
+sub sysseek
+{
+  my $self = shift;
+  my $pos = shift || 0;
+  my $whence = shift || 0;
+  warn "SYSSEEK: self=$self, pos=$pos, whence=$whence\n"
+    if ($ENV{DEBUG});
+  my $newpos = _newpos($self->{nextpos},$self->{size},$pos,$whence);
+
+  $self->{eof}=undef;
+  return $self->{nextpos}=$newpos;
+}
+
+sub tell
+{
+  my $self = shift;
+  return $self->{nextpos} - (defined($self->{_buf}) ? length($self->{_buf}) : 0);
+}
+
+# WARNING: ASCII mode probably breaks seek.
+sub binmode
+{
+  my $self = shift;
+  my $mode = shift || ':raw';
+  return if (defined($self->{curmode}) && ($self->{curmode} eq $mode));
+  if (defined($mode) and $mode eq ':crlf')
+  {
+    $self->_finish_connection();
+    $self->{ftp}->ascii()
+      or return $self->seterr();
+  }
+  else
+  {
+    $self->_finish_connection();
+    $self->{ftp}->binary()
+      or return $self->seterr();
+  }
+  $self->{curmode} = $mode;
+}
+
+sub _min
+{
+  return $_[0] < $_[1] ? $_[0] : $_[1];
+}
+
+sub _max
+{
+  return $_[0] > $_[1] ? $_[0] : $_[1];
+}
+
+sub read
+{
+  my $self = shift;
+#  return $self->sysread(@_);
+  
+  my(undef,$len,$offset)=@_;
+  $offset ||= 0;
+  warn "READ(buf,$len,$offset)\n"
+    if ($ENV{DEBUG});
+  
+  if (!defined($self->{_buf}) || length($self->{_buf}) <= 0)
+  {
+    $self->sysread($self->{_buf},_max($len,$self->{BlockSize}))
+      or return 0;
+  }
+  elsif (length($self->{_buf}) < $len)
+  {
+    $self->sysread($self->{_buf},_max($len-length($self->{_buf}),$self->{BlockSize}),length($self->{_buf}));
+  }
+  my $ret = _min($len,length($self->{_buf}));
+  if (!defined($_[0])) { $_[0] = '' }
+  substr($_[0],$offset) = substr($self->{_buf},0,$len,'');
+  $self->{read_count}++;
+
+  return $ret;
+}
+
+sub sysread
+{
+  my $self = shift;
+  if ($self->{eof})
+  {
+    return 0;
+  }
+  
+  my(undef,$len,$offset) = @_;
+  $offset ||= 0;
+
+  warn "SYSREAD(buf,$len,$offset)\n"
+    if ($ENV{DEBUG});
+  if ($self->{nextpos} >= $self->{size})
+  {
+    $self->{eof} = 1;
+    $self->{pos} = $self->{nextpos};
+    return 0;
+  }
+
+  if ($self->{pos} != $self->{nextpos})
+  {
+    # They seeked.
+    if ($self->{ftp_running})
+    {
+      warn "Seek detected, nextpos=$self->{nextpos}, pos=$self->{pos}, MaxSkipSize=$self->{MaxSkipSize}\n"
+       if ($ENV{DEBUG});
+      if ($self->{nextpos} > $self->{pos} and ($self->{nextpos} - $self->{pos}) < $self->{MaxSkipSize})
+      {
+       my $br = $self->{nextpos}-$self->{pos};
+       warn "Reading $br bytes to skip ahead\n"
+         if ($ENV{DEBUG});
+       my $junkbuff;
+       while ($br > 0)
+       {
+         warn "Trying to read $br more bytes\n"
+           if ($ENV{DEBUG});
+         my $b = $self->{ftp_data}->read($junkbuff,$br);
+         if ($b == 0)
+         {
+           $self->_at_eof();
+           return 0;
+         }
+         elsif (!defined($b) || $b < 0)
+         {
+           return $self->seterr();
+         }
+         else
+         {
+           $br -= $b;
+         }
+       }
+       $self->{pos}=$self->{nextpos};
+      }
+      else
+      {
+       warn "Aborting connection to move to new position\n"
+         if ($ENV{DEBUG});
+       $self->_finish_connection();
+      }
+    }
+  }
+
+  if (!$self->{ftp_running})
+  {
+    $self->{ftp}->restart($self->{nextpos});
+    $self->{ftp_data} = $self->{ftp}->retr($self->{filename})
+      or return $self->seterr();
+    $self->{ftp_running} = 1;
+    $self->{pos}=$self->{nextpos};
+  }
+
+  my $tmpbuf;
+  my $rb = $self->{ftp_data}->read($tmpbuf,$len);
+  if ($rb == 0)
+  {
+    $self->_at_eof();
+    return 0;
+  }
+  elsif (!defined($rb) || $rb < 0)
+  {
+    return $self->seterr();
+  }
+
+  if (!defined($_[0])) { $_[0] = '' }
+  substr($_[0],$offset) = $tmpbuf;
+  $self->{pos} += $rb;
+  $self->{nextpos} += $rb;
+
+  $self->{sysread_count}++;
+  $rb;
+}
+
+sub _at_eof
+{
+  my $self = shift;
+  $self->{eof}=1;
+  $self->_finish_connection();
+#  $self->{ftp_data}->_close();
+  $self->{ftp_running} = $self->{ftp_data} = undef;
+}
+  
+sub _finish_connection
+{
+  my $self = shift;
+  warn "_finish_connection\n"
+    if ($ENV{DEBUG});
+  return unless ($self->{ftp_running});
+  
+  if ($self->{size} - $self->{pos} < $self->{MaxSkipSize})
+  {
+    warn "Skipping " . ($self->{size}-$self->{pos}) . " bytes\n"
+      if ($ENV{DEBUG});
+    my $junkbuff;
+    my $br;
+    while(($br = $self->{ftp_data}->read($junkbuff,8192)))
+    {
+      # Read until EOF or error
+    }
+    defined($br)
+      or $self->seterr();
+  }
+  warn "Shutting down existing FTP DATA session...\n"
+    if ($ENV{DEBUG});
+
+  my $closeret;
+  {
+    eval {
+      $closeret = $self->{ftp_data}->close();
+    };
+    # Work around a timeout bug in Net::FTP
+    if ($@ && $@ =~ /^Timeout /)
+    {
+      warn "Timeout closing connection, retrying...\n"
+       if ($ENV{DEBUG});
+      select(undef,undef,undef,1);
+      redo;
+    }
+  }
+
+  $self->{ftp_running} = $self->{ftp_data} = undef;
+  return $closeret ? 1 : $self->seterr();
+}
+
+sub write
+{
+  die "Only reading currently supported";
+}
+
+sub close
+{
+  my $self = shift;
+  return $self->{ftp_data} ? $self->_finish_connection()
+                           : 1;
+}
+
+sub eof
+{
+  my $self = shift;
+  if ($self->{eof})
+  {
+    return 1;
+  }
+
+  my $c = $self->getc;
+  if (!defined($c))
+  {
+    return 1;
+  }
+  $self->ungetc(ord($c));
+  return undef;
+}
+
+sub getc
+{
+  my $self = shift;
+  my $c;
+  my $rb = $self->read($c,1);
+  if ($rb < 1)
+  {
+    return undef;
+  }
+  return $c;
+}
+
+sub ungetc
+{
+  my $self = shift;
+  # Note that $c is the ordinal value of a character, not the
+  # character itself (for some reason)
+  my($c)=@_;
+  $self->{_buf} = chr($c) . $self->{_buf};
+}
+
+sub getline
+{
+  my $self = shift;
+  if (!defined($/))
+  {
+    my $buf;
+    while($self->read($buf,$self->{BlockSize},length($buf)) > 0)
+    {
+      # Keep going
+    }
+    return $buf;
+  }
+  elsif (ref($/) && looks_like_number ${$/} )
+  {
+    my $buf;
+    $self->read($buf,${$/})
+      or return undef;
+    return $buf;
+  }
+
+  my $rs;
+  if ($/ eq '')
+  {
+    $rs = "\n\n";
+  }
+  else
+  {
+    $rs = $/;
+  }
+  my $eol;
+  if (!defined($self->{_buf})) { $self->{_buf} = '' }
+  while (($eol=index($self->{_buf},$rs)) < $[)
+  {
+    if ($self->{eof})
+    {
+      # return what's left
+      if (length($self->{_buf}) == 0)
+      {
+       return undef;
+      }
+      else
+      {
+       return substr($self->{_buf},0,length($self->{_buf}),'');
+      }
+    }
+    else
+    {
+      $self->sysread($self->{_buf},$self->{BlockSize},length($self->{_buf}));
+    }
+  }
+  # OK, we should have a match.
+  my $tmpbuf = substr($self->{_buf},0,$eol+length($rs),'');
+  while ($/ eq '' and substr($self->{_buf},0,1) eq "\n")
+  {
+    substr($self->{_buf},0,1)='';
+  }
+  return $tmpbuf;
+}
+
+sub getlines
+{
+  my $self = shift;
+  my @lines;
+  my $line;
+  while (defined($line = $self->getline()))
+  {
+    push(@lines,$line);
+  }
+  @lines;
+}
+
+sub error
+{
+  return undef;
+}
+
+sub seterr
+{
+  my $self = shift;
+  $self->{_error} = 1;
+  return undef;
+}
+
+sub clearerr
+{
+  my $self = shift;
+  $self->{_error} = undef;
+  return 0;
+}
+
+sub getpos
+{
+  my $self = shift;
+  return $self->tell();
+}
+
+sub setpos
+{
+  my $self = shift;
+  return $self->seek(@_);
+}
+
+sub DESTROY
+{
+  my $self = shift;
+  if (UNIVERSAL::isa($self,'GLOB'))
+  {
+    $self = tied *$self
+       or die "$self not tied?...";
+  }
+  if ($self->{ftp_data})
+  {
+    $self->_finish_connection();
+  }
+  warn "sysread called ".$self->{sysread_count}." times.\n"
+    if ($ENV{DEBUG});
+}
+
+=head1 TIED INTERFACE
+
+Instead of a L<IO::Handle|IO::Handle>-compatible interface, you can
+use a C<tie>-based interface to use the standard Perl I/O operators.
+You can use it like this:
+
+  use Net::FTP::RetrHandle;
+  # Create FTP object in $ftp
+  # Store filename in $filename
+  tie *FH, 'Net::FTP::RetrHandle', $ftp, $filename
+    or die "Error in tie!\n";
+
+=cut
+  ;
+sub TIEHANDLE
+{
+  my $class = shift;
+  my $obj = $class->new(@_);
+  $obj;
+}
+
+sub READ
+{
+  my $self = shift;
+  $self->read(@_);
+}
+
+sub READLINE
+{
+  my $self = shift;
+  return wantarray ? $self->getlines(@_)
+                   : $self->getline(@_);
+}
+
+sub GETC
+{
+  my $self = shift;
+  return $self->getc(@_);
+}
+
+sub SEEK
+{
+  my $self = shift;
+  return $self->seek(@_);
+}
+
+sub SYSSEEK
+{
+  my $self = shift;
+  return $self->sysseek(@_);
+}
+
+sub TELL
+{
+  my $self = shift;
+  return $self->tell();
+}
+
+sub CLOSE
+{
+  my $self = shift;
+  return $self->close(@_);
+}
+
+sub EOF
+{
+  my $self = shift;
+  return $self->eof(@_);
+
+}
+sub UNTIE
+{
+  tied($_[0])->close(@_);
+}
+
+=head1 EXAMPLE
+
+Here's an example of listing a Zip file without downloading the whole
+thing:
+
+    #!/usr/bin/perl
+    
+    use warnings;
+    use strict;
+    
+    use Net::FTP;
+    use Net::FTP::AutoReconnect;
+    use Net::FTP::RetrHandle;
+    use Archive::Zip;
+    
+    my $ftp = Net::FTP::AutoReconnect->new("ftp.info-zip.com", Debug => $ENV{DEBUG}) 
+        or die "connect error\n";
+    $ftp->login('anonymous','example@example.com')
+        or die "login error\n";
+    $ftp->cwd('/pub/infozip/UNIX/LINUX')
+        or die "cwd error\n";
+    my $fh = Net::FTP::RetrHandle->new($ftp,'unz551x-glibc.zip')
+        or die "Couldn't get handle to remote file\n";
+    my $zip = Archive::Zip->new($fh)
+        or die "Couldn't create Zip object\n";
+    foreach my $fn ($zip->memberNames())
+    {
+      print "unz551-glibc.zip: $fn\n";
+    }
+
+
+=head1 AUTHOR
+
+Scott Gifford <sgifford@suspectclass.com>
+
+=head1 BUGS
+
+The distinction between tied filehandles and C<IO::Handle>-compatible
+filehandles should be blurrier.  It seems like other file handle
+objects you can freely mix method calls and traditional Perl
+operations, but I can't figure out how to do it.
+
+Many FTP servers don't like frequent connection aborts.  If that's the
+case, try L<Net::FTP::AutoReconnect>, which will hide much of that
+from you.
+
+If the filehandle is tied and created with C<gensym>, C<readline>
+doesn't work with older versions of Perl.  No idea why.
+
+=head1 SEE ALSO
+
+L<Net::FTP>, L<Net::FTP::AutoReconnect>, L<IO::Handle>.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2006 Scott Gifford. All rights reserved.  This program
+is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself.
+
+=cut
+
+1;
index c247b84..28071a2 100755 (executable)
--- a/makeDist
+++ b/makeDist
@@ -1,4 +1,4 @@
-#!/bin/perl
+#!/usr/bin/env perl
 #
 # makeDist: Build a BackupPC distribution
 #
 #
 # makeDist: Build a BackupPC distribution
 #
@@ -53,8 +53,8 @@ die("BackupPC::Lib->new failed\n")
 
 umask(0022);
 
 
 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(
 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/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/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/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/BackupPC/Zip/FileMember.pm
+    lib/Net/FTP/AutoReconnect.pm
+    lib/Net/FTP/RetrHandle.pm
     cgi-bin/BackupPC_Admin
 );
 
     cgi-bin/BackupPC_Admin
 );
 
@@ -169,7 +174,11 @@ $ConfVars->{BlackoutHourEnd}   = 2;
 $ConfVars->{BlackoutWeekDays}  = 2;
 $ConfVars->{RsyncLogLevel}     = 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 ) {
 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} ) {
     $errCnt += CheckConfigParams($file, $ConfVars, 1);
 }
 if ( !$opts{l} ) {
@@ -195,13 +204,14 @@ if ( $errCnt ) {
 rmtree($DistDir, 0, 0);
 mkpath($DistDir, 0, 0777);
 
 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/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);
 }
                ) ) {
     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
                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
                doc/BackupPC.pod
                doc/BackupPC.html
                README
index a7681f5..132206d 100755 (executable)
--- a/makePatch
+++ b/makePatch
@@ -8,8 +8,8 @@ use strict;
 use File::Find;
 use File::Path;
 
 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";
 my $PatchVersion = "$BaseVersion$PatchLevel";
 
 my $Base         = "/home/craig/admin/packages/BackupPC-$BaseVersion";