is a high-performance, enterprise-grade system for backing up Linux and WinXX PCs and laptops to a server’s disk (http/cgi user interface).
| Protocol.pm (BackupPC-4.3.2) | : | Protocol.pm (BackupPC-4.4.0) |
|---|
| | |
| skipping to change at line 31 | | skipping to change at line 31 |
|---|
| # This program is distributed in the hope that it will be useful, | | # This program is distributed in the hope that it will be useful, |
| # but WITHOUT ANY WARRANTY; without even the implied warranty of | | # but WITHOUT ANY WARRANTY; without even the implied warranty of |
| # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| # GNU General Public License for more details. | | # GNU General Public License for more details. |
| # | | # |
| # You should have received a copy of the GNU General Public License | | # You should have received a copy of the GNU General Public License |
| # along with this program. If not, see <http://www.gnu.org/licenses/>. | | # along with this program. If not, see <http://www.gnu.org/licenses/>. |
| # | | # |
| #======================================================================== | | #======================================================================== |
| # | | # |
|
| # Version 4.3.2, released 17 Feb 2020. | | # Version 4.4.0, released 20 Jun 2020. |
| # | | # |
| # See http://backuppc.sourceforge.net. | | # See http://backuppc.sourceforge.net. |
| # | | # |
| #======================================================================== | | #======================================================================== |
| | |
| package BackupPC::Xfer::Protocol; | | package BackupPC::Xfer::Protocol; |
| | |
| use strict; | | use strict; |
| use Data::Dumper; | | use Data::Dumper; |
| use Encode qw/from_to encode/; | | use Encode qw/from_to encode/; |
| | |
| skipping to change at line 111 | | skipping to change at line 111 |
|---|
| # usage: | | # usage: |
| # $t->start(); | | # $t->start(); |
| # | | # |
| # start() executes the actual data transfer. Must be implemented by | | # start() executes the actual data transfer. Must be implemented by |
| # the derived class. | | # the derived class. |
| # | | # |
| sub start | | sub start |
| { | | { |
| my($t) = @_; | | my($t) = @_; |
| | |
|
| $t->{_errStr} = "start() not implemented by ".ref($t); | | $t->{_errStr} = "start() not implemented by " . ref($t); |
| return; | | return; |
| } | | } |
| | |
| # | | # |
| # | | # |
| # | | # |
| sub run | | sub run |
| { | | { |
| my($t) = @_; | | my($t) = @_; |
| | |
|
| $t->{_errStr} = "run() not implemented by ".ref($t); | | $t->{_errStr} = "run() not implemented by " . ref($t); |
| return; | | return; |
| } | | } |
| | |
| # | | # |
| # usage: | | # usage: |
| # $t->readOutput(); | | # $t->readOutput(); |
| # | | # |
| # This function is only used when $t->useTar() == 1. | | # This function is only used when $t->useTar() == 1. |
| # | | # |
| sub readOutput | | sub readOutput |
| | |
| skipping to change at line 201 | | skipping to change at line 201 |
|---|
| | |
| return ($t->{xferPid}); | | return ($t->{xferPid}); |
| } | | } |
| | |
| # | | # |
| # usage: | | # usage: |
| # $t->logMsg($msg); | | # $t->logMsg($msg); |
| # | | # |
| sub logMsg | | sub logMsg |
| { | | { |
|
| my ($t, $msg) = @_; | | my($t, $msg) = @_; |
| | |
| push(@{$t->{_logMsg}}, $msg); | | push(@{$t->{_logMsg}}, $msg); |
| } | | } |
| | |
| # | | # |
| # usage: | | # usage: |
| # $t->logMsgGet(); | | # $t->logMsgGet(); |
| # | | # |
| sub logMsgGet | | sub logMsgGet |
| { | | { |
| | |
| skipping to change at line 226 | | skipping to change at line 226 |
|---|
| | |
| # | | # |
| # usage: | | # usage: |
| # $t->getStats(); | | # $t->getStats(); |
| # | | # |
| # This function returns xfer statistics. It Returns a hash ref giving | | # This function returns xfer statistics. It Returns a hash ref giving |
| # various status information about the transfer. | | # various status information about the transfer. |
| # | | # |
| sub getStats | | sub getStats |
| { | | { |
|
| my ($t) = @_; | | my($t) = @_; |
| | |
| return { | | return { |
| map { $_ => $t->{$_} } | | map { $_ => $t->{$_} } |
| qw(byteCnt fileCnt xferErrCnt xferBadShareCnt xferBadFileCnt | | qw(byteCnt fileCnt xferErrCnt xferBadShareCnt xferBadFileCnt |
|
| xferOK hostAbort hostError lastOutputLine) | | xferOK hostAbort hostError lastOutputLine) |
| }; | | }; |
| } | | } |
| | |
| sub getBadFiles | | sub getBadFiles |
| { | | { |
|
| my ($t) = @_; | | my($t) = @_; |
| | |
| return @{$t->{badFiles}}; | | return @{$t->{badFiles}}; |
| } | | } |
| | |
| # | | # |
| # useTar function. In order to work correctly, the protocol in | | # useTar function. In order to work correctly, the protocol in |
| # question should overwrite the function if it needs to return true. | | # question should overwrite the function if it needs to return true. |
| # | | # |
| sub useTar | | sub useTar |
| { | | { |
| | |
| skipping to change at line 268 | | skipping to change at line 268 |
|---|
| # | | # |
| # This function writes to XferLOG. | | # This function writes to XferLOG. |
| # | | # |
| sub logWrite | | sub logWrite |
| { | | { |
| my($t, $msg, $level) = @_; | | my($t, $msg, $level) = @_; |
| | |
| my $XferLOG = $t->{XferLOG}; | | my $XferLOG = $t->{XferLOG}; |
| $level = 3 if ( !defined($level) ); | | $level = 3 if ( !defined($level) ); |
| | |
|
| return ( $XferLOG->write(\$msg) ) if ( $level <= $t->{logLevel} ); | | return ($XferLOG->write(\$msg)) if ( $level <= $t->{logLevel} ); |
| } | | } |
| | |
| ############################################################################## | | ############################################################################## |
| # Share name mapping | | # Share name mapping |
| ############################################################################## | | ############################################################################## |
| # | | # |
| # shareName2Path() maps the share name to the actual client path using | | # shareName2Path() maps the share name to the actual client path using |
| # the optional $Conf{ClientShareName2Path} setting. | | # the optional $Conf{ClientShareName2Path} setting. |
| # | | # |
| sub shareName2Path | | sub shareName2Path |
| { | | { |
| my($t, $shareName) = @_; | | my($t, $shareName) = @_; |
| | |
|
| return $shareName if ( ref($t->{conf}{ClientShareName2Path}) ne "HASH" | | return $shareName |
| || ($t->{conf}{ClientShareName2Path}{$shareName} eq "" | | if ( ref($t->{conf}{ClientShareName2Path}) ne "HASH" |
| && $t->{conf}{ClientShareName2Path}{"*"} eq "") ); | | || ($t->{conf}{ClientShareName2Path}{$shareName} eq "" && $t->{conf}{Cli |
| | entShareName2Path}{"*"} eq "") ); |
| return $t->{conf}{ClientShareName2Path}{$shareName} if ( $t->{conf}{ClientSh
areName2Path}{$shareName} ne "" ); | | return $t->{conf}{ClientShareName2Path}{$shareName} if ( $t->{conf}{ClientSh
areName2Path}{$shareName} ne "" ); |
| return $t->{conf}{ClientShareName2Path}{"*"} if ( $t->{conf}{ClientSh
areName2Path}{"*"} ne "" ); | | return $t->{conf}{ClientShareName2Path}{"*"} if ( $t->{conf}{ClientSh
areName2Path}{"*"} ne "" ); |
| return $shareName; | | return $shareName; |
| } | | } |
| | |
| ############################################################################## | | ############################################################################## |
| # File Inclusion/Exclusion | | # File Inclusion/Exclusion |
| ############################################################################## | | ############################################################################## |
| | |
| # | | # |
| # loadInclExclRegexps() places the appropriate file include/exclude regexps | | # loadInclExclRegexps() places the appropriate file include/exclude regexps |
| # | | # |
| sub loadInclExclRegexps | | sub loadInclExclRegexps |
| { | | { |
|
| my ( $t, $shareType ) = @_; | | my($t, $shareType) = @_; |
| my $bpc = $t->{bpc}; | | my $bpc = $t->{bpc}; |
| my $conf = $t->{conf}; | | my $conf = $t->{conf}; |
| | |
| my @BackupFilesOnly = (); | | my @BackupFilesOnly = (); |
| my @BackupFilesExclude = (); | | my @BackupFilesExclude = (); |
|
| my ($shareName, $shareNameRE); | | my($shareName, $shareNameRE); |
| | |
| $shareName = $t->{shareName}; | | $shareName = $t->{shareName}; |
| $shareName =~ s/\/*$//; # remove trailing slashes | | $shareName =~ s/\/*$//; # remove trailing slashes |
| $shareName = "/" if ( $shareName eq "" ); | | $shareName = "/" if ( $shareName eq "" ); |
| | |
| $t->{shareName} = $shareName; | | $t->{shareName} = $shareName; |
| $t->{shareNameRE} = $bpc->glob2re($shareName); | | $t->{shareNameRE} = $bpc->glob2re($shareName); |
| | |
| # | | # |
| # load all relevant values into @BackupFilesOnly | | # load all relevant values into @BackupFilesOnly |
| # | | # |
|
| if ( ref( $conf->{BackupFilesOnly} ) eq "HASH" ) { | | if ( ref($conf->{BackupFilesOnly}) eq "HASH" ) { |
| | |
|
| foreach my $share ( ( '*', $shareName ) ) { | | foreach my $share ( ('*', $shareName) ) { |
| push @BackupFilesOnly, @{ $conf->{BackupFilesOnly}{$share} } | | push @BackupFilesOnly, @{$conf->{BackupFilesOnly}{$share}} |
| if ( defined( $conf->{BackupFilesOnly}{$share} ) ); | | if ( defined($conf->{BackupFilesOnly}{$share}) ); |
| } | | } |
| | |
|
| } elsif ( ref( $conf->{BackupFilesOnly} ) eq "ARRAY" ) { | | } elsif ( ref($conf->{BackupFilesOnly}) eq "ARRAY" ) { |
| | |
|
| push( @BackupFilesOnly, @{ $conf->{BackupFilesOnly} } ); | | push(@BackupFilesOnly, @{$conf->{BackupFilesOnly}}); |
| | |
|
| } elsif ( !defined( $conf->{BackupFilesOnly} ) ) { | | } elsif ( !defined($conf->{BackupFilesOnly}) ) { |
| | |
| # | | # |
| # do nothing | | # do nothing |
| # | | # |
| | |
| } else { | | } else { |
| | |
| # | | # |
| # not a legitimate entry for $conf->{BackupFilesOnly} | | # not a legitimate entry for $conf->{BackupFilesOnly} |
| # | | # |
| $t->{_errStr} = "Incorrect syntax in BackupFilesOnly for host $t->{Host}
"; | | $t->{_errStr} = "Incorrect syntax in BackupFilesOnly for host $t->{Host}
"; |
| | |
| return; | | return; |
| } | | } |
| | |
| # | | # |
| # load all relevant values into @BackupFilesExclude | | # load all relevant values into @BackupFilesExclude |
| # | | # |
|
| if ( ref( $conf->{BackupFilesExclude} ) eq "HASH" ) { | | if ( ref($conf->{BackupFilesExclude}) eq "HASH" ) { |
| | |
|
| foreach my $share ( ( '*', $shareName ) ) { | | foreach my $share ( ('*', $shareName) ) { |
| push( @BackupFilesExclude, | | push( |
| | @BackupFilesExclude, |
| map { | | map { |
|
| ( $_ =~ /^\// ) | | ($_ =~ /^\//) |
| ? ( $t->{shareNameRE} . $bpc->glob2re($_) ) | | ? ($t->{shareNameRE} . $bpc->glob2re($_)) |
| : ( '.*\/' . $bpc->glob2re($_) . '(?=\/.*)?' ) | | : ('.*\/' . $bpc->glob2re($_) . '(?=\/.*)?') |
| } @{ $conf->{BackupFilesExclude}{$share} } | | } @{$conf->{BackupFilesExclude}{$share}} |
| ) if ( defined( $conf->{BackupFilesExclude}{$share} ) ) ; | | ) if ( defined($conf->{BackupFilesExclude}{$share}) ); |
| } | | } |
| | |
|
| } elsif ( ref( $conf->{BackupFilesExclude} ) eq "ARRAY" ) { | | } elsif ( ref($conf->{BackupFilesExclude}) eq "ARRAY" ) { |
| | |
|
| push( @BackupFilesExclude, | | push(@BackupFilesExclude, |
| map { | | map { ($_ =~ /\//) ? ($bpc->glob2re($_)) : ('.*\/' . $bpc->glob2re($ |
| ( $_ =~ /\// ) | | _) . '(?<=\/.*)?') } |
| ? ( $bpc->glob2re($_) ) | | @{$conf->{BackupFilesExclude}}); |
| : ( '.*\/' . $bpc->glob2re($_) . '(?<=\/.*)?' ) | | |
| } @{ $conf->{BackupFilesExclude} } ); | | |
| | |
|
| } elsif ( !defined( $conf->{BackupFilesOnly} ) ) { | | } elsif ( !defined($conf->{BackupFilesOnly}) ) { |
| | |
| # | | # |
| # do nothing here | | # do nothing here |
| # | | # |
| | |
| } else { | | } else { |
| | |
| # | | # |
| # not a legitimate entry for $conf->{BackupFilesExclude} | | # not a legitimate entry for $conf->{BackupFilesExclude} |
| # | | # |
|
| $t->{_errStr} = | | $t->{_errStr} = "Incorrect syntax in BackupFilesExclude for host $t->{Ho |
| "Incorrect syntax in BackupFilesExclude for host $t->{Host}"; | | st}"; |
| return; | | return; |
| } | | } |
| | |
| # | | # |
| # load the regular expressions into the xfer object | | # load the regular expressions into the xfer object |
| # | | # |
|
| $t->{BackupFilesOnly} = ( @BackupFilesOnly > 0 ) ? \@BackupFilesOnly : undef | | $t->{BackupFilesOnly} = (@BackupFilesOnly > 0) ? \@BackupFilesOnly |
| ; | | : undef; |
| $t->{BackupFilesExclude} = ( @BackupFilesExclude > 0 ) ? \@BackupFilesExclud | | $t->{BackupFilesExclude} = (@BackupFilesExclude > 0) ? \@BackupFilesExclude |
| e : undef; | | : undef; |
| | |
| return 1; | | return 1; |
| } | | } |
| | |
| sub checkIncludeExclude | | sub checkIncludeExclude |
| { | | { |
|
| my ($t, $file) = @_; | | my($t, $file) = @_; |
| | |
|
| return ( $t->checkIncludeMatch($file) && !$t->checkExcludeMatch($file) ); | | return ($t->checkIncludeMatch($file) && !$t->checkExcludeMatch($file)); |
| } | | } |
| | |
| sub checkIncludeMatch | | sub checkIncludeMatch |
| { | | { |
|
| my ($t, $file) = @_; | | my($t, $file) = @_; |
| | |
| my $shareName = $t->{shareName}; | | my $shareName = $t->{shareName}; |
| my $includes = $t->{BackupFilesOnly} || return 1; | | my $includes = $t->{BackupFilesOnly} || return 1; |
|
| my $match = ""; | | my $match = ""; |
| | |
| foreach my $include ( @{$includes} ) { | | foreach my $include ( @{$includes} ) { |
| | |
| # | | # |
| # construct regexp elsewhere to avoid syntactical evil | | # construct regexp elsewhere to avoid syntactical evil |
| # | | # |
|
| $match = '^' . quotemeta( $shareName . $include ) . '(?=\/.*)?'; | | $match = '^' . quotemeta($shareName . $include) . '(?=\/.*)?'; |
| | |
|
| # | | # |
| # return true if the include folder is a parent of the file, | | # return true if the include folder is a parent of the file, |
| # or the folder itself. | | # or the folder itself. |
|
| # | | # |
| return 1 if ( $file =~ /$match/ ); | | return 1 if ( $file =~ /$match/ ); |
| | |
| $match = '^' . quotemeta($file) . '(?=\/.*)?'; | | $match = '^' . quotemeta($file) . '(?=\/.*)?'; |
| | |
|
| # | | # |
| # return true if the file is a parent of the include folder, | | # return true if the file is a parent of the include folder, |
| # or the folder itself. | | # or the folder itself. |
|
| # | | # |
| return 1 if ( "$shareName$include" =~ /$match/ ); | | return 1 if ( "$shareName$include" =~ /$match/ ); |
| } | | } |
| return 0; | | return 0; |
| } | | } |
| | |
| sub checkExcludeMatch | | sub checkExcludeMatch |
| { | | { |
|
| my ($t, $file) = @_; | | my($t, $file) = @_; |
| | |
| my $shareName = $t->{shareName}; | | my $shareName = $t->{shareName}; |
| my $excludes = $t->{BackupFilesExclude} || return 0; | | my $excludes = $t->{BackupFilesExclude} || return 0; |
|
| my $match = ""; | | my $match = ""; |
| | |
| foreach my $exclude ( @{$excludes} ) { | | foreach my $exclude ( @{$excludes} ) { |
| | |
| # | | # |
| # construct regexp elsewhere to avoid syntactical evil | | # construct regexp elsewhere to avoid syntactical evil |
| # | | # |
|
| $match = '^' . quotemeta( $shareName . $exclude ) . '(?=\/.*)?'; | | $match = '^' . quotemeta($shareName . $exclude) . '(?=\/.*)?'; |
| | |
|
| # | | # |
| # return true if the exclude folder is a parent of the file, | | # return true if the exclude folder is a parent of the file, |
| # or the folder itself. | | # or the folder itself. |
|
| # | | # |
| return 1 if ( $file =~ /$match/ ); | | return 1 if ( $file =~ /$match/ ); |
| | |
| $match = '^' . quotemeta($file) . '(?=\/.*)?'; | | $match = '^' . quotemeta($file) . '(?=\/.*)?'; |
| | |
|
| # | | # |
| # return true if the file is a parent of the exclude folder, | | # return true if the file is a parent of the exclude folder, |
| # or the folder itself. | | # or the folder itself. |
|
| # | | # |
| return 1 if ( "$shareName$exclude" =~ /$match/ ); | | return 1 if ( "$shareName$exclude" =~ /$match/ ); |
| } | | } |
| return 0; | | return 0; |
| } | | } |
| | |
| 1; | | 1; |
| | | |
| End of changes. 40 change blocks. |
|---|
| 58 lines changed or deleted | | 58 lines changed or added |
|---|
"Fossies" - the Fresh Open Source Software Archive 