* version header update
[BackupPC.git] / lib / BackupPC / Xfer / Ftp.pm
1 #============================================================= -*-perl-*-
2 #
3 # BackupPC::Xfer::Ftp package
4 #
5 # DESCRIPTION
6 #
7 #   This library defines a BackupPC::Xfer::Ftp class for transferring
8 #   data from a FTP client.
9 #
10 # AUTHOR
11 #   Paul Mantz <pcmantz@zmanda.com>
12 #
13 # COPYRIGHT
14 #   (C) 2008, Zmanda Inc.
15 #
16 #   This program is free software; you can redistribute it and/or
17 #   modify it under the terms of the GNU General Public License as
18 #   published by the Free Software Foundation; either version 2 of the
19 #   License, or (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 GNU
24 #   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
29 #   02111-1307 USA
30 #
31 #
32 #========================================================================
33 #
34 # Version 3.2.0beta0, released 5 April 2009.
35 #
36 # See http://backuppc.sourceforge.net.
37 #
38 #========================================================================
39
40
41 package BackupPC::Xfer::Ftp;
42
43 use strict;
44
45 use BackupPC::View;
46 use BackupPC::Attrib qw(:all);
47
48 use Encode qw/from_to encode/;
49 use File::Listing qw/parse_dir/;
50 use File::Path;
51 use Data::Dumper;
52 use base qw(BackupPC::Xfer::Protocol);
53
54 use vars qw( $FTPLibOK $FTPLibErr $ARCLibOK );
55
56 use constant S_IFMT => 0170000;
57
58 BEGIN {
59
60     $FTPLibOK = 1;
61     $ARCLibOK = 0;
62
63     #
64     # clear eval error variable
65     #
66     my @FTPLibs = qw( Net::FTP Net::FTP::RetrHandle );
67
68     foreach my $module ( @FTPLibs ) {
69
70         undef $@;
71         eval "use $module;";
72
73         if ( $@ ) {
74             $FTPLibOK = 0;
75             $FTPLibErr = "module $module doesn't exist: $@";
76             last;
77         }
78     }
79
80     eval "use Net::FTP::AutoReconnect;";
81     $ARCLibOK = (defined($@)) ? 1 : 0;
82 };
83
84 ##############################################################################
85 # Constructor
86 ##############################################################################
87
88
89 #
90 #   usage:
91 #     $xfer = new BackupPC::Xfer::Ftp( $bpc, %args );
92 #
93 # new() is your default class constructor.  it also calls the
94 # constructor for Protocol as well.
95 #
96 sub new
97 {
98     my ( $class, $bpc, $args ) = @_;
99     $args ||= {};
100
101     my $t = BackupPC::Xfer::Protocol->new(
102         $bpc,
103         {
104            ftp   => undef,
105            stats => {
106                errorCnt          => 0,
107                TotalFileCnt      => 0,
108                TotalFileSize     => 0,
109                ExistFileCnt      => 0,
110                ExistFileSize     => 0,
111                ExistFileCompSize => 0,
112            },
113            %$args,
114         } );
115     return bless( $t, $class );
116 }
117
118
119 ##############################################################################
120 # Methods
121 ##############################################################################
122
123 #
124 #   usage:
125 #     $xfer->start();
126 #
127 # start() is called to configure and initiate a dump or restore,
128 # depending on the configured options.
129 #
130 sub start
131 {
132     my ($t) = @_;
133
134     my $bpc  = $t->{bpc};
135     my $conf = $t->{conf};
136
137     my ( @fileList, $logMsg, $incrDate, $args, $dumpText );
138
139     #
140     # initialize the statistics returned by getStats()
141     #
142     foreach ( qw/byteCnt fileCnt xferErrCnt xferBadShareCnt
143                  xferBadFileCnt xferOK hostAbort hostError
144                  lastOutputLine/ )
145     {
146         $t->{$_} = 0;
147     }
148
149     #
150     # Net::FTP::RetrHandle is necessary.
151     #
152     if ( !$FTPLibOK ) {
153         $t->{_errStr} = "Error: FTP transfer selected but module"
154           . " Net::FTP::RetrHandle is not installed.";
155         $t->{xferErrCnt}++;
156         return;
157     }
158
159     #
160     # standardize the file include/exclude settings if necessary
161     #
162     unless ( $t->{type} eq 'restore' ) {
163         $bpc->backupFileConfFix( $conf, "FtpShareName" );
164         $t->loadInclExclRegexps("FtpShareName");
165     }
166
167     #
168     # Convert the encoding type of the names if at all possible
169     #
170     from_to( $args->{shareName}, "utf8", $conf->{ClientCharset} )
171                                 if ( $conf->{ClientCharset} ne "" );
172
173     #
174     # Collect FTP configuration arguments and translate them for
175     # passing to the FTP module.
176     #
177     unless ( $args = $t->getFTPArgs() ) {
178         return;
179     }
180
181     #
182     # Create the Net::FTP::AutoReconnect or Net::FTP object.
183     #
184     undef $@;
185     eval {
186         $t->{ftp} = ($ARCLibOK) ? Net::FTP::AutoReconnect->new(%$args)
187                                 : Net::FTP->new(%$args);
188     };
189     if ($@) {
190         $t->{_errStr} = "Can't open connection to $args->{host}: $!";
191         $t->{xferErrCnt}++;
192         return;
193     }
194
195     #
196     # Log in to the ftp server and set appropriate path information.
197     #
198     undef $@;
199     eval { $t->{ftp}->login( $conf->{FtpUserName}, $conf->{FtpPasswd} ); };
200     if ( $@ ) {
201         $t->{_errStr} = "Can't login to $args->{host}: $!";
202         $t->{xferErrCnt}++;
203         return;
204     }
205
206     undef $@;
207     eval { $t->{ftp}->binary(); };
208     if ($@) {
209         $t->{_errStr} =
210           "Can't enable binary transfer mode to $args->{host}: $!";
211         $t->{xferErrCnt}++;
212         return;
213     }
214
215     undef $@;
216     eval { $t->{shareName} =~ m/^\.?$/ || $t->{ftp}->cwd( $t->{shareName} ); };
217     if ($@) {
218         $t->{_errStr} =
219             "Can't change working directory to $t->{shareName}: $!";
220         $t->{xferErrCnt}++;
221         return;
222     }
223
224     undef $@;
225     eval { $t->{sharePath} = $t->{ftp}->pwd(); };
226     if ($@) {
227         $t->{_errStr} =
228             "Can't retrieve full working directory of $t->{shareName}: $!";
229         $t->{xferErrCnt}++;
230         return;
231     }
232
233     #
234     # log the beginning of action based on type
235     #
236     if ( $t->{type} eq 'restore' ) {
237         $logMsg = "ftp restore for host $t->{host} started on directory "
238           . "$t->{shareName}\n";
239
240     } elsif ( $t->{type} eq 'full' ) {
241         $logMsg = "ftp full backup for host $t->{host} started on directory "
242           . "$t->{shareName}\n";
243
244     } elsif ( $t->{type} eq 'incr' ) {
245         $incrDate = $bpc->timeStamp( $t->{incrBaseTime} - 3600, 1 );
246         $logMsg = "ftp incremental backup for $t->{host} started back to "
247           . "$incrDate (backup #$t->{incrBaseBkupNum}) for directory "
248           . "$t->{shareName}\n";
249     }
250     $t->logWrite($logMsg, 1);
251
252     #
253     # call the recursive function based on the type of action
254     #
255     if ( $t->{type} eq 'restore' ) {
256
257         $t->restore();
258         $logMsg = "Restore of $t->{host} complete";
259
260     } elsif ( $t->{type} eq 'incr' ) {
261
262         $t->backup();
263         $logMsg = "Incremental backup of $t->{host} complete";
264
265     } elsif ( $t->{type} eq 'full' ) {
266
267         $t->backup();
268         $logMsg = "Full backup of $t->{host} complete";
269     }
270
271     delete $t->{_errStr};
272     return $logMsg;
273 }
274
275
276 #
277 #
278 #
279 sub run
280 {
281     my ($t) = @_;
282     my $stats = $t->{stats};
283
284     my ( $tarErrs,      $nFilesExist, $sizeExist,
285          $sizeExistCom, $nFilesTotal, $sizeTotal );
286
287     #
288     # TODO: replace the $stats array with variables at the top level,
289     # ones returned by $getStats.  They should be identical.
290     #
291     $tarErrs      = 0;
292     $nFilesExist  = $stats->{ExistFileCnt};
293     $sizeExist    = $stats->{ExistFileSize};
294     $sizeExistCom = $stats->{ExistFileCompSize};
295     $nFilesTotal  = $stats->{TotalFileCnt};
296     $sizeTotal    = $stats->{TotalFileSize};
297
298     if ( $t->{type} eq "restore" ) {
299         return ( $t->{fileCnt}, $t->{byteCnt}, 0, 0 );
300
301     } else {
302         return ( $tarErrs,      $nFilesExist, $sizeExist,
303                  $sizeExistCom, $nFilesTotal, $sizeTotal );
304     }
305 }
306
307
308 #
309 #   usage:
310 #     $t->restore();
311 #
312 # TODO: finish or scuttle this function.  It is not necessary for a
313 # release.
314 #
315 sub restore
316 {
317     my $t = @_;
318
319     my $bpc = $t->{bpc};
320     my $fileList = $t->{fileList};
321
322     my ($path, $fileName, $fileAttr, $fileType );
323
324     #print STDERR "BackupPC::Xfer::Ftp->restore()";
325
326     #
327     # Prepare the view object
328     #
329     $t->{view} = BackupPC::View->new( $bpc, $t->{bkupSrcHost},
330                                       $t->{backups} );
331     my $view = $t->{view};
332
333   SCAN: foreach my $f ( @$fileList ) {
334
335         #print STDERR "restoring $f...\n";
336
337         $f =~ /(.*)\/([^\/]*)/;
338         $path     = $1;
339         $fileName = $2;
340
341         $view->dirCache($path);
342
343         $fileAttr = $view->fileAttrib($fileName);
344         $fileType = fileType2Text( $fileAttr->{type} );
345
346         if ( $fileType eq "dir") {
347             $t->restoreDir($fileName, $fileAttr);
348
349         } elsif ( $fileType eq "file" ) {
350             $t->restoreFile($fileName, $fileAttr);
351
352         } elsif ( $fileType eq "symlink" ) {
353             #
354             # ignore
355             #
356         } else {
357             #
358             # ignore
359             #
360         }
361     } # end SCAN
362 }
363
364
365 sub restoreDir
366 {
367     my ( $t, $dirName, $dirAttr ) = @_;
368
369     my $ftp    = $t->{ftp};
370     my $bpc    = $t->{bpc};
371     my $conf   = $t->{conf};
372     my $view   = $t->{view};
373     my $TopDir = $bpc->TopDir();
374
375     my $path    = "$dirAttr->{relPath}/$dirName";
376     my $dirList = $view->dirAttrib( -1, $t->{shareName}, $path );
377
378     my ( $fileName, $fileAttr, $fileType );
379
380     #print STDERR "BackupPC::Xfer::Ftp->restore($dirName)\n";
381
382     #
383     # Create the remote directory
384     #
385     undef $@;
386     eval { $ftp->mkdir( $path, 1 ); };
387     if ($@) {
388         $t->logFileAction( "fail", $dirName, $dirAttr );
389         return;
390     }
391
392  SCAN: while ( ($fileName, $fileAttr ) = each %$dirList ) {
393
394         $fileType = fileType2Text( $fileAttr->{type} );
395
396         if ( $fileType eq "dir" ) {
397             if ( $t->restoreDir( $fileName, $fileAttr ) ) {
398                 $t->logWrite( "restored: $path/$fileName\n", 5 );
399             } else {
400                 $t->logWrite( "restore failed: $path/$fileName\n", 3 );
401             }
402
403         } elsif ( $fileType eq "file" ) {
404             $t->restoreFile( $fileName, $fileAttr );
405
406         } elsif ( $fileType eq "hardlink" ) {
407             #
408             # Hardlinks cannot be restored.  however, if we have the
409             # target file in the pool, we can restore that.
410             #
411             $t->restoreFile( $fileName, $fileAttr );
412
413             next SCAN;
414
415         } elsif ( $fileType eq "symlink" ) {
416             #
417             # Symlinks cannot be restored
418             #
419             next SCAN;
420
421         } else {
422             #
423             # Ignore all other types (devices, doors, etc)
424             #
425             next SCAN;
426         }
427     }
428 }
429
430
431 sub restoreFile
432 {
433     my ($t, $fileName, $fileAttr ) = @_;
434
435     my $conf = $t->{conf};
436     my $ftp  = $t->{ftp};
437
438     my $poolFile = $fileAttr->{fullPath};
439     my $fileDest = ( $conf->{ClientCharset} ne "" )
440                  ? from_to( "$fileAttr->{relPath}/$fileName",
441                             "utf8", $conf->{ClientCharset} )
442                  : "$fileAttr->{relPath}/$fileName";
443
444     #print STDERR "BackupPC::Xfer::Ftp->restoreFile($fileName)\n";
445
446     undef $@;
447     eval {
448         if ( $ftp->put( $poolFile, $fileDest ) ) {
449             $t->logFileAction( "restore", $fileName, $fileAttr );
450         } else {
451             $t->logFileAction( "fail", $fileName, $fileAttr );
452         }
453     };
454     if ($@) {
455         $t->logFileAction( "fail", $fileName, $fileAttr );
456     }
457 }
458
459
460 #
461 #  usage:
462 #   $t->backup($path);
463 #
464 # $t->backup() is a recursive function that takes a path as an
465 # argument, and performs a backup on that folder consistent with the
466 # configuration parameters.  $path is considered rooted at
467 # $t->{shareName}, so no $ftp->cwd() command is necessary.
468 #
469 sub backup
470 {
471     my ($t) =  @_;
472
473     my $ftp    = $t->{ftp};
474     my $bpc    = $t->{bpc};
475     my $conf   = $t->{conf};
476     my $TopDir = $bpc->TopDir();
477     my $OutDir = "$TopDir/pc/$t->{client}/new/"
478       . $bpc->fileNameEltMangle( $t->{shareName} );
479
480     #
481     # Prepare the view object
482     #
483     $t->{view} = BackupPC::View->new( $bpc, $t->{client}, $t->{backups} );
484
485     #
486     # Prepare backup folder
487     #
488     unless ( eval { mkpath( $OutDir, 0, 0755 ); } ) {
489         $t->{_errStr} = "can't create OutDir: $OutDir";
490         $t->{xferErrCnt}++;
491         return;
492     }
493
494     #
495     # determine the filetype of the shareName and back it up
496     # appropriately.  For now, assume that $t->{shareName} is a
497     # directory.
498     #
499     my $f = {
500               relPath  => "",
501               fullName => $t->{shareName},
502             };
503
504     if ( $t->handleDir( $f, $OutDir ) ) {
505
506         $t->{xferOK} = 1;
507         return 1;
508
509     } else {
510
511         $t->{xferBadShareCnt}++;
512         return;
513     }
514 }
515
516
517 ####################################################################################
518 # FTP-specific functions
519 ####################################################################################
520
521
522 #
523 # This is an encapulation of the logic necessary to grab the arguments
524 # from %Conf and throw it in a hash pointer to be passed to the
525 # Net::FTP object.
526 #
527 sub getFTPArgs
528 {
529     my ($t)  = @_;
530     my $conf = $t->{conf};
531
532     return {
533         Host         => $conf->{ClientNameAlias}
534                      || $t->{hostIP}
535                      || $t->{host},
536         Firewall     => undef,                            # not used
537         FirewallType => undef,                            # not used
538         BlockSize    => $conf->{FtpBlockSize} || 10240,
539         Port         => $conf->{FtpPort}      || 21,
540         Timeout      => $conf->{FtpTimeout}   || 120,
541         Debug        => 0,                                # do not touch
542         Passive      => 1,                                # do not touch
543         Hash         => undef,                            # do not touch
544         LocalAddr    => "localhost",                      # do not touch
545     };
546 }
547
548
549 #
550 #   usage:
551 #     $dirList = $t->remotels($path);
552 #
553 # remotels() returns a reference to a list of hash references that
554 # describe the contents of each file in the directory of the path
555 # specified.
556 #
557 # In the future, I would like to make this function return objects in
558 # Attrib format.  That would be very optimal, and I could probably
559 # release the code to CPAN.
560 #
561 sub remotels
562 {
563     my ( $t, $path ) = @_;
564
565     my $ftp  = $t->{ftp};
566     my $bpc  = $t->{bpc};
567     my $conf = $t->{conf};
568
569     my ( $dirContents, $remoteDir, $f );
570
571     undef $@;
572     eval {
573         $dirContents = ( $path =~ /^\.?$/ ) ? $ftp->dir()
574                                             : $ftp->dir("$path/");
575     };
576     if ($@) {
577         $t->{xferErrCnt}++;
578         return "can't retrieve remote directory contents of $path: $!";
579     }
580
581     foreach my $info ( @{parse_dir($dirContents)} ) {
582
583         $f = {
584             name  => $info->[0],
585             type  => $info->[1],
586             size  => $info->[2],
587             mtime => $info->[3],
588             mode  => $info->[4],
589         };
590
591         $f->{utf8name} = $f->{name};
592         from_to( $f->{utf8name}, $conf->{ClientCharset}, "utf8" )
593                                 if ( $conf->{ClientCharset} ne "" );
594
595         $f->{fullName} = "$t->{sharePath}/$path/$f->{name}";
596         $f->{fullName} =~ s/\/+/\//g;
597
598         $f->{relPath} = ($path eq "") ? $f->{name} : "$path/$f->{name}";
599         $f->{relPath} =~ s/\/+/\//g;
600
601         push( @$remoteDir, $f );
602     }
603     return $remoteDir;
604 }
605
606
607 #
608 # ignoreFileCheck() looks at the attributes of the arguments and the
609 # backup types, and determines if the file should be skipped in this
610 # backup.
611 #
612 sub ignoreFileCheck
613 {
614     my ( $t, $f, $attrib ) = @_;
615
616     if ( $f->{name} =~ /^\.\.?$/ ) {
617         return 1;
618     }
619
620     return ( !$t->checkIncludeExclude( $f->{fullName} ) );
621 }
622
623
624 #
625 # handleSymlink() backs up a symlink.
626 #
627 sub handleSymlink
628 {
629     my ( $t, $f, $OutDir, $attrib ) = @_;
630
631     my $conf = $t->{conf};
632     my $ftp  = $t->{ftp};
633     my ( $target, $targetDesc );
634
635     my $attribInfo = {
636         type  => BPC_FTYPE_SYMLINK,
637         mode  => $f->{mode},
638         uid   => undef,            # unsupported
639         gid   => undef,            # unsupported
640         size  => 0,
641         mtime => $f->{mtime},
642     };
643
644     #
645     # If we are following symlinks, back them up as the type of file
646     # they point to. Otherwise, backup the symlink.
647     #
648     if ( $conf->{FtpFollowSymlinks} ) {
649
650         #
651         # handle nested symlinks by recurring on the target until a
652         # file or directory is found.
653         #
654         $f->{type} =~ /^l (.*)/;
655         $target = $1;
656
657         undef $@;
658         eval {
659             if ( $targetDesc = $ftp->dir("$target/") ) {
660                 $t->handleSymDir( $f, $OutDir, $attrib, $targetDesc );
661
662             } elsif ( $targetDesc = $ftp->dir($target) ) {
663                 if ( $targetDesc->[4] eq 'file' ) {
664                     $t->handleSymFile( $f, $OutDir, $attrib );
665
666                 } elsif ( $targetDesc->[4] =~ /l (.*)/ ) {
667                     $t->logFileAction( "fail", $f->{utf8name}, $attribInfo );
668                     return;
669                 }
670             } else {
671                 $t->( "fail", $f );
672                 return;
673             }
674         };
675         if ($@) {
676             $t->logFileAction( "fail", $f->{utf8name}, $attribInfo );
677             return;
678         }
679
680     } else {
681         #
682         # If we are not following symlinks, record them normally.
683         #
684         $attrib->set( $f->{utf8name}, $attribInfo );
685         $t->logFileAction("create", $f->{utf8name}, $attribInfo);
686     }
687     return 1;
688 }
689
690
691 sub handleSymDir
692 {
693     my ($t, $fSym, $OutDir, $attrib, $targetDesc) = @_;
694
695     return 1;
696  }
697
698
699 sub handleSymFile
700 {
701     my ( $t, $fSym, $OutDir, $attrib, $targetDesc ) = @_;
702
703     my $bpc  = $t->{bpc};
704     my $conf = $t->{conf};
705
706     my $f = {
707         name  => $fSym->{name},
708         type  => $targetDesc->[1],
709         size  => $targetDesc->[2],
710         mtime => $targetDesc->[3],
711         mode  => $targetDesc->[4]
712     };
713
714     $f->{utf8name} = $fSym->{name};
715     from_to( $f->{utf8name}, $conf->{ClientCharset}, "utf8" )
716                             if ( $conf->{ClientCharset} ne "" );
717
718     $f->{relPath}  = $fSym->{relPath};
719     $f->{fullName} = "$t->{shareName}/$fSym->{relPath}/$fSym->{name}";
720     $f->{fullName} =~ s/\/+/\//g;
721
722     #
723     # since FTP servers follow symlinks, we can just do this:
724     #
725     return $t->handleFile( $f, $OutDir, $attrib );
726 }
727
728
729 #
730 # handleDir() backs up a directory, and initiates a backup of its
731 # contents.
732 #
733 sub handleDir
734 {
735     my ( $t, $dir, $OutDir ) = @_;
736
737     my $ftp   = $t->{ftp};
738     my $bpc   = $t->{bpc};
739     my $conf  = $t->{conf};
740     my $view  = $t->{view};
741     my $stats = $t->{stats};
742
743     my ( $exists, $digest, $outSize, $errs );
744     my ( $poolWrite, $poolFile, $attribInfo );
745     my ( $localDir, $remoteDir, $attrib, %expectedFiles );
746
747     if ( exists($dir->{utf8name})) {
748         $OutDir .= "/" . $bpc->fileNameMangle( $dir->{utf8name} );
749     }
750
751     unless ( -d $OutDir ) {
752
753         eval { mkpath( $OutDir, 0, 0755 ) };
754         if ( $@ ) {
755             $t->logFileAction( "fail", $dir->{utf8name}, $dir );
756             return;
757         } else {
758             $t->logFileAction( "create", $dir->{utf8name}, $dir );
759         }
760     }
761
762     $attrib    = BackupPC::Attrib->new( { compress => $t->{compress} } );
763     $remoteDir = $t->remotels( $dir->{relPath} );
764
765     if ( $t->{type} eq "incr" ) {
766         $localDir  = $view->dirAttrib( $t->{incrBaseBkupNum},
767                                        $t->{shareName}, $dir->{relPath} );
768         %expectedFiles = map { $_ => 0 } sort keys %$localDir
769     }
770
771     #
772     # take care of each file in the directory
773     #
774  SCAN: foreach my $f ( @{$remoteDir} ) {
775
776         next SCAN if $t->ignoreFileCheck( $f, $attrib );
777
778         #
779         # handle based on filetype
780         #
781         if ( $f->{type} eq 'f' ) {
782             $t->handleFile( $f, $OutDir, $attrib );
783
784         } elsif ( $f->{type} eq 'd' ) {
785
786             $attribInfo = {
787                 type  => BPC_FTYPE_DIR,
788                 mode  => $f->{mode},
789                 uid   => undef,           # unsupported
790                 gid   => undef,           # unsupported
791                 size  => $f->{size},
792                 mtime => $f->{mtime},
793             };
794
795             #print STDERR "$f->{utf8name}: ". Dumper($attribInfo);
796
797             if ( $t->handleDir($f, $OutDir) ) {
798                 $attrib->set( $f->{utf8name}, $attribInfo);
799             }
800
801         } elsif ( $f->{type} =~ /^l (.*)/ ) {
802             $t->handleSymlink( $f, $OutDir, $attrib );
803
804         } else {
805             #
806             # do nothing
807             #
808         }
809
810         #
811         # Mark file as seen in expected files hash
812         #
813         $expectedFiles{ $f->{utf8name} }++ if ( $t->{type} eq "incr" );
814
815     } # end foreach (@{$remoteDir})
816
817     #
818     # If the backup type is incremental, mark the files that are not
819     # present on the server as deleted.
820     #
821     if ( $t->{type} eq "incr" ) {
822         while ( my ($f, $seen) = each %expectedFiles ) {
823             $attrib->set( $f, { type => BPC_FTYPE_DELETED } )
824                 unless ($seen);
825         }
826     }
827
828     #
829     # print the directory attributes, now that the directory is done.
830     #
831     my $fileName = $attrib->fileName($OutDir);
832     my $data     = $attrib->writeData();
833
834     $poolWrite = BackupPC::PoolWrite->new( $bpc, $fileName, length($data),
835                                            $t->{compress} );
836     $poolWrite->write( \$data );
837     ( $exists, $digest, $outSize, $errs ) = $poolWrite->close();
838
839     #
840     # Explicit success
841     #
842     return 1;
843 }
844
845
846 #
847 # handleFile() backs up a file.
848 #
849 sub handleFile
850 {
851     my ( $t, $f, $OutDir, $attrib ) = @_;
852
853     my $bpc        = $t->{bpc};
854     my $ftp        = $t->{ftp};
855     my $view       = $t->{view};
856     my $stats      = $t->{stats};
857     my $newFilesFH = $t->{newFilesFH};
858
859     my ( $poolFile, $poolWrite, $data, $localSize );
860     my ( $exists, $digest, $outSize, $errs );
861     my ( $oldAttrib );
862     local *FTP;
863
864     #
865     # If this is an incremental backup and the file exists in a
866     # previous backup unchanged, write the attribInfo for the file
867     # accordingly.
868     #
869     if ( $t->{type} eq "incr" ) {
870         return 1 if $t->incrFileExistCheck( $f, $attrib );
871     }
872
873     my $attribInfo = {
874         %$f,
875         type  => BPC_FTYPE_FILE,
876         uid   => undef,            # unsupported
877         gid   => undef,            # unsupported
878     };
879     delete $attribInfo->{utf8name}; # unused value
880
881     #
882     # If this is a full backup or the file has changed on the host,
883     # back it up.
884     #
885     undef $@;
886     eval { tie ( *FTP, 'Net::FTP::RetrHandle', $ftp, $f->{fullName} ); };
887     if ( !*FTP || $@ ) {
888         $t->logFileAction( "fail", $f->{utf8name}, $attribInfo );
889         $t->{xferBadFileCnt}++;
890         $stats->{errCnt}++;
891         return;
892     }
893
894     $poolFile    = $OutDir . "/" .  $bpc->fileNameMangle( $f->{name} );
895     $poolWrite   = BackupPC::PoolWrite->new( $bpc, $poolFile, $f->{size},
896                                            $t->{compress} );
897
898     $localSize = 0;
899
900     undef $@;
901     eval {
902         while (<FTP>) {
903             $localSize += length($_);
904             $poolWrite->write( \$_ );
905         }
906     };
907     ( $exists, $digest, $outSize, $errs ) = $poolWrite->close();
908     if ( !*FTP || $@ || @$errs ) {
909
910         $t->logFileAction( "fail", $f->{utf8name}, $attribInfo );
911         unlink($poolFile);
912         $t->{xferBadFileCnt}++;
913         $stats->{errCnt} += scalar @$errs;
914         return;
915     }
916
917     #
918     # this should never happen
919     #
920     if ( $localSize != $f->{size} ) {
921         $t->logFileAction( "fail", $f->{utf8name}, $attribInfo );
922         unlink($poolFile);
923         $stats->{xferBadFileCnt}++;
924         $stats->{errCnt}++;
925         return;
926     }
927
928     #
929     # Perform logging
930     #
931     $attrib->set( $f->{utf8name}, $attribInfo );
932     $t->logFileAction( $exists ? "pool" : "create",
933                        $f->{utf8name}, $attribInfo );
934
935     my $relPoolFile = $bpc->fileNameEltMangle( $t->{shareName} )
936                     . "/"
937                     . $bpc->fileNameMangle($attribInfo->{relPath});
938
939     print $newFilesFH "$digest $f->{size} $relPoolFile\n" unless $exists;
940
941     #
942     # Cumulate the stats
943     #
944     $stats->{TotalFileCnt}++;
945     $stats->{ExistFileCnt}++;
946     $stats->{ExistFileCompSize} += -s $poolFile;
947     $stats->{ExistFileSize}     += $f->{size};
948     $stats->{TotalFileSize}     += $f->{size};
949
950     $t->{byteCnt} += $localSize;
951     $t->{fileCnt}++;
952 }
953
954
955 #
956 # this function checks if the file has been modified on disk, and if
957 # it has, returns.  Otherwise, it updates the attrib values.
958 #
959 sub incrFileExistCheck
960 {
961     my ($t, $f, $attrib) = @_;
962
963     my $view = $t->{view};
964
965     my $oldAttribInfo = $view->fileAttrib( $t->{incrBaseBkupNum},
966                                        $t->{shareName}, "/" . $f->{relPath} );
967
968     ##$t->logWrite( "Old attrib:\n" . Dumper($oldAttribInfo), 1 );
969     ##$t->logWrite( "New attrib:\n" . Dumper($f), 1 );
970     ##$t->logWrite( sprintf("%s: mtime %d vs %d, size %d vs %d\n", $f->{fullName},
971     ##              $oldAttribInfo->{mtime}, $f->{mtime},
972     ##              $oldAttribInfo->{size}, $f->{size}), 1);
973
974     return ( $oldAttribInfo->{mtime} == $f->{mtime}
975           && $oldAttribInfo->{size} == $f->{size} );
976 }
977
978
979 #
980 # Generate a log file message for a completed file.  Taken from
981 # BackupPC_tarExtract. $f should be an attrib object.
982 #
983 sub logFileAction
984 {
985     my ( $t, $action, $name, $attrib ) = @_;
986
987     my $owner = "$attrib->{uid}/$attrib->{gid}";
988     my $type =
989       ( ( "", "p", "c", "", "d", "", "b", "", "", "", "l", "", "s" ) )
990       [ ( $attrib->{mode} & S_IFMT ) >> 12 ];
991
992     $name  = "."   if ( $name  eq "" );
993     $owner = "-/-" if ( $owner eq "/" );
994
995     my $fileAction = sprintf(
996         "  %-6s %1s%4o %9s %11.0f %s\n",
997         $action, $type, $attrib->{mode} & 07777,
998         $owner, $attrib->{size}, $attrib->{relPath}
999     );
1000
1001     return $t->logWrite( $fileAction, 1 );
1002 }
1003
1004 1;