2b3c0014c7d42aa4595fba4234f95756f41799a0
[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 # Unreleased, planned release in 3.2 (or 3.1.1)
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     $args = $t->getFTPArgs();
178
179     #
180     # Create the Net::FTP::AutoReconnect or Net::FTP object.
181     #
182     unless ( $t->{ftp} = ($ARCLibOK) ? Net::FTP::AutoReconnect->new(%$args)
183                                      : Net::FTP->new(%$args) )
184     {
185         $t->{_errStr} = "Can't open connection to $args->{Host}";
186         $t->{xferErrCnt}++;
187         return;
188     }
189
190     #
191     # Log in to the ftp server and set appropriate path information.
192     #
193     unless ( $t->{ftp}->login( $conf->{FtpUserName}, $conf->{FtpPasswd} ) ) {
194         $t->{_errStr} = "Can't login to $args->{Host}";
195         $t->{xferErrCnt}++;
196         return;
197     }
198
199     unless ( $t->{ftp}->binary() ) {
200         $t->{_errStr} = "Can't enable binary transfer mode to $args->{Host}";
201         $t->{xferErrCnt}++;
202         return;
203     }
204
205     unless (    ( $t->{shareName} =~ m/^\.?$/ )
206              || ( $t->{ftp}->cwd( $t->{shareName} ) ) )
207     {
208         $t->{_errStr} = "Can't change working directory to $t->{shareName}";
209         $t->{xferErrCnt}++;
210         return;
211     }
212
213     unless  ( $t->{sharePath} = $t->{ftp}->pwd() ) {
214         $t->{_errStr} = "Can't retrieve full working directory of $t->{shareName}";
215         $t->{xferErrCnt}++;
216         return;
217     }
218
219     #
220     # log the beginning of action based on type
221     #
222     if ( $t->{type} eq 'restore' ) {
223         $logMsg = "restore started on directory $t->{shareName}";
224
225     } elsif ( $t->{type} eq 'full' ) {
226         $logMsg = "full backup started on directory $t->{shareName}";
227
228     } elsif ( $t->{type} eq 'incr' ) {
229
230         $incrDate = $bpc->timeStamp( $t->{incrBaseTime} - 3600, 1 );
231         $logMsg = "incremental backup started back to $incrDate" .
232             " (backup #$t->{incrBaseBkupNum}) for directory" . "
233             $t->{shareName}";
234     }
235
236     #
237     # call the recursive function based on the type of action
238     #
239     if ( $t->{type} eq 'restore' ) {
240
241         $t->restore();
242         $logMsg = "Restore of $args->{Host} complete";
243
244     } elsif ( $t->{type} eq 'incr' ) {
245
246         $t->backup();
247         $logMsg = "Incremental backup of $args->{Host} complete";
248
249     } elsif ( $t->{type} eq 'full' ) {
250
251         $t->backup();
252         $logMsg = "Full backup of $args->{Host} complete";
253     }
254
255     delete $t->{_errStr};
256     return $logMsg;
257 }
258
259
260 #
261 #
262 #
263 sub run
264 {
265     my ($t) = @_;
266     my $stats = $t->{stats};
267
268     my ( $tarErrs,      $nFilesExist, $sizeExist,
269          $sizeExistCom, $nFilesTotal, $sizeTotal );
270
271     #
272     # TODO: replace the $stats array with variables at the top level,
273     # ones returned by $getStats.  They should be identical.
274     #
275     $tarErrs      = 0;
276     $nFilesExist  = $stats->{ExistFileCnt};
277     $sizeExist    = $stats->{ExistFileSize};
278     $sizeExistCom = $stats->{ExistFileCompSize};
279     $nFilesTotal  = $stats->{TotalFileCnt};
280     $sizeTotal    = $stats->{TotalFileSize};
281
282     if ( $t->{type} eq "restore" ) {
283         return ( $t->{fileCnt}, $t->{byteCnt}, 0, 0 );
284
285     } else {
286         return \( $tarErrs,      $nFilesExist, $sizeExist,
287                   $sizeExistCom, $nFilesTotal, $sizeTotal );
288     }
289 }
290
291
292 #
293 #   usage:
294 #     $t->restore();
295 #
296 # TODO: finish or scuttle this function.  It is not necessary for a
297 # release.
298 #
299 sub restore
300 {
301     my $t = @_;
302
303     my $bpc = $t->{bpc};
304     my $fileList = $t->{fileList};
305
306     my ($path, $fileName, $fileAttr, $fileType );
307
308     #print STDERR "BackupPC::Xfer::Ftp->restore()";
309
310     #
311     # Prepare the view object
312     #
313     $t->{view} = BackupPC::View->new( $bpc, $t->{bkupSrcHost},
314                                       $t->{backups} );
315     my $view = $t->{view};
316
317   SCAN: foreach my $f ( @$fileList ) {
318
319         #print STDERR "restoring $f...\n";
320
321         $f =~ /(.*)\/([^\/]*)/;
322         $path     = $1;
323         $fileName = $2;
324
325         $view->dirCache($path);
326
327         $fileAttr = $view->fileAttrib($fileName);
328         $fileType = fileType2Text( $fileAttr->{type} );
329
330         if ( $fileType eq "dir") {
331             $t->restoreDir($fileName, $fileAttr);
332
333         } elsif ( $fileType eq "file" ) {
334             $t->restoreFile($fileName, $fileAttr);
335
336         } elsif ( $fileType eq "symlink" ) {
337             #
338             # ignore
339             #
340         } else {
341             #
342             # ignore
343             #
344         }
345     } # end SCAN
346 }
347
348
349 sub restoreDir
350 {
351     my ( $t, $dirName, $dirAttr ) = @_;
352
353     my $ftp    = $t->{ftp};
354     my $bpc    = $t->{bpc};
355     my $conf   = $t->{conf};
356     my $view   = $t->{view};
357     my $TopDir = $bpc->TopDir();
358
359     my $path    = "$dirAttr->{relPath}/$dirName";
360     my $dirList = $view->dirAttrib( -1, $t->{shareName}, $path );
361
362     my ( $fileName, $fileAttr, $fileType );
363
364     #print STDERR "BackupPC::Xfer::Ftp->restore($dirName)\n";
365
366     #
367     # Create the remote directory
368     #
369     unless ( $ftp->mkdir( $path, 1 ) ) {
370
371         $t->logFileAction( "fail", $dirName, $dirAttr );
372         return;
373     }
374
375  SCAN: while ( ($fileName, $fileAttr ) = each %$dirList ) {
376
377         $fileType = fileType2Text( $fileAttr->{type} );
378
379         if ( $fileType eq "dir" ) {
380             if ( $t->restoreDir( $fileName, $fileAttr ) ) {
381                 $t->logWrite( "restored: $path/$fileName\n", 5 );
382             } else {
383                 $t->logWrite( "restore failed: $path/$fileName\n", 3 );
384             }
385
386         } elsif ( $fileType eq "file" ) {
387             $t->restoreFile( $fileName, $fileAttr );
388
389         } elsif ( $fileType eq "hardlink" ) {
390             #
391             # Hardlinks cannot be restored.  however, if we have the
392             # target file in the pool, we can restore that.
393             #
394             $t->restoreFile( $fileName, $fileAttr );
395
396             next SCAN;
397
398         } elsif ( $fileType eq "symlink" ) {
399             #
400             # Symlinks cannot be restored
401             #
402             next SCAN;
403
404         } else {
405             #
406             # Ignore all other types (devices, doors, etc)
407             #
408             next SCAN;
409         }
410     }
411 }
412
413
414 sub restoreFile
415 {
416     my ($t, $fileName, $fileAttr ) = @_;
417
418     my $conf = $t->{conf};
419     my $ftp  = $t->{ftp};
420
421     my $poolFile = $fileAttr->{fullPath};
422     my $fileDest = ( $conf->{ClientCharset} ne "" )
423                  ? from_to( "$fileAttr->{relPath}/$fileName",
424                             "utf8", $conf->{ClientCharset} )
425                  : "$fileAttr->{relPath}/$fileName";
426
427     #print STDERR "BackupPC::Xfer::Ftp->restoreFile($fileName)\n";
428
429     #
430     # Note: is logging necessary here?
431     #
432     if ( $ftp->put( $poolFile, $fileDest ) ) {
433         $t->logFileAction("restore", $fileName, $fileAttr);
434
435     } else {
436         $t->logFileAction("fail", $fileName, $fileAttr);
437     }
438 }
439
440
441 #
442 #  usage:
443 #   $t->backup($path);
444 #
445 # $t->backup() is a recursive function that takes a path as an
446 # argument, and performs a backup on that folder consistent with the
447 # configuration parameters.  $path is considered rooted at
448 # $t->{shareName}, so no $ftp->cwd() command is necessary.
449 #
450 sub backup
451 {
452     my ($t) =  @_;
453
454     my $ftp    = $t->{ftp};
455     my $bpc    = $t->{bpc};
456     my $conf   = $t->{conf};
457     my $TopDir = $bpc->TopDir();
458     my $OutDir = "$TopDir/pc/$t->{client}/new/"
459       . $bpc->fileNameEltMangle( $t->{shareName} );
460
461     #
462     # Prepare the view object
463     #
464     $t->{view} = BackupPC::View->new( $bpc, $t->{client}, $t->{backups} );
465
466     #
467     # Prepare backup folder
468     #
469     unless ( mkpath( $OutDir, 0, 0755 ) ) {
470         $t->{_errStr} = "can't create OutDir: $OutDir";
471         $t->{xferErrCnt}++;
472         return;
473     }
474
475     #
476     # determine the filetype of the shareName and back it up
477     # appropriately.  For now, assume that $t->{shareName} is a
478     # directory.
479     #
480     my $f = {
481               relPath  => "",
482               fullName => $t->{shareName},
483             };
484
485     if ( $t->handleDir( $f, $OutDir ) ) {
486
487         $t->{xferOK} = 1;
488         return 1;
489
490     } else {
491
492         $t->{xferBadShareCnt}++;
493         return;
494     }
495 }
496
497
498 ####################################################################################
499 # FTP-specific functions
500 ####################################################################################
501
502
503 #
504 # This is an encapulation of the logic necessary to grab the arguments
505 # from %Conf and throw it in a hash pointer to be passed to the
506 # Net::FTP object.
507 #
508 sub getFTPArgs
509 {
510     my ($t)  = @_;
511     my $bpc  = $t->{bpc};
512     my $conf = $t->{conf};
513
514     #
515     # accepted default key => value pairs to Net::FTP
516     #
517     my $args = {
518                  Host         => undef,
519                  Firewall     => undef,          # not used
520                  FirewallType => undef,          # not used
521                  BlockSize    => 10240,
522                  Port         => 21,
523                  Timeout      => 120,
524                  Debug        => 0,              # do not touch
525                  Passive      => 1,              # do not touch
526                  Hash         => undef,          # do not touch
527                  LocalAddr    => "localhost",    # do not touch
528                };
529
530     #
531     # This is mostly to fool makeDist
532     #
533     exists( $conf->{ClientNameAlias} ) && exists( $conf->{FtpBlockSize} ) &&
534     exists( $conf->{FtpPort} )         && exists( $conf->{FtpTimeout} )
535         or die "Configuration variables for FTP not present in config.pl";
536
537     #
538     # map of options from %Conf in the config.pl scripts to options
539     # the Net::FTP::AutoReconnect object.
540     #
541     my $argMap = {
542                    "Host"      => "ClientNameAlias",
543                    "BlockSize" => "FtpBlockSize",
544                    "Port"      => "FtpPort",
545                    "Timeout"   => "FtpTimeout",
546                  };
547
548     foreach my $key ( keys(%$args) ) {
549         $args->{$key} = $conf->{ $argMap->{$key} } || $args->{$key};
550     }
551
552     #
553     # Fix for $args->{Host} since it can be in more than one location.
554     # Note the precedence here, this may need to be fixed.  Order of
555     # precedence:
556     #   $conf->{ClientNameAlias}
557     #   $t->{hostIP}
558     #   $t->{host}
559     #
560     $args->{Host} ||= $t->{hostIP};
561     $args->{Host} ||= $t->{host};
562
563     #
564     # return the reference to the hash of items
565     #
566     return $args;
567 }
568
569
570 #
571 #   usage:
572 #     $dirList = $t->remotels($path);
573 #
574 # remotels() returns a reference to a list of hash references that
575 # describe the contents of each file in the directory of the path
576 # specified.
577 #
578 # In the future, I would like to make this function return objects in
579 # Attrib format.  That would be very optimal, and I could probably
580 # release the code to CPAN.
581 #
582 sub remotels
583 {
584     my ( $t, $path ) = @_;
585
586     my $ftp  = $t->{ftp};
587     my $bpc  = $t->{bpc};
588     my $conf = $t->{conf};
589
590     my ( $dirContents, $remoteDir, $f );
591
592     unless ( $dirContents = ($path =~ /^\.?$/ ) ? $ftp->dir() :
593                                                   $ftp->dir("$path/") )
594     {
595         $t->{xferErrCnt}++;
596         return "can't retrieve remote directory contents of $path";
597     }
598
599     foreach my $info ( @{parse_dir($dirContents)} ) {
600
601         $f = {
602                name   => $info->[0],
603                type   => $info->[1],
604                size   => $info->[2],
605                mtime  => $info->[3],
606                mode   => $info->[4],
607              };
608
609         #
610         # convert & store utf8 version of filename
611         #
612         $f->{utf8name} = $f->{name};
613         from_to( $f->{utf8name}, $conf->{ClientCharset}, "utf8" );
614
615         #
616         # construct the full name
617         #
618         $f->{fullName} = "$t->{sharePath}/$path/$f->{name}";
619         $f->{fullName} =~ s/\/+/\//g;
620
621         $f->{relPath} = ($path eq "") ? $f->{name} : "$path/$f->{name}";
622         $f->{relPath} =~ s/\/+/\//g;
623
624         push( @$remoteDir, $f );
625     }
626
627     return $remoteDir;
628 }
629
630
631 #
632 # ignoreFileCheck() looks at the attributes of the arguments and the
633 # backup types, and determines if the file should be skipped in this
634 # backup.
635 #
636 sub ignoreFileCheck
637 {
638     my ( $t, $f, $attrib ) = @_;
639
640     #
641     # case for ignoring the files '.' & '..'
642     #
643     if ( $f->{name} =~ /^\.\.?$/ ) {
644         return 1;
645     }
646
647     #
648     # Check the include/exclude lists.  the function returns true if
649     # the file should be backed up, so return the opposite.
650     #
651     return ( !$t->checkIncludeExclude( $f->{fullName} ) );
652 }
653
654
655 #
656 # handleSymlink() backs up a symlink.
657 #
658 sub handleSymlink
659 {
660     my ( $t, $f, $OutDir, $attrib ) = @_;
661
662     my $conf = $t->{conf};
663     my $ftp  = $t->{ftp};
664     my ( $target, $targetDesc );
665
666     my $attribInfo = {
667         type  => BPC_FTYPE_SYMLINK,
668         mode  => $f->{mode},
669         uid   => undef,            # unsupported
670         gid   => undef,            # unsupported
671         size  => 0,
672         mtime => $f->{mtime},
673     };
674
675     #
676     # If we are following symlinks, back them up as the type of file
677     # they point to. Otherwise, backup the symlink.
678     #
679     if ( $conf->{FtpFollowSymlinks} ) {
680
681         #
682         # handle nested symlinks by recurring on the target until a
683         # file or directory is found.
684         #
685         $f->{type} =~ /^l (.*)/;
686         $target = $1;
687
688         if ( $targetDesc = $ftp->dir("$target/") ) {
689             $t->handleSymDir( $f, $OutDir, $attrib, $targetDesc );
690
691         } elsif ( $targetDesc = $ftp->dir($target) ) {
692             if ( $targetDesc->[4] eq 'file' ) {
693                 $t->handleSymFile( $f, $OutDir, $attrib );
694
695             } elsif ( $targetDesc->[4] =~ /l (.*)/) {
696
697                 $t->logFileAction("fail", $f->{utf8name}, $attribInfo);
698                 return;
699             }
700         } else {
701
702             $t->("fail", $f);
703             return;
704         }
705
706     } else {
707
708         #
709         # If we are not following symlinks, record them normally.
710         #
711         $attrib->set( $f->{utf8name}, $attribInfo );
712         $t->logFileAction("create", $f->{utf8name}, $attribInfo);
713     }
714     return 1;
715 }
716
717
718 sub handleSymDir
719 {
720     my ($t, $fSym, $OutDir, $attrib, $targetDesc) = @_;
721
722     return 1;
723  }
724
725
726 sub handleSymFile
727 {
728     my ( $t, $fSym, $OutDir, $attrib, $targetDesc ) = @_;
729
730     my $bpc  = $t->{bpc};
731     my $conf = $t->{conf};
732
733     my $f = {
734               name  => $fSym->{name},
735               type  => $targetDesc->[1],
736               size  => $targetDesc->[2],
737               mtime => $targetDesc->[3],
738               mode  => $targetDesc->[4]
739             };
740
741     $f->{utf8name} = $fSym->{name};
742     from_to( $f->{utf8name}, $conf->{ClientCharset}, "utf8" );
743
744     $f->{relPath} = $fSym->{relPath};
745
746     $f->{fullName} = "$t->{shareName}/$fSym->{relPath}/$fSym->{name}";
747     $f->{fullName} =~ s/\/+/\//g;
748
749     #
750     # since FTP servers follow symlinks, we can jsut do this:
751     #
752     return $t->handleFile( $f, $OutDir, $attrib );
753 }
754
755
756 #
757 # handleDir() backs up a directory, and initiates a backup of its
758 # contents.
759 #
760 sub handleDir
761 {
762     my ( $t, $dir, $OutDir ) = @_;
763
764     my $ftp   = $t->{ftp};
765     my $bpc   = $t->{bpc};
766     my $conf  = $t->{conf};
767     my $view  = $t->{view};
768     my $stats = $t->{stats};
769
770     my ( $exists, $digest, $outSize, $errs );
771     my ( $poolWrite, $poolFile, $attribInfo );
772     my ( $localDir, $remoteDir, $attrib, %expectedFiles );
773
774     if ( exists($dir->{utf8name})) {
775         $OutDir .= "/" . $bpc->fileNameMangle( $dir->{utf8name} );
776     }
777
778     unless ( -d $OutDir ) {
779
780         mkpath( $OutDir, 0, 0755 );
781         $t->logFileAction( "create", $dir->{utf8name}, $dir );
782     }
783
784     $attrib    = BackupPC::Attrib->new( { compress => $t->{Compress} } );
785     $remoteDir = $t->remotels( $dir->{relPath} );
786
787     if ( $t->{type} eq "incr" ) {
788         $localDir  = $view->dirAttrib( $t->{incrBaseBkupNum},
789                                        $t->{shareName}, $dir->{relPath} );
790         %expectedFiles = map { $_ => 0 } sort keys %$localDir
791     }
792
793     #
794     # take care of each file in the directory
795     #
796  SCAN: foreach my $f ( @{$remoteDir} ) {
797
798         next SCAN if $t->ignoreFileCheck( $f, $attrib );
799
800         #
801         # handle based on filetype
802         #
803         if ( $f->{type} eq 'f' ) {
804             $t->handleFile( $f, $OutDir, $attrib );
805
806         } elsif ( $f->{type} eq 'd' ) {
807
808             $attribInfo = {
809                 type  => BPC_FTYPE_DIR,
810                 mode  => $f->{mode},
811                 uid   => undef,           # unsupported
812                 gid   => undef,           # unsupported
813                 size  => $f->{size},
814                 mtime => $f->{mtime},
815             };
816
817             #print STDERR "$f->{utf8name}: ". Dumper($attribInfo);
818
819             if ( $t->handleDir($f, $OutDir) ) {
820                 $attrib->set( $f->{utf8name}, $attribInfo);
821             }
822
823         } elsif ( $f->{type} =~ /^l (.*)/ ) {
824             $t->handleSymlink( $f, $OutDir, $attrib );
825
826         } else {
827             #
828             # do nothing
829             #
830         }
831
832         #
833         # Mark file as seen in expected files hash
834         #
835         $expectedFiles{ $f->{utf8name} }++ if ( $t->{type} eq "incr" );
836
837     } # end foreach (@{$remoteDir})
838
839     #
840     # If the backup type is incremental, mark the files that are not
841     # present on the server as deleted.
842     #
843     if ( $t->{type} eq "incr" ) {
844         while ( my ($f, $seen) = each %expectedFiles ) {
845             $attrib->set( $f, { type => BPC_FTYPE_DELETED } )
846                 unless ($seen);
847         }
848     }
849
850     #
851     # print the directory attributes, now that the directory is done.
852     #
853     my $fileName = $attrib->fileName($OutDir);
854     my $data     = $attrib->writeData();
855
856     $poolWrite = BackupPC::PoolWrite->new( $bpc, $fileName, length($data),
857                                            $t->{Compress} );
858     $poolWrite->write( \$data );
859     ( $exists, $digest, $outSize, $errs ) = $poolWrite->close();
860
861     #
862     # Explicit success
863     #
864     return 1;
865 }
866
867
868 #
869 # handleFile() backs up a file.
870 #
871 sub handleFile
872 {
873     my ( $t, $f, $OutDir, $attrib ) = @_;
874
875     my $bpc        = $t->{bpc};
876     my $ftp        = $t->{ftp};
877     my $view       = $t->{view};
878     my $stats      = $t->{stats};
879     my $newFilesFH = $t->{newFilesFH};
880
881     my ( $poolFile, $poolWrite, $data, $localSize );
882     my ( $exists, $digest, $outSize, $errs );
883     my ( $oldAttrib );
884     local *FTP;
885
886     #
887     # If this is an incremental backup and the file exists in a
888     # previous backup unchanged, write the attribInfo for the file
889     # accordingly.
890     #
891     if ( $t->{type} eq "incr" ) {
892         return 1 if $t->incrFileExistCheck( $f, $attrib );
893     }
894
895     my $attribInfo = {
896                        type  => BPC_FTYPE_FILE,
897                        mode  => $f->{mode},
898                        uid   => undef,            # unsupported
899                        gid   => undef,            # unsupported
900                        size  => $f->{size},
901                        mtime => $f->{mtime},
902                      };
903
904     #
905     # If this is a full backup or the file has changed on the host,
906     # back it up.
907     #
908     unless ( tie( *FTP, 'Net::FTP::RetrHandle', $ftp, $f->{fullName} ) ) {
909
910         $t->handleFileAction( "fail", $attribInfo );
911         $t->{xferBadFileCnt}++;
912         $stats->{errCnt}++;
913         return;
914     }
915
916     $poolFile  = $OutDir . "/" . $bpc->fileNameMangle( $f->{name} );
917     $poolWrite = BackupPC::PoolWrite->new( $bpc, $poolFile, $f->{size},
918                                            $bpc->{xfer}{compress} );
919
920     $localSize = 0;
921     while (<FTP>) {
922
923         $localSize += length($_);
924         $poolWrite->write( \$_ );
925     }
926     ( $exists, $digest, $outSize, $errs ) = $poolWrite->close();
927
928     #
929     # calculate the file statistics
930     #
931     if (@$errs) {
932
933         $t->logFileAction( "fail", $f->{utf8name}, $attribInfo );
934         unlink($poolFile);
935         $t->{xferBadFileCnt}++;
936         $t->{errCnt} += scalar(@$errs);
937         return;
938     }
939
940     #
941     # this should never happen
942     #
943     if ( $localSize != $f->{size} ) {
944
945         $t->logFileAction( "fail", $f->{utf8name}, $attribInfo );
946         unklink($poolFile);
947         $stats->{xferBadFileCnt}++;
948         $stats->{errCnt}++;
949         return;
950     }
951
952     #
953     # Perform logging
954     #
955     $attrib->set( $f->{utf8name}, $attribInfo );
956     $t->logFileAction( $exists ? "pool" : "create", $f->{utf8name}, $attribInfo );
957     print $newFilesFH "$digest $f->{size} $poolFile\n" unless $exists;
958
959     #
960     # Cumulate the stats
961     #
962     $stats->{TotalFileCnt}++;
963     $stats->{ExistFileCnt}++;
964     $stats->{ExistFileCompSize} += -s $poolFile;
965     $stats->{ExistFileSize}     += $f->{size};
966     $stats->{TotalFileSize}     += $f->{size};
967
968     $t->{byteCnt} += $localSize;
969     $t->{fileCnt}++;
970 }
971
972
973 #
974 # this function checks if the file has been modified on disk, and if
975 # it has, returns.  Otherwise, it updates the attrib values.
976 #
977 sub incrFileExistCheck
978 {
979     my ($t, $f, $attrib) = @_;
980
981     my $view = $t->{view};
982
983     my $oldAttribInfo = $view->fileAttrib( $t->{incrBaseBkupNum},
984                                        $t->{shareName}, $f->{relPath} );
985
986     #print STDERR "*" x 50 . "\n";
987     #print STDERR "Old data:\n" . Dumper($oldAttribInfo);
988     #print STDERR "New data:\n" . Dumper($f);
989     #print STDERR "$f->{fullName}: $oldAttribInfo->{mtime} ?= $f->{mtime}, $oldAttribInfo->{size} ?= $f->{size}\n";
990
991     return ( $oldAttribInfo->{mtime} == $f->{mtime}
992           && $oldAttribInfo->{size} == $f->{size} );
993 }
994
995
996 #
997 # Generate a log file message for a completed file.  Taken from
998 # BackupPC_tarExtract. $f should be an attrib object.
999 #
1000 sub logFileAction
1001 {
1002     my ( $t, $action, $name, $attrib ) = @_;
1003
1004     my $owner = "$attrib->{uid}/$attrib->{gid}";
1005     my $type =
1006       ( ( "", "p", "c", "", "d", "", "b", "", "", "", "l", "", "s" ) )
1007       [ ( $attrib->{mode} & S_IFMT ) >> 12 ];
1008
1009     $name  = "."   if ( $name  eq "" );
1010     $owner = "-/-" if ( $owner eq "/" );
1011
1012     my $fileAction = sprintf( "  %-6s %1s%4o %9s %11.0f %s\n",
1013                               $action, $type, $attrib->{mode} & 07777,
1014                               $owner, $attrib->{size}, $name );
1015
1016     return $t->logWrite( $fileAction, 1 );
1017 }
1018
1019 1;