lib/BackupPC/Xfer/Tar.pm

   1 #============================================================= -*-perl-*-
   2 #
   3 # BackupPC::Xfer::Tar package
   4 #
   5 # DESCRIPTION
   6 #
   7 #   This library defines a BackupPC::Xfer::Tar class for managing
   8 #   the tar-based transport of backup data from the client.
   9 #
  10 # AUTHOR
  11 #   Craig Barratt  <cbarratt@users.sourceforge.net>
  12 #
  13 # COPYRIGHT
  14 #   Copyright (C) 2001  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 1.6.0_CVS, released 10 Dec 2002.
  33 #
  34 # See http://backuppc.sourceforge.net.
  35 #
  36 #========================================================================
  37
  38 package BackupPC::Xfer::Tar;
  39
  40 use strict;
  41
  42 sub new
  43 {
  44     my($class, $bpc, $args) = @_;
  45
  46     $args ||= {};
  47     my $t = bless {
  48         bpc       => $bpc,
  49         conf      => { $bpc->Conf },
  50         host      => "",
  51         hostIP    => "",
  52         shareName => "",
  53         pipeRH    => undef,
  54         pipeWH    => undef,
  55         badFiles  => [],
  56         %$args,
  57     }, $class;
  58
  59     return $t;
  60 }
  61
  62 sub args
  63 {
  64     my($t, $args) = @_;
  65
  66     foreach my $arg ( keys(%$args) ) {
  67         $t->{$arg} = $args->{$arg};
  68     }
  69 }
  70
  71 sub useTar
  72 {
  73     return 1;
  74 }
  75
  76 sub start
  77 {
  78     my($t) = @_;
  79     my $bpc = $t->{bpc};
  80     my $conf = $t->{conf};
  81     my(@fileList, @tarClientCmd, $logMsg, $incrDate);
  82     local(*TAR);
  83
  84     if ( $t->{type} eq "restore" ) {
  85         push(@tarClientCmd, split(/ +/, $conf->{TarClientRestoreCmd}));
  86         $logMsg = "restore started below directory $t->{shareName}";
  87         #
  88         # restores are considered to work unless we see they fail
  89         # (opposite to backups...)
  90         #
  91         $t->{xferOK} = 1;
  92     } else {
  93         #
  94         # Turn $conf->{BackupFilesOnly} and $conf->{BackupFilesExclude}
  95         # into a hash of arrays of files
  96         #
  97         $conf->{TarShareName} = [ $conf->{TarShareName} ]
  98                         unless ref($conf->{TarShareName}) eq "ARRAY";
  99         foreach my $param qw(BackupFilesOnly BackupFilesExclude) {
 100             next if ( !defined($conf->{$param}) );
 101             if ( ref($conf->{$param}) eq "ARRAY" ) {
 102                 $conf->{$param} = {
 103                         $conf->{TarShareName}[0] => $conf->{$param}
 104                 };
 105             } elsif ( ref($conf->{$param}) eq "HASH" ) {
 106                 # do nothing
 107             } else {
 108                 $conf->{$param} = {
 109                         $conf->{TarShareName}[0] => [ $conf->{$param} ]
 110                 };
 111             }
 112         }
 113         if ( defined($conf->{BackupFilesExclude}{$t->{shareName}}) ) {
 114             foreach my $file ( @{$conf->{BackupFilesExclude}{$t->{shareName}}} )
 115             {
 116                 $file = ".$file" if ( $file =~ /^\// );
 117                 push(@fileList, "--exclude=$file");
 118             }
 119         }
 120         if ( defined($conf->{BackupFilesOnly}{$t->{shareName}}) ) {
 121             foreach my $file ( @{$conf->{BackupFilesOnly}{$t->{shareName}}} ) {
 122                 $file = ".$file" if ( $file =~ /^\// );
 123                 push(@fileList, $file);
 124             }
 125         } else {
 126             push(@fileList, ".");
 127         }
 128         if ( $t->{type} eq "full" ) {
 129             push(@tarClientCmd,
 130                     split(/ +/, $conf->{TarClientCmd}),
 131                     split(/ +/, $conf->{TarFullArgs})
 132             );
 133             $logMsg = "full backup started for directory $t->{shareName}";
 134         } else {
 135             $incrDate = $bpc->timeStampISO($t->{lastFull} - 3600, 1);
 136             push(@tarClientCmd,
 137                     split(/ +/, $conf->{TarClientCmd}),
 138                     split(/ +/, $conf->{TarIncrArgs})
 139             );
 140             $logMsg = "incr backup started back to $incrDate for directory"
 141                     . " $t->{shareName}";
 142         }
 143     }
 144     #
 145     # Merge variables into @tarClientCmd
 146     #
 147     my $vars = {
 148         host      => $t->{host},
 149         hostIP    => $t->{hostIP},
 150         incrDate  => $incrDate,
 151         shareName => $t->{shareName},
 152         tarPath   => $conf->{TarClientPath},
 153         sshPath   => $conf->{SshPath},
 154     };
 155     my @cmd = @tarClientCmd;
 156     @tarClientCmd = ();
 157     foreach my $arg ( @cmd ) {
 158         next if ( $arg =~ /^\s*$/ );
 159         if ( $arg =~ /^\$fileList(\+?)/ ) {
 160             my $esc = $1 eq "+";
 161             foreach $arg ( @fileList ) {
 162                 $arg = $bpc->shellEscape($arg) if ( $esc );
 163                 push(@tarClientCmd, $arg);
 164             }
 165         } else {
 166             $arg =~ s{\$(\w+)(\+?)}{
 167                 defined($vars->{$1})
 168                     ? ($2 eq "+" ? $bpc->shellEscape($vars->{$1}) : $vars->{$1})
 169                     : "\$$1"
 170             }eg;
 171             push(@tarClientCmd, $arg);
 172         }
 173     }
 174     if ( !defined($t->{xferPid} = open(TAR, "-|")) ) {
 175         $t->{_errStr} = "Can't fork to run tar";
 176         return;
 177     }
 178     $t->{pipeTar} = *TAR;
 179     if ( !$t->{xferPid} ) {
 180         #
 181         # This is the tar child.
 182         #
 183         setpgrp 0,0;
 184         if ( $t->{type} eq "restore" ) {
 185             #
 186             # For restores, close the write end of the pipe,
 187             # clone STDIN to RH
 188             #
 189             close($t->{pipeWH});
 190             close(STDERR);
 191             open(STDERR, ">&STDOUT");
 192             close(STDIN);
 193             open(STDIN, "<&$t->{pipeRH}");
 194         } else {
 195             #
 196             # For backups, close the read end of the pipe,
 197             # clone STDOUT to WH, and STDERR to STDOUT
 198             #
 199             close($t->{pipeRH});
 200             close(STDERR);
 201             open(STDERR, ">&STDOUT");
 202             open(STDOUT, ">&$t->{pipeWH}");
 203         }
 204         #
 205         # Run the tar command
 206         #
 207         exec(@tarClientCmd);
 208         # should not be reached, but just in case...
 209         $t->{_errStr} = "Can't exec @tarClientCmd";
 210         return;
 211     }
 212     $t->{XferLOG}->write(\"Running: @tarClientCmd\n");
 213     alarm($conf->{SmbClientTimeout});
 214     $t->{_errStr} = undef;
 215     return $logMsg;
 216 }
 217
 218 sub readOutput
 219 {
 220     my($t, $FDreadRef, $rout) = @_;
 221     my $conf = $t->{conf};
 222
 223     if ( vec($rout, fileno($t->{pipeTar}), 1) ) {
 224         my $mesg;
 225         if ( sysread($t->{pipeTar}, $mesg, 8192) <= 0 ) {
 226             vec($$FDreadRef, fileno($t->{pipeTar}), 1) = 0;
 227             if ( !close($t->{pipeTar}) ) {
 228                 $t->{tarOut} .= "Tar exited with error $? ($!) status\n";
 229                 $t->{xferOK} = 0 if ( !$t->{tarBadExitOk} );
 230             }
 231         } else {
 232             $t->{tarOut} .= $mesg;
 233         }
 234     }
 235     while ( $t->{tarOut} =~ /(.*?)[\n\r]+(.*)/s ) {
 236         $_ = $1;
 237         $t->{tarOut} = $2;
 238         $t->{XferLOG}->write(\"$_\n");
 239         #
 240         # refresh our inactivity alarm
 241         #
 242         alarm($conf->{SmbClientTimeout});
 243         $t->{lastOutputLine} = $_ if ( !/^$/ );
 244         if ( /^Total bytes written: / ) {
 245             $t->{xferOK} = 1;
 246         } elsif ( /^\./ ) {
 247             $t->{fileCnt}++;
 248         } else {
 249             $t->{xferErrCnt}++;
 250             #
 251             # If tar encounters a minor error, it will exit with a non-zero
 252             # status.  We still consider that ok.  Remember if tar prints
 253             # this message indicating a non-fatal error.
 254             #
 255             $t->{tarBadExitOk} = 1
 256                     if ( $t->{xferOK} && /Error exit delayed from previous / );
 257         }
 258     }
 259     return 1;
 260 }
 261
 262 sub setSelectMask
 263 {
 264     my($t, $FDreadRef) = @_;
 265
 266     vec($$FDreadRef, fileno($t->{pipeTar}), 1) = 1;
 267 }
 268
 269 sub errStr
 270 {
 271     my($t) = @_;
 272
 273     return $t->{_errStr};
 274 }
 275
 276 sub xferPid
 277 {
 278     my($t) = @_;
 279
 280     return $t->{xferPid};
 281 }
 282
 283 sub logMsg
 284 {
 285     my($t, $msg) = @_;
 286
 287     push(@{$t->{_logMsg}}, $msg);
 288 }
 289
 290 sub logMsgGet
 291 {
 292     my($t) = @_;
 293
 294     return shift(@{$t->{_logMsg}});
 295 }
 296
 297 #
 298 # Returns a hash ref giving various status information about
 299 # the transfer.
 300 #
 301 sub getStats
 302 {
 303     my($t) = @_;
 304
 305     return { map { $_ => $t->{$_} }
 306             qw(byteCnt fileCnt xferErrCnt xferBadShareCnt xferBadFileCnt
 307                xferOK hostAbort hostError lastOutputLine)
 308     };
 309 }
 310
 311 sub getBadFiles
 312 {
 313     my($t) = @_;
 314
 315     return @{$t->{badFiles}};
 316 }
 317
 318 1;