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