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.2.0beta0, released 17 Jan 2009.
  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 # File Inclusion/Exclusion
 275 ##############################################################################
 276
 277 #
 278 # loadInclExclRegexps() places the appropriate file include/exclude regexps
 279 #
 280 sub loadInclExclRegexps
 281 {
 282     my ( $t, $shareType ) = @_;
 283     my $bpc  = $t->{bpc};
 284     my $conf = $t->{conf};
 285
 286     my @BackupFilesOnly    = ();
 287     my @BackupFilesExclude = ();
 288     my ($shareName, $shareNameRE);
 289
 290     #
 291     # $conf->{$shareType} shold be a reference to an array with one
 292     # element, thanks to BackupFileConfFix().
 293     #
 294     $shareName = @{ $conf->{$shareType} }[0];
 295     $shareName =~ s/\/*$//;    # remove trailing slashes
 296
 297     $t->{shareName}   = $shareName;
 298     $t->{shareNameRE} = $bpc->glob2re($shareName);
 299
 300     #
 301     # load all relevant values into @BackupFilesOnly
 302     #
 303     if ( ref( $conf->{BackupFilesOnly} ) eq "HASH" ) {
 304
 305         foreach my $share ( ( '*', $shareName ) ) {
 306             push @BackupFilesOnly, @{ $conf->{BackupFilesOnly}{$share} }
 307                 if ( defined( $conf->{BackupFilesOnly}{$share} ) );
 308         }
 309
 310     } elsif ( ref( $conf->{BackupFilesOnly} ) eq "ARRAY" ) {
 311
 312         push( @BackupFilesOnly, @{ $conf->{BackupFilesOnly} } );
 313
 314     } elsif ( !defined( $conf->{BackupFilesOnly} ) ) {
 315
 316         #
 317         # do nothing
 318         #
 319
 320     } else {
 321
 322         #
 323         # not a legitimate entry for $conf->{BackupFilesOnly}
 324         #
 325         $t->{_errStr} = "Incorrect syntax in BackupFilesOnly for host $t->{Host}";
 326
 327         return;
 328     }
 329
 330     #
 331     # load all relevant values into @BackupFilesExclude
 332     #
 333     if ( ref( $conf->{BackupFilesExclude} ) eq "HASH" ) {
 334
 335         foreach my $share ( ( '*', $shareName ) ) {
 336             push( @BackupFilesExclude,
 337                 map {
 338                         ( $_ =~ /^\// )
 339                       ? ( $t->{shareNameRE} . $bpc->glob2re($_) )
 340                       : ( '.*\/' . $bpc->glob2re($_) . '(?=\/.*)?' )
 341                   } @{ $conf->{BackupFilesExclude}{$share} }
 342                 ) if ( defined( $conf->{BackupFilesExclude}{$share} ) ) ;
 343         }
 344
 345     } elsif ( ref( $conf->{BackupFilesExclude} ) eq "ARRAY" ) {
 346
 347         push( @BackupFilesExclude,
 348             map {
 349                     ( $_ =~ /\// )
 350                   ? ( $bpc->glob2re($_) )
 351                   : ( '.*\/' . $bpc->glob2re($_) . '(?<=\/.*)?' )
 352               } @{ $conf->{BackupFilesExclude} } );
 353
 354     } elsif ( !defined( $conf->{BackupFilesOnly} ) ) {
 355
 356         #
 357         # do nothing here
 358         #
 359
 360     } else {
 361
 362         #
 363         # not a legitimate entry for $conf->{BackupFilesExclude}
 364         #
 365         $t->{_errStr} =
 366           "Incorrect syntax in BackupFilesExclude for host $t->{Host}";
 367         return;
 368     }
 369
 370     #
 371     # load the regular expressions into the xfer object
 372     #
 373     $t->{BackupFilesOnly} = ( @BackupFilesOnly > 0 ) ? \@BackupFilesOnly : undef;
 374     $t->{BackupFilesExclude} = ( @BackupFilesExclude > 0 ) ? \@BackupFilesExclude : undef;
 375
 376     return 1;
 377 }
 378
 379
 380 sub checkIncludeExclude
 381 {
 382     my ($t, $file) = @_;
 383
 384     return ( $t->checkIncludeMatch($file) && !$t->checkExcludeMatch($file) );
 385 }
 386
 387 sub checkIncludeMatch
 388 {
 389     my ($t, $file) = @_;
 390
 391     my $shareName = $t->{shareName};
 392     my $includes  = $t->{BackupFilesOnly} || return 1;
 393     my $match = "";
 394
 395     foreach my $include ( @{$includes} ) {
 396
 397         #
 398         # construct regexp elsewhere to avoid syntactical evil
 399         #
 400         $match = '^' . quotemeta( $shareName . $include ) . '(?=\/.*)?';
 401
 402         #
 403         # return true if the include folder is a parent of the file,
 404         # or the folder itself.
 405         #
 406         return 1 if ( $file =~ /$match/ );
 407
 408         $match = '^' . quotemeta($file) . '(?=\/.*)?';
 409
 410         #
 411         # return true if the file is a parent of the include folder,
 412         # or the folder itself.
 413         #
 414         return 1 if ( "$shareName$include" =~ /$match/ );
 415     }
 416     return 0;
 417 }
 418
 419 sub checkExcludeMatch
 420 {
 421     my ($t, $file) = @_;
 422
 423     my $shareName = $t->{shareName};
 424     my $includes  = $t->{BackupFilesOnly} || return 0;
 425     my $match = "";
 426
 427     foreach my $include ( @{$includes} ) {
 428
 429         #
 430         # construct regexp elsewhere to avoid syntactical evil
 431         #
 432         $match = '^' . quotemeta( $shareName . $include ) . '(?=\/.*)?';
 433
 434         #
 435         # return true if the include folder is a parent of the file,
 436         # or the folder itself.
 437         #
 438         return 1 if ( $file =~ /$match/ );
 439
 440         $match = '^' . quotemeta($file) . '(?=\/.*)?';
 441
 442         #
 443         # return true if the file is a parent of the include folder,
 444         # or the folder itself.
 445         #
 446         return 1 if ( "$shareName$include" =~ /$match/ );
 447     }
 448     return 0;
 449 }
 450
 451 1;