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