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-2007  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.1.0, released 25 Nov 2007.
  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
  67         #
  68         # Various stats
  69         #
  70         byteCnt         => 0,
  71         fileCnt         => 0,
  72         xferErrCnt      => 0,
  73         xferBadShareCnt => 0,
  74         xferBadFileCnt  => 0,
  75         xferOK          => 0,
  76
  77         #
  78         # User's args
  79         #
  80         %$args,
  81     }, $class;
  82
  83     return $t;
  84 }
  85
  86 #
  87 #  usage:
  88 #    $t->args($args);
  89 #
  90 # args() can be used to send additional argument to the Xfer object
  91 # via a hash reference.
  92 #
  93 sub args
  94 {
  95     my($t, $args) = @_;
  96
  97     foreach my $arg ( keys(%$args) ) {
  98         $t->{$arg} = $args->{$arg};
  99     }
 100 }
 101
 102 #
 103 #  usage:
 104 #    $t->start();
 105 #
 106 # start() executes the actual data transfer.  Must be implemented by
 107 # the derived class.
 108 #
 109 sub start
 110 {
 111     my($t) = @_;
 112
 113     $t->{_errStr} = "start() not implemented by ".ref($t);
 114     return;
 115 }
 116
 117 #
 118 #
 119 #
 120 sub run
 121 {
 122     my($t) = @_;
 123
 124     $t->{_errStr} = "run() not implemented by ".ref($t);
 125     return;
 126 }
 127
 128 #
 129 #  usage:
 130 #    $t->readOutput();
 131 #
 132 # This function is only used when $t->useTar() == 1.
 133 #
 134 sub readOutput
 135 {
 136     my($t) = @_;
 137
 138     $t->{_errStr} = "readOutput() not implemented by " . ref($t);
 139     return;
 140 }
 141
 142 #
 143 #  usage:
 144 #    $t->abort($reason);
 145 #
 146 # Aborts the current job.
 147 #
 148 sub abort
 149 {
 150     my($t, $reason) = @_;
 151     my @xferPid = $t->xferPid;
 152
 153     $t->{abort}       = 1;
 154     $t->{abortReason} = $reason;
 155     if ( @xferPid ) {
 156         kill($t->{bpc}->sigName2num("INT"), @xferPid);
 157     }
 158 }
 159
 160 #
 161 #  usage:
 162 #    $t->subSelectMask
 163 #
 164 # This function sets a mask for files when ($t->useTar == 1).
 165 #
 166 sub setSelectMask
 167 {
 168     my($t) = @_;
 169
 170     $t->{_errStr} = "readOutput() not implemented by " . ref($t);
 171 }
 172
 173 #
 174 #  usage:
 175 #    $t->errStr();
 176 #
 177 sub errStr
 178 {
 179     my($t) = @_;
 180
 181     return $t->{_errStr};
 182 }
 183
 184 #
 185 #  usage:
 186 #   $pid = $t->xferPid();
 187 #
 188 # xferPid() returns the process id of the child forked process.
 189 #
 190 sub xferPid
 191 {
 192     my($t) = @_;
 193
 194     return ($t->{xferPid});
 195 }
 196
 197 #
 198 #  usage:
 199 #    $t->logMsg($msg);
 200 #
 201 sub logMsg
 202 {
 203     my ($t, $msg) = @_;
 204
 205     push(@{$t->{_logMsg}}, $msg);
 206 }
 207
 208 #
 209 #  usage:
 210 #    $t->logMsgGet();
 211 #
 212 sub logMsgGet
 213 {
 214     my($t) = @_;
 215
 216     return shift(@{$t->{_logMsg}});
 217 }
 218
 219 #
 220 #  usage:
 221 #    $t->getStats();
 222 #
 223 # This function returns xfer statistics.  It Returns a hash ref giving
 224 # various status information about the transfer.
 225 #
 226 sub getStats
 227 {
 228     my ($t) = @_;
 229
 230     return {
 231         map { $_ => $t->{$_} }
 232           qw(byteCnt fileCnt xferErrCnt xferBadShareCnt xferBadFileCnt
 233              xferOK hostAbort hostError lastOutputLine)
 234     };
 235 }
 236
 237 sub getBadFiles
 238 {
 239     my ($t) = @_;
 240
 241     return @{$t->{badFiles}};
 242 }
 243
 244 #
 245 # useTar function.  In order to work correctly, the protocol in
 246 # question should overwrite the function if it needs to return true.
 247 #
 248 sub useTar
 249 {
 250     return 0;
 251 }
 252
 253 ##############################################################################
 254 # Logging Functions
 255 ##############################################################################
 256
 257 #
 258 # usage:
 259 #   $t->logWrite($msg [, $level])
 260 #
 261 # This function writes to XferLOG.
 262 #
 263 sub logWrite
 264 {
 265     my($t, $msg, $level) = @_;
 266
 267     my $XferLOG = $t->{XferLOG};
 268     $level = 3 if ( !defined($level) );
 269
 270     return ( $XferLOG->write(\$msg) ) if ( $level <= $t->{logLevel} );
 271 }
 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;