Minor changes to lib/BackupPC/Xfer/RsyncDigest.pm and bin/BackupPC_nightly
[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.0.0beta2, released 11 Nov 2006.
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}) ) {
214                 $t->{tarOut} .= "Tar exited with error $? ($!) status\n";
215                 $t->{xferOK} = 0 if ( !$t->{tarBadExitOk} );
216             }
217         } else {
218             $t->{tarOut} .= $mesg;
219         }
220     }
221     my $logFileThres = $t->{type} eq "restore" ? 1 : 2;
222     while ( $t->{tarOut} =~ /(.*?)[\n\r]+(.*)/s ) {
223         $_ = $1;
224         $t->{tarOut} = $2;
225         from_to($_, $conf->{ClientCharset}, "utf8")
226                             if ( $conf->{ClientCharset} ne "" );
227         #
228         # refresh our inactivity alarm
229         #
230         alarm($conf->{ClientTimeout}) if ( !$t->{abort} );
231         $t->{lastOutputLine} = $_ if ( !/^$/ );
232         if ( /^Total bytes written: / ) {
233             $t->{XferLOG}->write(\"$_\n") if ( $t->{logLevel} >= 1 );
234             $t->{xferOK} = 1;
235         } elsif ( /^\./ ) {
236             $t->{XferLOG}->write(\"$_\n") if ( $t->{logLevel} >= $logFileThres );
237             $t->{fileCnt}++;
238         } else {
239             #
240             # Ignore annoying log message on incremental for tar 1.15.x
241             #
242             if ( !/: file is unchanged; not dumped$/ ) {
243                 $t->{XferLOG}->write(\"$_\n") if ( $t->{logLevel} >= 0 );
244                 $t->{xferErrCnt}++;
245             }
246             #
247             # If tar encounters a minor error, it will exit with a non-zero
248             # status.  We still consider that ok.  Remember if tar prints
249             # this message indicating a non-fatal error.
250             #
251             $t->{tarBadExitOk} = 1
252                     if ( $t->{xferOK} && /Error exit delayed from previous / );
253             #
254             # Also remember files that had read errors
255             #
256             if ( /: \.\/(.*): Read error at byte / ) {
257                 my $badFile = $1;
258                 push(@{$t->{badFiles}}, {
259                         share => $t->{shareName},
260                         file  => $badFile
261                     });
262             }
263
264         }
265     }
266     return 1;
267 }
268
269 sub abort
270 {
271     my($t, $reason) = @_;
272     my @xferPid = $t->xferPid;
273
274     $t->{abort} = 1;
275     $t->{abortReason} = $reason;
276     if ( @xferPid ) {
277         kill($t->{bpc}->sigName2num("INT"), @xferPid);
278     }
279 }
280
281 sub setSelectMask
282 {
283     my($t, $FDreadRef) = @_;
284
285     vec($$FDreadRef, fileno($t->{pipeTar}), 1) = 1;
286 }
287
288 sub errStr
289 {
290     my($t) = @_;
291
292     return $t->{_errStr};
293 }
294
295 sub xferPid
296 {
297     my($t) = @_;
298
299     return ($t->{xferPid});
300 }
301
302 sub logMsg
303 {
304     my($t, $msg) = @_;
305
306     push(@{$t->{_logMsg}}, $msg);
307 }
308
309 sub logMsgGet
310 {
311     my($t) = @_;
312
313     return shift(@{$t->{_logMsg}});
314 }
315
316 #
317 # Returns a hash ref giving various status information about
318 # the transfer.
319 #
320 sub getStats
321 {
322     my($t) = @_;
323
324     return { map { $_ => $t->{$_} }
325             qw(byteCnt fileCnt xferErrCnt xferBadShareCnt xferBadFileCnt
326                xferOK hostAbort hostError lastOutputLine)
327     };
328 }
329
330 sub getBadFiles
331 {
332     my($t) = @_;
333
334     return @{$t->{badFiles}};
335 }
336
337 1;