* Fixed encoding of email subject header in bin/BackupPC_sendEmail as
[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.1.0, released 25 Nov 2007.
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 ##############################################################################
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;