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