* Changes in preparation for 3.2.0beta1...
[BackupPC.git] / lib / BackupPC / Xfer / Protocol.pm
1 #============================================================= -*-perl-*-
2 #
3 # BackupPC::Xfer::Protocol package
4 #
5 # DESCRIPTION
6 #
7 #   This library defines a BackupPC::Xfer::Protocol class which
8 #   defines standard methods for the transfer protocols in BackupPC.
9 #
10 # AUTHOR
11 #   Paul Mantz    <pcmantz@zmanda.com>
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.0beta1, released 5 Jan 2010.
33 #
34 # See http://backuppc.sourceforge.net.
35 #
36 #========================================================================
37
38 package BackupPC::Xfer::Protocol;
39
40 use strict;
41 use Data::Dumper;
42 use Encode qw/from_to encode/;
43
44 use BackupPC::Attrib qw(:all);
45
46 #    
47 #  usage: 
48 #    $t = BackupPC::Xfer::Protocol->new($args);
49 #
50 # new() is the constructor.  There's nothing special going on here.
51 #    
52 sub new
53 {
54     my($class, $bpc, $args) = @_;
55
56     $args ||= {};
57     my $t = bless {
58         bpc       => $bpc,
59         conf      => $bpc->{Conf},
60         host      => "",
61         hostIP    => "",
62         shareName => "",
63         pipeRH    => undef,
64         pipeWH    => undef,
65         badFiles  => [],
66         logLevel  => $bpc->{Conf}{XferLogLevel},
67
68         #
69         # Various stats
70         #
71         byteCnt         => 0,
72         fileCnt         => 0,
73         xferErrCnt      => 0,
74         xferBadShareCnt => 0,
75         xferBadFileCnt  => 0,
76         xferOK          => 0,
77
78         #
79         # User's args
80         #
81         %$args,
82     }, $class;
83
84     return $t;
85 }
86
87 #    
88 #  usage:
89 #    $t->args($args);
90 #
91 # args() can be used to send additional argument to the Xfer object
92 # via a hash reference.
93 #    
94 sub args
95 {
96     my($t, $args) = @_;
97
98     foreach my $arg ( keys(%$args) ) {
99         $t->{$arg} = $args->{$arg};
100     }
101 }
102
103 #
104 #  usage:
105 #    $t->start();
106 #
107 # start() executes the actual data transfer.  Must be implemented by
108 # the derived class.
109 #
110 sub start
111 {
112     my($t) = @_;
113
114     $t->{_errStr} = "start() not implemented by ".ref($t);
115     return;
116 }
117
118 #
119 #
120 #
121 sub run
122 {
123     my($t) = @_;
124
125     $t->{_errStr} = "run() not implemented by ".ref($t);
126     return;
127 }
128
129 #
130 #  usage:
131 #    $t->readOutput();
132 #
133 # This function is only used when $t->useTar() == 1.
134 #
135 sub readOutput
136 {
137     my($t) = @_;
138
139     $t->{_errStr} = "readOutput() not implemented by " . ref($t);
140     return;
141 }
142
143 #
144 #  usage:
145 #    $t->abort($reason);
146 #
147 # Aborts the current job.
148 #
149 sub abort
150 {
151     my($t, $reason) = @_;
152     my @xferPid = $t->xferPid;
153
154     $t->{abort}       = 1;
155     $t->{abortReason} = $reason;
156     if ( @xferPid ) {
157         kill($t->{bpc}->sigName2num("INT"), @xferPid);
158     }
159 }
160
161 #
162 #  usage:
163 #    $t->subSelectMask
164 #
165 # This function sets a mask for files when ($t->useTar == 1).
166 #
167 sub setSelectMask
168 {
169     my($t) = @_;
170
171     $t->{_errStr} = "readOutput() not implemented by " . ref($t);
172 }
173
174 #
175 #  usage:
176 #    $t->errStr();
177 #
178 sub errStr
179 {
180     my($t) = @_;
181
182     return $t->{_errStr};
183 }
184
185 #
186 #  usage:
187 #   $pid = $t->xferPid();
188 #
189 # xferPid() returns the process id of the child forked process.
190 #
191 sub xferPid
192 {
193     my($t) = @_;
194
195     return ($t->{xferPid});
196 }
197
198 #
199 #  usage:
200 #    $t->logMsg($msg);
201 #
202 sub logMsg
203 {
204     my ($t, $msg) = @_;
205
206     push(@{$t->{_logMsg}}, $msg);
207 }
208
209 #
210 #  usage:
211 #    $t->logMsgGet();
212 #
213 sub logMsgGet
214 {
215     my($t) = @_;
216
217     return shift(@{$t->{_logMsg}});
218 }
219
220 #
221 #  usage:
222 #    $t->getStats();
223 #
224 # This function returns xfer statistics.  It Returns a hash ref giving
225 # various status information about the transfer.
226 #
227 sub getStats
228 {
229     my ($t) = @_;
230
231     return {
232         map { $_ => $t->{$_} }
233           qw(byteCnt fileCnt xferErrCnt xferBadShareCnt xferBadFileCnt
234              xferOK hostAbort hostError lastOutputLine)
235     };
236 }
237
238 sub getBadFiles
239 {
240     my ($t) = @_;
241
242     return @{$t->{badFiles}};
243 }
244
245 #
246 # useTar function.  In order to work correctly, the protocol in
247 # question should overwrite the function if it needs to return true.
248 #
249 sub useTar
250 {
251     return 0;
252 }
253
254 ##############################################################################
255 # Logging Functions
256 ##############################################################################
257
258 #
259 # usage:
260 #   $t->logWrite($msg [, $level])
261 #
262 # This function writes to XferLOG.
263 #
264 sub logWrite
265 {
266     my($t, $msg, $level) = @_;
267
268     my $XferLOG = $t->{XferLOG};
269     $level = 3 if ( !defined($level) );
270     
271     return ( $XferLOG->write(\$msg) ) if ( $level <= $t->{logLevel} );
272 }
273
274 ##############################################################################
275 # File Inclusion/Exclusion
276 ##############################################################################
277
278 #
279 # loadInclExclRegexps() places the appropriate file include/exclude regexps 
280 #
281 sub loadInclExclRegexps
282 {
283     my ( $t, $shareType ) = @_;
284     my $bpc  = $t->{bpc};
285     my $conf = $t->{conf};
286     
287     my @BackupFilesOnly    = ();
288     my @BackupFilesExclude = ();
289     my ($shareName, $shareNameRE);
290     
291     #
292     # $conf->{$shareType} shold be a reference to an array with one
293     # element, thanks to BackupFileConfFix().
294     #
295     $shareName = @{ $conf->{$shareType} }[0];
296     $shareName =~ s/\/*$//;    # remove trailing slashes
297
298     $t->{shareName}   = $shareName;
299     $t->{shareNameRE} = $bpc->glob2re($shareName);
300
301     #
302     # load all relevant values into @BackupFilesOnly
303     #
304     if ( ref( $conf->{BackupFilesOnly} ) eq "HASH" ) {
305
306         foreach my $share ( ( '*', $shareName ) ) {
307             push @BackupFilesOnly, @{ $conf->{BackupFilesOnly}{$share} } 
308                 if ( defined( $conf->{BackupFilesOnly}{$share} ) );
309         }
310         
311     } elsif ( ref( $conf->{BackupFilesOnly} ) eq "ARRAY" ) {
312         
313         push( @BackupFilesOnly, @{ $conf->{BackupFilesOnly} } );
314         
315     } elsif ( !defined( $conf->{BackupFilesOnly} ) ) {
316
317         #
318         # do nothing 
319         #
320         
321     } else {
322
323         #
324         # not a legitimate entry for $conf->{BackupFilesOnly}
325         #
326         $t->{_errStr} = "Incorrect syntax in BackupFilesOnly for host $t->{Host}";
327           
328         return;
329     }
330     
331     #
332     # load all relevant values into @BackupFilesExclude
333     #
334     if ( ref( $conf->{BackupFilesExclude} ) eq "HASH" ) {
335
336         foreach my $share ( ( '*', $shareName ) ) {
337             push( @BackupFilesExclude,
338                 map {
339                         ( $_ =~ /^\// )
340                       ? ( $t->{shareNameRE} . $bpc->glob2re($_) )
341                       : ( '.*\/' . $bpc->glob2re($_) . '(?=\/.*)?' )
342                   } @{ $conf->{BackupFilesExclude}{$share} }
343                 ) if ( defined( $conf->{BackupFilesExclude}{$share} ) ) ;
344         }
345
346     } elsif ( ref( $conf->{BackupFilesExclude} ) eq "ARRAY" ) {
347
348         push( @BackupFilesExclude,
349             map {
350                     ( $_ =~ /\// )
351                   ? ( $bpc->glob2re($_) )
352                   : ( '.*\/' . $bpc->glob2re($_) . '(?<=\/.*)?' )
353               } @{ $conf->{BackupFilesExclude} } );
354
355     } elsif ( !defined( $conf->{BackupFilesOnly} ) ) {
356
357         #
358         # do nothing here
359         #
360
361     } else {
362
363         #
364         # not a legitimate entry for $conf->{BackupFilesExclude}
365         #
366         $t->{_errStr} =
367           "Incorrect syntax in BackupFilesExclude for host $t->{Host}";
368         return;
369     }
370
371     #
372     # load the regular expressions into the xfer object
373     #
374     $t->{BackupFilesOnly} = ( @BackupFilesOnly > 0 ) ? \@BackupFilesOnly : undef;
375     $t->{BackupFilesExclude} = ( @BackupFilesExclude > 0 ) ? \@BackupFilesExclude : undef;
376
377     return 1;
378 }
379
380
381 sub checkIncludeExclude
382 {
383     my ($t, $file) = @_;
384
385     return ( $t->checkIncludeMatch($file) && !$t->checkExcludeMatch($file) );
386 }
387     
388 sub checkIncludeMatch
389 {
390     my ($t, $file) = @_;
391
392     my $shareName = $t->{shareName};
393     my $includes  = $t->{BackupFilesOnly} || return 1;
394     my $match = "";
395     
396     foreach my $include ( @{$includes} ) {
397       
398         #
399         # construct regexp elsewhere to avoid syntactical evil
400         #
401         $match = '^' . quotemeta( $shareName . $include ) . '(?=\/.*)?';
402
403         #
404         # return true if the include folder is a parent of the file,
405         # or the folder itself.
406         #
407         return 1 if ( $file =~ /$match/ );
408
409         $match = '^' . quotemeta($file) . '(?=\/.*)?';
410
411         #
412         # return true if the file is a parent of the include folder,
413         # or the folder itself.
414         #
415         return 1 if ( "$shareName$include" =~ /$match/ );
416     }
417     return 0;
418 }
419
420 sub checkExcludeMatch
421 {
422     my ($t, $file) = @_;
423
424     my $shareName = $t->{shareName};
425     my $includes  = $t->{BackupFilesOnly} || return 0;
426     my $match = "";
427
428     foreach my $include ( @{$includes} ) {
429
430         #
431         # construct regexp elsewhere to avoid syntactical evil
432         #
433         $match = '^' . quotemeta( $shareName . $include ) . '(?=\/.*)?';
434
435         #
436         # return true if the include folder is a parent of the file,
437         # or the folder itself.
438         #
439         return 1 if ( $file =~ /$match/ );
440
441         $match = '^' . quotemeta($file) . '(?=\/.*)?';
442                 
443         #
444         # return true if the file is a parent of the include folder,
445         # or the folder itself.
446         #
447         return 1 if ( "$shareName$include" =~ /$match/ );
448     }
449     return 0;
450 }
451
452 1;