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-2003  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 2.1.3, released 21 Jan 2007.
  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         $tarClientCmd = $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, and $conf->{TarShareName}
  96         # to an array
  97         #
  98         $bpc->backupFileConfFix($conf, "TarShareName");
  99
 100         if ( defined($conf->{BackupFilesExclude}{$t->{shareName}}) ) {
 101             foreach my $file ( @{$conf->{BackupFilesExclude}{$t->{shareName}}} )
 102             {
 103                 $file = ".$file" if ( $file =~ /^\// );
 104                 push(@fileList, "--exclude=$file");
 105             }
 106         }
 107         if ( defined($conf->{BackupFilesOnly}{$t->{shareName}}) ) {
 108             foreach my $file ( @{$conf->{BackupFilesOnly}{$t->{shareName}}} ) {
 109                 $file = ".$file" if ( $file =~ /^\// );
 110                 push(@fileList, $file);
 111             }
 112         } else {
 113             push(@fileList, ".");
 114         }
 115         if ( ref($conf->{TarClientCmd}) eq "ARRAY" ) {
 116             $tarClientCmd = $conf->{TarClientCmd};
 117         } else {
 118             $tarClientCmd = [split(/ +/, $conf->{TarClientCmd})];
 119         }
 120         my $args;
 121         if ( $t->{type} eq "full" ) {
 122             $args = $conf->{TarFullArgs};
 123             $logMsg = "full backup started for directory $t->{shareName}";
 124         } else {
 125             $incrDate = $bpc->timeStamp($t->{lastFull} - 3600, 1);
 126             $args = $conf->{TarIncrArgs};
 127             $logMsg = "incr backup started back to $incrDate for directory"
 128                     . " $t->{shareName}";
 129         }
 130         push(@$tarClientCmd, split(/ +/, $args));
 131     }
 132     #
 133     # Merge variables into @tarClientCmd
 134     #
 135     my $args = {
 136         host      => $t->{host},
 137         hostIP    => $t->{hostIP},
 138         client    => $t->{client},
 139         incrDate  => $incrDate,
 140         shareName => $t->{shareName},
 141         fileList  => \@fileList,
 142         tarPath   => $conf->{TarClientPath},
 143         sshPath   => $conf->{SshPath},
 144     };
 145     $tarClientCmd = $bpc->cmdVarSubstitute($tarClientCmd, $args);
 146     if ( !defined($t->{xferPid} = open(TAR, "-|")) ) {
 147         $t->{_errStr} = "Can't fork to run tar";
 148         return;
 149     }
 150     $t->{pipeTar} = *TAR;
 151     if ( !$t->{xferPid} ) {
 152         #
 153         # This is the tar child.
 154         #
 155         setpgrp 0,0;
 156         if ( $t->{type} eq "restore" ) {
 157             #
 158             # For restores, close the write end of the pipe,
 159             # clone STDIN to RH
 160             #
 161             close($t->{pipeWH});
 162             close(STDERR);
 163             open(STDERR, ">&STDOUT");
 164             close(STDIN);
 165             open(STDIN, "<&$t->{pipeRH}");
 166         } else {
 167             #
 168             # For backups, close the read end of the pipe,
 169             # clone STDOUT to WH, and STDERR to STDOUT
 170             #
 171             close($t->{pipeRH});
 172             close(STDERR);
 173             open(STDERR, ">&STDOUT");
 174             open(STDOUT, ">&$t->{pipeWH}");
 175         }
 176         #
 177         # Run the tar command
 178         #
 179         alarm(0);
 180         $bpc->cmdExecOrEval($tarClientCmd, $args);
 181         # should not be reached, but just in case...
 182         $t->{_errStr} = "Can't exec @$tarClientCmd";
 183         return;
 184     }
 185     my $str = "Running: " . $bpc->execCmd2ShellCmd(@$tarClientCmd) . "\n";
 186     $t->{XferLOG}->write(\"Running: @$tarClientCmd\n");
 187     alarm($conf->{ClientTimeout});
 188     $t->{_errStr} = undef;
 189     return $logMsg;
 190 }
 191
 192 sub readOutput
 193 {
 194     my($t, $FDreadRef, $rout) = @_;
 195     my $conf = $t->{conf};
 196
 197     if ( vec($rout, fileno($t->{pipeTar}), 1) ) {
 198         my $mesg;
 199         if ( sysread($t->{pipeTar}, $mesg, 8192) <= 0 ) {
 200             vec($$FDreadRef, fileno($t->{pipeTar}), 1) = 0;
 201             if ( !close($t->{pipeTar}) && $? != 256 ) {
 202                 #
 203                 # Tar 1.16 uses exit status 1 (256) when some files
 204                 # changed during archive creation.  We allow this
 205                 # as a benign error and consider the archive ok
 206                 #
 207                 $t->{tarOut} .= "Tar exited with error $? ($!) status\n";
 208                 $t->{xferOK} = 0 if ( !$t->{tarBadExitOk} );
 209             }
 210         } else {
 211             $t->{tarOut} .= $mesg;
 212         }
 213     }
 214     while ( $t->{tarOut} =~ /(.*?)[\n\r]+(.*)/s ) {
 215         $_ = $1;
 216         $t->{tarOut} = $2;
 217         #
 218         # refresh our inactivity alarm
 219         #
 220         alarm($conf->{ClientTimeout}) if ( !$t->{abort} );
 221         $t->{lastOutputLine} = $_ if ( !/^$/ );
 222         if ( /^Total bytes (written|read): / ) {
 223             $t->{XferLOG}->write(\"$_\n") if ( $t->{logLevel} >= 1 );
 224             $t->{xferOK} = 1;
 225         } elsif ( /^\./ ) {
 226             $t->{XferLOG}->write(\"$_\n") if ( $t->{logLevel} >= 2 );
 227             $t->{fileCnt}++;
 228         } else {
 229             #
 230             # Ignore annoying log message on incremental for tar 1.15.x
 231             #
 232             if ( !/: file is unchanged; not dumped$/ ) {
 233                 $t->{XferLOG}->write(\"$_\n") if ( $t->{logLevel} >= 0 );
 234                 $t->{xferErrCnt}++;
 235             }
 236             #
 237             # If tar encounters a minor error, it will exit with a non-zero
 238             # status.  We still consider that ok.  Remember if tar prints
 239             # this message indicating a non-fatal error.
 240             #
 241             $t->{tarBadExitOk} = 1
 242                     if ( $t->{xferOK} && /Error exit delayed from previous / );
 243             #
 244             # Also remember files that had read errors
 245             #
 246             if ( /: \.\/(.*): Read error at byte / ) {
 247                 my $badFile = $1;
 248                 push(@{$t->{badFiles}}, {
 249                         share => $t->{shareName},
 250                         file  => $badFile
 251                     });
 252             }
 253
 254         }
 255     }
 256     return 1;
 257 }
 258
 259 sub abort
 260 {
 261     my($t, $reason) = @_;
 262     my @xferPid = $t->xferPid;
 263
 264     $t->{abort} = 1;
 265     $t->{abortReason} = $reason;
 266     if ( @xferPid ) {
 267         kill($t->{bpc}->sigName2num("INT"), @xferPid);
 268     }
 269 }
 270
 271 sub setSelectMask
 272 {
 273     my($t, $FDreadRef) = @_;
 274
 275     vec($$FDreadRef, fileno($t->{pipeTar}), 1) = 1;
 276 }
 277
 278 sub errStr
 279 {
 280     my($t) = @_;
 281
 282     return $t->{_errStr};
 283 }
 284
 285 sub xferPid
 286 {
 287     my($t) = @_;
 288
 289     return ($t->{xferPid});
 290 }
 291
 292 sub logMsg
 293 {
 294     my($t, $msg) = @_;
 295
 296     push(@{$t->{_logMsg}}, $msg);
 297 }
 298
 299 sub logMsgGet
 300 {
 301     my($t) = @_;
 302
 303     return shift(@{$t->{_logMsg}});
 304 }
 305
 306 #
 307 # Returns a hash ref giving various status information about
 308 # the transfer.
 309 #
 310 sub getStats
 311 {
 312     my($t) = @_;
 313
 314     return { map { $_ => $t->{$_} }
 315             qw(byteCnt fileCnt xferErrCnt xferBadShareCnt xferBadFileCnt
 316                xferOK hostAbort hostError lastOutputLine)
 317     };
 318 }
 319
 320 sub getBadFiles
 321 {
 322     my($t) = @_;
 323
 324     return @{$t->{badFiles}};
 325 }
 326
 327 1;