1 #============================================================= -*-perl-*-
3 # BackupPC::Xfer::Tar package
7 # This library defines a BackupPC::Xfer::Tar class for managing
8 # the tar-based transport of backup data from the client.
11 # Craig Barratt <cbarratt@users.sourceforge.net>
14 # Copyright (C) 2001-2009 Craig Barratt
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.
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.
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
30 #========================================================================
32 # Version 3.2.0, released 31 Jul 2010.
34 # See http://backuppc.sourceforge.net.
36 #========================================================================
38 package BackupPC::Xfer::Tar;
41 use Encode qw/from_to encode/;
42 use base qw(BackupPC::Xfer::Protocol);
53 my $conf = $t->{conf};
54 my(@fileList, $tarClientCmd, $logMsg, $incrDate);
57 if ( $t->{type} eq "restore" ) {
58 $tarClientCmd = $conf->{TarClientRestoreCmd};
59 $logMsg = "restore started below directory $t->{shareName}";
61 # restores are considered to work unless we see they fail
62 # (opposite to backups...)
67 # Turn $conf->{BackupFilesOnly} and $conf->{BackupFilesExclude}
68 # into a hash of arrays of files, and $conf->{TarShareName}
71 $bpc->backupFileConfFix($conf, "TarShareName");
73 if ( defined($conf->{BackupFilesExclude}{$t->{shareName}}) ) {
74 foreach my $file ( @{$conf->{BackupFilesExclude}{$t->{shareName}}} )
76 $file = "./$2" if ( $file =~ m{^(\./+|/+)(.*)}s );
77 $file = encode($conf->{ClientCharset}, $file)
78 if ( $conf->{ClientCharset} ne "" );
79 push(@fileList, "--exclude=$file");
82 if ( defined($conf->{BackupFilesOnly}{$t->{shareName}}) ) {
83 foreach my $file ( @{$conf->{BackupFilesOnly}{$t->{shareName}}} ) {
84 $file = $2 if ( $file =~ m{^(\./+|/+)(.*)}s );
86 $file = encode($conf->{ClientCharset}, $file)
87 if ( $conf->{ClientCharset} ne "" );
88 push(@fileList, $file);
93 if ( ref($conf->{TarClientCmd}) eq "ARRAY" ) {
94 $tarClientCmd = $conf->{TarClientCmd};
96 $tarClientCmd = [split(/ +/, $conf->{TarClientCmd})];
99 if ( $t->{type} eq "full" ) {
100 $args = $conf->{TarFullArgs};
101 $logMsg = "full backup started for directory $t->{shareName}";
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}";
109 push(@$tarClientCmd, split(/ +/, $args));
112 # Merge variables into @tarClientCmd
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},
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";
131 $t->{pipeTar} = *TAR;
132 if ( !$t->{xferPid} ) {
134 # This is the tar child.
137 if ( $t->{type} eq "restore" ) {
139 # For restores, close the write end of the pipe,
144 open(STDERR, ">&STDOUT");
146 open(STDIN, "<&$t->{pipeRH}");
149 # For backups, close the read end of the pipe,
150 # clone STDOUT to WH, and STDERR to STDOUT
154 open(STDERR, ">&STDOUT");
155 open(STDOUT, ">&$t->{pipeWH}");
158 # Run the tar command
161 $bpc->cmdExecOrEval($tarClientCmd, $args);
162 # should not be reached, but just in case...
163 $t->{_errStr} = "Can't exec @$tarClientCmd";
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;
177 my($t, $FDreadRef, $rout) = @_;
178 my $conf = $t->{conf};
180 if ( vec($rout, fileno($t->{pipeTar}), 1) ) {
182 if ( sysread($t->{pipeTar}, $mesg, 8192) <= 0 ) {
183 vec($$FDreadRef, fileno($t->{pipeTar}), 1) = 0;
184 if ( !close($t->{pipeTar}) && $? != 256 ) {
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
190 $t->{tarOut} .= "Tar exited with error $? ($!) status\n";
191 $t->{xferOK} = 0 if ( !$t->{tarBadExitOk} );
194 $t->{tarOut} .= $mesg;
197 my $logFileThres = $t->{type} eq "restore" ? 1 : 2;
198 while ( $t->{tarOut} =~ /(.*?)[\n\r]+(.*)/s ) {
201 from_to($_, $conf->{ClientCharset}, "utf8")
202 if ( $conf->{ClientCharset} ne "" );
204 # refresh our inactivity alarm
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 );
212 $t->{XferLOG}->write(\"$_\n") if ( $t->{logLevel} >= $logFileThres );
216 # Ignore annoying log message on incremental for tar 1.15.x
218 if ( !/: file is unchanged; not dumped$/ && !/: socket ignored$/ ) {
219 $t->{XferLOG}->write(\"$_\n") if ( $t->{logLevel} >= 0 );
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.
227 $t->{tarBadExitOk} = 1
228 if ( $t->{xferOK} && /Error exit delayed from previous / );
230 # Also remember files that had read errors
232 if ( /: \.\/(.*): Read error at byte / ) {
234 push(@{$t->{badFiles}}, {
235 share => $t->{shareName},
247 my($t, $FDreadRef) = @_;
249 vec($$FDreadRef, fileno($t->{pipeTar}), 1) = 1;