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