Changes for 3.1.0beta0.
[BackupPC.git] / 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.1.0beta0, released 3 Sep 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;