lib/BackupPC/Xfer/Protocol.pm

   1 #============================================================= -*-perl-*-
   2 #
   3 # BackupPC::Xfer::Protocol package
   4 #
   5 # DESCRIPTION
   6 #
   7 #   This library defines a BackupPC::Xfer::Protocol class which
   8 #   defines standard methods for the transfer protocols in BackupPC.
   9 #
  10 # AUTHOR
  11 #   Paul Mantz    <pcmantz@zmanda.com>
  12 #
  13 # COPYRIGHT
  14 #   Copyright (C) 2001-2009  Craig Barratt
  15 #
  16 #   This program is free software; you can redistribute it and/or modify
  17 #   it under the terms of the GNU General Public License as published by
  18 #   the Free Software Foundation; either version 2 of the License, or
  19 #   (at your option) any later version.
  20 #
  21 #   This program is distributed in the hope that it will be useful,
  22 #   but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 #   GNU General Public License for more details.
  25 #
  26 #   You should have received a copy of the GNU General Public License
  27 #   along with this program; if not, write to the Free Software
  28 #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  29 #
  30 #========================================================================
  31 #
  32 # Version 3.2.0, released 31 Jul 2010.
  33 #
  34 # See http://backuppc.sourceforge.net.
  35 #
  36 #========================================================================
  37
  38 package BackupPC::Xfer::Protocol;
  39
  40 use strict;
  41 use Data::Dumper;
  42 use Encode qw/from_to encode/;
  43
  44 use BackupPC::Attrib qw(:all);
  45
  46 #
  47 #  usage:
  48 #    $t = BackupPC::Xfer::Protocol->new($args);
  49 #
  50 # new() is the constructor.  There's nothing special going on here.
  51 #
  52 sub new
  53 {
  54     my($class, $bpc, $args) = @_;
  55
  56     $args ||= {};
  57     my $t = bless {
  58         bpc       => $bpc,
  59         conf      => $bpc->{Conf},
  60         host      => "",
  61         hostIP    => "",
  62         shareName => "",
  63         pipeRH    => undef,
  64         pipeWH    => undef,
  65         badFiles  => [],
  66         logLevel  => $bpc->{Conf}{XferLogLevel},
  67
  68         #
  69         # Various stats
  70         #
  71         byteCnt         => 0,
  72         fileCnt         => 0,
  73         xferErrCnt      => 0,
  74         xferBadShareCnt => 0,
  75         xferBadFileCnt  => 0,
  76         xferOK          => 0,
  77
  78         #
  79         # User's args
  80         #
  81         %$args,
  82     }, $class;
  83
  84     return $t;
  85 }
  86
  87 #
  88 #  usage:
  89 #    $t->args($args);
  90 #
  91 # args() can be used to send additional argument to the Xfer object
  92 # via a hash reference.
  93 #
  94 sub args
  95 {
  96     my($t, $args) = @_;
  97
  98     foreach my $arg ( keys(%$args) ) {
  99         $t->{$arg} = $args->{$arg};
 100     }
 101 }
 102
 103 #
 104 #  usage:
 105 #    $t->start();
 106 #
 107 # start() executes the actual data transfer.  Must be implemented by
 108 # the derived class.
 109 #
 110 sub start
 111 {
 112     my($t) = @_;
 113
 114     $t->{_errStr} = "start() not implemented by ".ref($t);
 115     return;
 116 }
 117
 118 #
 119 #
 120 #
 121 sub run
 122 {
 123     my($t) = @_;
 124
 125     $t->{_errStr} = "run() not implemented by ".ref($t);
 126     return;
 127 }
 128
 129 #
 130 #  usage:
 131 #    $t->readOutput();
 132 #
 133 # This function is only used when $t->useTar() == 1.
 134 #
 135 sub readOutput
 136 {
 137     my($t) = @_;
 138
 139     $t->{_errStr} = "readOutput() not implemented by " . ref($t);
 140     return;
 141 }
 142
 143 #
 144 #  usage:
 145 #    $t->abort($reason);
 146 #
 147 # Aborts the current job.
 148 #
 149 sub abort
 150 {
 151     my($t, $reason) = @_;
 152     my @xferPid = $t->xferPid;
 153
 154     $t->{abort}       = 1;
 155     $t->{abortReason} = $reason;
 156     if ( @xferPid ) {
 157         kill($t->{bpc}->sigName2num("INT"), @xferPid);
 158     }
 159 }
 160
 161 #
 162 #  usage:
 163 #    $t->subSelectMask
 164 #
 165 # This function sets a mask for files when ($t->useTar == 1).
 166 #
 167 sub setSelectMask
 168 {
 169     my($t) = @_;
 170
 171     $t->{_errStr} = "readOutput() not implemented by " . ref($t);
 172 }
 173
 174 #
 175 #  usage:
 176 #    $t->errStr();
 177 #
 178 sub errStr
 179 {
 180     my($t) = @_;
 181
 182     return $t->{_errStr};
 183 }
 184
 185 #
 186 #  usage:
 187 #   $pid = $t->xferPid();
 188 #
 189 # xferPid() returns the process id of the child forked process.
 190 #
 191 sub xferPid
 192 {
 193     my($t) = @_;
 194
 195     return ($t->{xferPid});
 196 }
 197
 198 #
 199 #  usage:
 200 #    $t->logMsg($msg);
 201 #
 202 sub logMsg
 203 {
 204     my ($t, $msg) = @_;
 205
 206     push(@{$t->{_logMsg}}, $msg);
 207 }
 208
 209 #
 210 #  usage:
 211 #    $t->logMsgGet();
 212 #
 213 sub logMsgGet
 214 {
 215     my($t) = @_;
 216
 217     return shift(@{$t->{_logMsg}});
 218 }
 219
 220 #
 221 #  usage:
 222 #    $t->getStats();
 223 #
 224 # This function returns xfer statistics.  It Returns a hash ref giving
 225 # various status information about the transfer.
 226 #
 227 sub getStats
 228 {
 229     my ($t) = @_;
 230
 231     return {
 232         map { $_ => $t->{$_} }
 233           qw(byteCnt fileCnt xferErrCnt xferBadShareCnt xferBadFileCnt
 234              xferOK hostAbort hostError lastOutputLine)
 235     };
 236 }
 237
 238 sub getBadFiles
 239 {
 240     my ($t) = @_;
 241
 242     return @{$t->{badFiles}};
 243 }
 244
 245 #
 246 # useTar function.  In order to work correctly, the protocol in
 247 # question should overwrite the function if it needs to return true.
 248 #
 249 sub useTar
 250 {
 251     return 0;
 252 }
 253
 254 ##############################################################################
 255 # Logging Functions
 256 ##############################################################################
 257
 258 #
 259 # usage:
 260 #   $t->logWrite($msg [, $level])
 261 #
 262 # This function writes to XferLOG.
 263 #
 264 sub logWrite
 265 {
 266     my($t, $msg, $level) = @_;
 267
 268     my $XferLOG = $t->{XferLOG};
 269     $level = 3 if ( !defined($level) );
 270
 271     return ( $XferLOG->write(\$msg) ) if ( $level <= $t->{logLevel} );
 272 }
 273
 274 ##############################################################################
 275 # File Inclusion/Exclusion
 276 ##############################################################################
 277
 278 #
 279 # loadInclExclRegexps() places the appropriate file include/exclude regexps
 280 #
 281 sub loadInclExclRegexps
 282 {
 283     my ( $t, $shareType ) = @_;
 284     my $bpc  = $t->{bpc};
 285     my $conf = $t->{conf};
 286
 287     my @BackupFilesOnly    = ();
 288     my @BackupFilesExclude = ();
 289     my ($shareName, $shareNameRE);
 290
 291     #
 292     # $conf->{$shareType} shold be a reference to an array with one
 293     # element, thanks to BackupFileConfFix().
 294     #
 295     $shareName = @{ $conf->{$shareType} }[0];
 296     $shareName =~ s/\/*$//;    # remove trailing slashes
 297
 298     $t->{shareName}   = $shareName;
 299     $t->{shareNameRE} = $bpc->glob2re($shareName);
 300
 301     #
 302     # load all relevant values into @BackupFilesOnly
 303     #
 304     if ( ref( $conf->{BackupFilesOnly} ) eq "HASH" ) {
 305
 306         foreach my $share ( ( '*', $shareName ) ) {
 307             push @BackupFilesOnly, @{ $conf->{BackupFilesOnly}{$share} }
 308                 if ( defined( $conf->{BackupFilesOnly}{$share} ) );
 309         }
 310
 311     } elsif ( ref( $conf->{BackupFilesOnly} ) eq "ARRAY" ) {
 312
 313         push( @BackupFilesOnly, @{ $conf->{BackupFilesOnly} } );
 314
 315     } elsif ( !defined( $conf->{BackupFilesOnly} ) ) {
 316
 317         #
 318         # do nothing
 319         #
 320
 321     } else {
 322
 323         #
 324         # not a legitimate entry for $conf->{BackupFilesOnly}
 325         #
 326         $t->{_errStr} = "Incorrect syntax in BackupFilesOnly for host $t->{Host}";
 327
 328         return;
 329     }
 330
 331     #
 332     # load all relevant values into @BackupFilesExclude
 333     #
 334     if ( ref( $conf->{BackupFilesExclude} ) eq "HASH" ) {
 335
 336         foreach my $share ( ( '*', $shareName ) ) {
 337             push( @BackupFilesExclude,
 338                 map {
 339                         ( $_ =~ /^\// )
 340                       ? ( $t->{shareNameRE} . $bpc->glob2re($_) )
 341                       : ( '.*\/' . $bpc->glob2re($_) . '(?=\/.*)?' )
 342                   } @{ $conf->{BackupFilesExclude}{$share} }
 343                 ) if ( defined( $conf->{BackupFilesExclude}{$share} ) ) ;
 344         }
 345
 346     } elsif ( ref( $conf->{BackupFilesExclude} ) eq "ARRAY" ) {
 347
 348         push( @BackupFilesExclude,
 349             map {
 350                     ( $_ =~ /\// )
 351                   ? ( $bpc->glob2re($_) )
 352                   : ( '.*\/' . $bpc->glob2re($_) . '(?<=\/.*)?' )
 353               } @{ $conf->{BackupFilesExclude} } );
 354
 355     } elsif ( !defined( $conf->{BackupFilesOnly} ) ) {
 356
 357         #
 358         # do nothing here
 359         #
 360
 361     } else {
 362
 363         #
 364         # not a legitimate entry for $conf->{BackupFilesExclude}
 365         #
 366         $t->{_errStr} =
 367           "Incorrect syntax in BackupFilesExclude for host $t->{Host}";
 368         return;
 369     }
 370
 371     #
 372     # load the regular expressions into the xfer object
 373     #
 374     $t->{BackupFilesOnly} = ( @BackupFilesOnly > 0 ) ? \@BackupFilesOnly : undef;
 375     $t->{BackupFilesExclude} = ( @BackupFilesExclude > 0 ) ? \@BackupFilesExclude : undef;
 376
 377     return 1;
 378 }
 379
 380
 381 sub checkIncludeExclude
 382 {
 383     my ($t, $file) = @_;
 384
 385     return ( $t->checkIncludeMatch($file) && !$t->checkExcludeMatch($file) );
 386 }
 387
 388 sub checkIncludeMatch
 389 {
 390     my ($t, $file) = @_;
 391
 392     my $shareName = $t->{shareName};
 393     my $includes  = $t->{BackupFilesOnly} || return 1;
 394     my $match = "";
 395
 396     foreach my $include ( @{$includes} ) {
 397
 398         #
 399         # construct regexp elsewhere to avoid syntactical evil
 400         #
 401         $match = '^' . quotemeta( $shareName . $include ) . '(?=\/.*)?';
 402
 403         #
 404         # return true if the include folder is a parent of the file,
 405         # or the folder itself.
 406         #
 407         return 1 if ( $file =~ /$match/ );
 408
 409         $match = '^' . quotemeta($file) . '(?=\/.*)?';
 410
 411         #
 412         # return true if the file is a parent of the include folder,
 413         # or the folder itself.
 414         #
 415         return 1 if ( "$shareName$include" =~ /$match/ );
 416     }
 417     return 0;
 418 }
 419
 420 sub checkExcludeMatch
 421 {
 422     my ($t, $file) = @_;
 423
 424     my $shareName = $t->{shareName};
 425     my $includes  = $t->{BackupFilesOnly} || return 0;
 426     my $match = "";
 427
 428     foreach my $include ( @{$includes} ) {
 429
 430         #
 431         # construct regexp elsewhere to avoid syntactical evil
 432         #
 433         $match = '^' . quotemeta( $shareName . $include ) . '(?=\/.*)?';
 434
 435         #
 436         # return true if the include folder is a parent of the file,
 437         # or the folder itself.
 438         #
 439         return 1 if ( $file =~ /$match/ );
 440
 441         $match = '^' . quotemeta($file) . '(?=\/.*)?';
 442
 443         #
 444         # return true if the file is a parent of the include folder,
 445         # or the folder itself.
 446         #
 447         return 1 if ( "$shareName$include" =~ /$match/ );
 448     }
 449     return 0;
 450 }
 451
 452 1;