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