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-2009  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.2.0, released 31 Jul 2010.
  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 use base qw(BackupPC::Xfer::Protocol);
  43
  44 sub useTar
  45 {
  46     return 1;
  47 }
  48
  49 sub start
  50 {
  51     my($t) = @_;
  52     my $bpc = $t->{bpc};
  53     my $conf = $t->{conf};
  54     my(@fileList, $tarClientCmd, $logMsg, $incrDate);
  55     local(*TAR);
  56
  57     if ( $t->{type} eq "restore" ) {
  58         $tarClientCmd = $conf->{TarClientRestoreCmd};
  59         $logMsg = "restore started below directory $t->{shareName}";
  60         #
  61         # restores are considered to work unless we see they fail
  62         # (opposite to backups...)
  63         #
  64         $t->{xferOK} = 1;
  65     } else {
  66         #
  67         # Turn $conf->{BackupFilesOnly} and $conf->{BackupFilesExclude}
  68         # into a hash of arrays of files, and $conf->{TarShareName}
  69         # to an array
  70         #
  71         $bpc->backupFileConfFix($conf, "TarShareName");
  72
  73         if ( defined($conf->{BackupFilesExclude}{$t->{shareName}}) ) {
  74             foreach my $file ( @{$conf->{BackupFilesExclude}{$t->{shareName}}} )
  75             {
  76                 $file = "./$2" if ( $file =~ m{^(\./+|/+)(.*)}s );
  77                 $file = encode($conf->{ClientCharset}, $file)
  78                             if ( $conf->{ClientCharset} ne "" );
  79                 push(@fileList, "--exclude=$file");
  80             }
  81         }
  82         if ( defined($conf->{BackupFilesOnly}{$t->{shareName}}) ) {
  83             foreach my $file ( @{$conf->{BackupFilesOnly}{$t->{shareName}}} ) {
  84                 $file = $2 if ( $file =~ m{^(\./+|/+)(.*)}s );
  85                 $file = "./$file";
  86                 $file = encode($conf->{ClientCharset}, $file)
  87                             if ( $conf->{ClientCharset} ne "" );
  88                 push(@fileList, $file);
  89             }
  90         } else {
  91             push(@fileList, ".");
  92         }
  93         if ( ref($conf->{TarClientCmd}) eq "ARRAY" ) {
  94             $tarClientCmd = $conf->{TarClientCmd};
  95         } else {
  96             $tarClientCmd = [split(/ +/, $conf->{TarClientCmd})];
  97         }
  98         my $args;
  99         if ( $t->{type} eq "full" ) {
 100             $args = $conf->{TarFullArgs};
 101             $logMsg = "full backup started for directory $t->{shareName}";
 102         } else {
 103             $incrDate = $bpc->timeStamp($t->{incrBaseTime} - 3600, 1);
 104             $args = $conf->{TarIncrArgs};
 105             $logMsg = "incr backup started back to $incrDate"
 106                     . " (backup #$t->{incrBaseBkupNum}) for directory"
 107                     . " $t->{shareName}";
 108         }
 109         push(@$tarClientCmd, split(/ +/, $args));
 110     }
 111     #
 112     # Merge variables into @tarClientCmd
 113     #
 114     my $args = {
 115         host      => $t->{host},
 116         hostIP    => $t->{hostIP},
 117         client    => $t->{client},
 118         incrDate  => $incrDate,
 119         shareName => $t->{shareName},
 120         fileList  => \@fileList,
 121         tarPath   => $conf->{TarClientPath},
 122         sshPath   => $conf->{SshPath},
 123     };
 124     from_to($args->{shareName}, "utf8", $conf->{ClientCharset})
 125                             if ( $conf->{ClientCharset} ne "" );
 126     $tarClientCmd = $bpc->cmdVarSubstitute($tarClientCmd, $args);
 127     if ( !defined($t->{xferPid} = open(TAR, "-|")) ) {
 128         $t->{_errStr} = "Can't fork to run tar";
 129         return;
 130     }
 131     $t->{pipeTar} = *TAR;
 132     if ( !$t->{xferPid} ) {
 133         #
 134         # This is the tar child.
 135         #
 136         setpgrp 0,0;
 137         if ( $t->{type} eq "restore" ) {
 138             #
 139             # For restores, close the write end of the pipe,
 140             # clone STDIN to RH
 141             #
 142             close($t->{pipeWH});
 143             close(STDERR);
 144             open(STDERR, ">&STDOUT");
 145             close(STDIN);
 146             open(STDIN, "<&$t->{pipeRH}");
 147         } else {
 148             #
 149             # For backups, close the read end of the pipe,
 150             # clone STDOUT to WH, and STDERR to STDOUT
 151             #
 152             close($t->{pipeRH});
 153             close(STDERR);
 154             open(STDERR, ">&STDOUT");
 155             open(STDOUT, ">&$t->{pipeWH}");
 156         }
 157         #
 158         # Run the tar command
 159         #
 160         alarm(0);
 161         $bpc->cmdExecOrEval($tarClientCmd, $args);
 162         # should not be reached, but just in case...
 163         $t->{_errStr} = "Can't exec @$tarClientCmd";
 164         return;
 165     }
 166     my $str = "Running: " . $bpc->execCmd2ShellCmd(@$tarClientCmd) . "\n";
 167     from_to($str, $conf->{ClientCharset}, "utf8")
 168                             if ( $conf->{ClientCharset} ne "" );
 169     $t->{XferLOG}->write(\"Running: @$tarClientCmd\n");
 170     alarm($conf->{ClientTimeout});
 171     $t->{_errStr} = undef;
 172     return $logMsg;
 173 }
 174
 175 sub readOutput
 176 {
 177     my($t, $FDreadRef, $rout) = @_;
 178     my $conf = $t->{conf};
 179
 180     if ( vec($rout, fileno($t->{pipeTar}), 1) ) {
 181         my $mesg;
 182         if ( sysread($t->{pipeTar}, $mesg, 8192) <= 0 ) {
 183             vec($$FDreadRef, fileno($t->{pipeTar}), 1) = 0;
 184             if ( !close($t->{pipeTar}) && $? != 256 ) {
 185                 #
 186                 # Tar 1.16 uses exit status 1 (256) when some files
 187                 # changed during archive creation.  We allow this
 188                 # as a benign error and consider the archive ok
 189                 #
 190                 $t->{tarOut} .= "Tar exited with error $? ($!) status\n";
 191                 $t->{xferOK} = 0 if ( !$t->{tarBadExitOk} );
 192             }
 193         } else {
 194             $t->{tarOut} .= $mesg;
 195         }
 196     }
 197     my $logFileThres = $t->{type} eq "restore" ? 1 : 2;
 198     while ( $t->{tarOut} =~ /(.*?)[\n\r]+(.*)/s ) {
 199         $_ = $1;
 200         $t->{tarOut} = $2;
 201         from_to($_, $conf->{ClientCharset}, "utf8")
 202                             if ( $conf->{ClientCharset} ne "" );
 203         #
 204         # refresh our inactivity alarm
 205         #
 206         alarm($conf->{ClientTimeout}) if ( !$t->{abort} );
 207         $t->{lastOutputLine} = $_ if ( !/^$/ );
 208         if ( /^Total bytes (written|read): / ) {
 209             $t->{XferLOG}->write(\"$_\n") if ( $t->{logLevel} >= 1 );
 210             $t->{xferOK} = 1;
 211         } elsif ( /^\./ ) {
 212             $t->{XferLOG}->write(\"$_\n") if ( $t->{logLevel} >= $logFileThres );
 213             $t->{fileCnt}++;
 214         } else {
 215             #
 216             # Ignore annoying log message on incremental for tar 1.15.x
 217             #
 218             if ( !/: file is unchanged; not dumped$/ && !/: socket ignored$/ ) {
 219                 $t->{XferLOG}->write(\"$_\n") if ( $t->{logLevel} >= 0 );
 220                 $t->{xferErrCnt}++;
 221             }
 222             #
 223             # If tar encounters a minor error, it will exit with a non-zero
 224             # status.  We still consider that ok.  Remember if tar prints
 225             # this message indicating a non-fatal error.
 226             #
 227             $t->{tarBadExitOk} = 1
 228                     if ( $t->{xferOK} && /Error exit delayed from previous / );
 229             #
 230             # Also remember files that had read errors
 231             #
 232             if ( /: \.\/(.*): Read error at byte / ) {
 233                 my $badFile = $1;
 234                 push(@{$t->{badFiles}}, {
 235                         share => $t->{shareName},
 236                         file  => $badFile
 237                     });
 238             }
 239
 240         }
 241     }
 242     return 1;
 243 }
 244
 245 sub setSelectMask
 246 {
 247     my($t, $FDreadRef) = @_;
 248
 249     vec($$FDreadRef, fileno($t->{pipeTar}), 1) = 1;
 250 }
 251
 252 1;