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