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 modify
17#   it under the terms of the GNU General Public License as published by
18#   the Free Software Foundation, either version 3 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, see <http://www.gnu.org/licenses/>.
28#
29#========================================================================
30#
31# Version 4.3.3, released 5 Apr 2020.
32#
33# See http://backuppc.sourceforge.net.
34#
35#========================================================================
36
37package BackupPC::Xfer::Ftp;
38
39use strict;
40
41use BackupPC::Lib;
42use BackupPC::View;
43use BackupPC::DirOps;
44use BackupPC::XS qw(:all);
45
46use Encode qw/from_to encode/;
47use File::Listing qw/parse_dir/;
48use Fcntl ':mode';
49use File::Path;
50use Data::Dumper;
51use base qw(BackupPC::Xfer::Protocol);
52
53use vars qw( $FTPLibOK $FTPLibErr $ARCLibOK );
54
55BEGIN {
56
57    $FTPLibOK = 1;
58    $ARCLibOK = 0;
59
60    #
61    # clear eval error variable
62    #
63    my @FTPLibs = qw( Net::FTP Net::FTP::RetrHandle );
64
65    foreach my $module ( @FTPLibs ) {
66
67        undef $@;
68        eval "use $module;";
69
70        if ( $@ ) {
71            $FTPLibOK = 0;
72            $FTPLibErr = "module $module doesn't exist: $@";
73            last;
74        }
75    }
76
77    eval "use Net::FTP::AutoReconnect;";
78    $ARCLibOK = (defined($@)) ? 1 : 0;
79    #
80    # TODO
81    #
82    $ARCLibOK = 0;
83};
84
85##############################################################################
86# Constructor
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#
96sub 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# 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#
129sub start
130{
131    my($t) = @_;
132
133    my $bpc  = $t->{bpc};
134    my $conf = $t->{conf};
135    my $TopDir = $bpc->TopDir();
136
137    my ( @fileList, $logMsg, $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    $t->{shareNamePath} = $t->shareName2Path($t->{shareName});
171    from_to( $args->{shareNamePath}, "utf8", $conf->{ClientCharset} )
172                                if ( $conf->{ClientCharset} ne "" );
173
174    #
175    # Collect FTP configuration arguments and translate them for
176    # passing to the FTP module.
177    #
178    unless ( $args = $t->getFTPArgs() ) {
179        return;
180    }
181
182    #
183    # Create the Net::FTP::AutoReconnect or Net::FTP object.
184    #
185    undef $@;
186    eval {
187        $t->{ftp} = ($ARCLibOK) ? Net::FTP::AutoReconnect->new(%$args)
188                                : Net::FTP->new(%$args);
189    };
190    if ( $@ || !defined($t->{ftp}) ) {
191        $t->{_errStr} = "Can't open ftp connection to $args->{Host}: $!";
192        $t->{xferErrCnt}++;
193        return;
194    }
195    $t->logWrite("Connected to $args->{Host}\n", 2);
196
197    #
198    # Log in to the ftp server and set appropriate path information.
199    #
200    undef $@;
201    my $ret;
202    eval { $ret = $t->{ftp}->login( $conf->{FtpUserName}, $conf->{FtpPasswd} ); };
203    if ( !$ret ) {
204        $t->{_errStr} = "Can't ftp login to $args->{Host} (user = $conf->{FtpUserName}), $@";
205        $t->{xferErrCnt}++;
206        return;
207    }
208    $t->logWrite("Login successful to $conf->{FtpUserName}\@$args->{Host}\n", 2);
209
210    eval { $ret = $t->{ftp}->binary(); };
211    if ( !$ret ) {
212        $t->{_errStr} =
213          "Can't enable ftp binary transfer mode to $args->{Host}: " . $t->{ftp}->message();
214        $t->{xferErrCnt}++;
215        return;
216    }
217    $t->logWrite("Binary command successful\n", 2);
218
219    eval { $ret = $t->{ftp}->cwd( $t->{shareNamePath} ); };
220    if ( !$ret ) {
221        $t->{_errStr} =
222            "Can't change working directory to $t->{shareNamePath}: " . $t->{ftp}->message();
223        $t->{xferErrCnt}++;
224        return;
225    }
226    $t->logWrite("Set cwd to $t->{shareNamePath}\n", 2);
227
228    #
229    # log the beginning of action based on type
230    #
231    if ( $t->{type} eq 'restore' ) {
232        $logMsg = "ftp restore for host $t->{host} started on directory "
233          . "$t->{shareName}";
234
235    } elsif ( $t->{type} eq 'full' ) {
236        $logMsg = "ftp full backup for host $t->{host} started on directory "
237          . "$t->{shareName}";
238
239    } elsif ( $t->{type} eq 'incr' ) {
240        $logMsg = "ftp incremental backup for $t->{host} started for directory "
241                . "$t->{shareName}";
242    }
243    $logMsg .= " (client path $t->{shareNamePath})" if ( $t->{shareName} ne $t->{shareNamePath} );
244    $t->logWrite($logMsg . "\n", 1);
245
246    #
247    # call the recursive function based on the type of action
248    #
249    if ( $t->{type} eq 'restore' ) {
250
251        $t->restore();
252        $logMsg = "Restore of $t->{host} "
253                . ($t->{xferOK} ? "complete" : "failed");
254
255    } else {
256        $t->{compress}    = $t->{backups}[$t->{newBkupIdx}]{compress};
257        $t->{newBkupNum}  = $t->{backups}[$t->{newBkupIdx}]{num};
258        $t->{lastBkupNum} = $t->{backups}[$t->{lastBkupIdx}]{num};
259        $t->{AttrNew}     = BackupPC::XS::AttribCache::new($t->{client}, $t->{newBkupNum}, $t->{shareName},
260                                                           $t->{compress});
261        $t->{DeltaNew}    = BackupPC::XS::DeltaRefCnt::new("$TopDir/pc/$t->{client}/$t->{newBkupNum}");
262        $t->{AttrNew}->setDeltaInfo($t->{DeltaNew});
263
264        $t->{Inode} = 1;
265	for ( my $i = 0 ; $i < @{$t->{backups}} ; $i++ ) {
266	    $t->{Inode} = $t->{backups}[$i]{inodeLast} + 1 if ( $t->{Inode} <= $t->{backups}[$i]{inodeLast} );
267	}
268        $t->{Inode0} = $t->{Inode};
269
270        if ( !$t->{inPlace} ) {
271            $t->{AttrOld}  = BackupPC::XS::AttribCache::new($t->{client}, $t->{lastBkupNum}, $t->{shareName},
272                                                           $t->{compress});
273            $t->{DeltaOld} = BackupPC::XS::DeltaRefCnt::new("$TopDir/pc/$t->{client}/$t->{lastBkupNum}");
274            $t->{AttrOld}->setDeltaInfo($t->{DeltaOld});
275        }
276        $t->logWrite("ftp inPlace = $t->{inPlace}, newBkupNum = $t->{newBkupNum}, lastBkupNum = $t->{lastBkupNum}\n", 4);
277        $bpc->flushXSLibMesgs();
278
279        $t->backup();
280
281        $t->{AttrNew}->flush(1);
282        $bpc->flushXSLibMesgs();
283        if ( $t->{AttrOld} ) {
284            $t->{AttrOld}->flush(1);
285            $bpc->flushXSLibMesgs();
286        }
287
288        if ( $t->{logLevel} >= 6 ) {
289            print("RefCnt Deltas for new #$t->{newBkupNum}\n");
290            $t->{DeltaNew}->print();
291            if ( $t->{DeltaOld} ) {
292                print("RefCnt Deltas for old #$t->{lastBkupNum}\n");
293                $t->{DeltaOld}->print();
294            }
295        }
296        $bpc->flushXSLibMesgs();
297        $t->{DeltaNew}->flush();
298        $t->{DeltaOld}->flush() if ( $t->{DeltaOld} );
299
300        if ( $t->{type} eq 'incr' ) {
301            $logMsg = "Incremental backup of $t->{host} "
302                    . ($t->{xferOK} ? "complete" : "failed");
303        } else {
304            $logMsg = "Full backup of $t->{host} "
305                    . ($t->{xferOK} ? "complete" : "failed");
306        }
307        return if ( !$t->{xferOK} && defined($t->{_errStr}) );
308    }
309
310    delete $t->{_errStr};
311    return $logMsg;
312}
313
314
315#
316#
317#
318sub run
319{
320    my ($t) = @_;
321    my $stats = $t->{stats};
322
323    my ( $tarErrs,      $nFilesExist, $sizeExist,
324         $sizeExistCom, $nFilesTotal, $sizeTotal );
325
326    #
327    # TODO: replace the $stats array with variables at the top level,
328    # ones returned by $getStats.  They should be identical.
329    #
330    $tarErrs      = 0;
331    $nFilesExist  = $stats->{ExistFileCnt};
332    $sizeExist    = $stats->{ExistFileSize};
333    $sizeExistCom = $stats->{ExistFileCompSize};
334    $nFilesTotal  = $stats->{TotalFileCnt};
335    $sizeTotal    = $stats->{TotalFileSize};
336
337    if ( $t->{type} eq "restore" ) {
338        return ( $t->{fileCnt}, $t->{byteCnt}, 0, 0 );
339
340    } else {
341        return ( $tarErrs,      $nFilesExist, $sizeExist,
342                 $sizeExistCom, $nFilesTotal, $sizeTotal );
343    }
344}
345
346
347sub restore
348{
349    my($t) = @_;
350
351    my $bpc = $t->{bpc};
352    my $fileList = $t->{fileList};
353
354    $t->{view} = BackupPC::View->new($bpc, $t->{bkupSrcHost}, $t->{backups});
355    my $view   = $t->{view};
356
357    foreach my $file ( @$fileList ) {
358
359        my $attr = $view->fileAttrib($t->{bkupSrcNum}, $t->{bkupSrcShare}, $file);
360
361        $t->logWrite("restore($file)\n", 4);
362
363        if ( $attr->{type} == BPC_FTYPE_DIR ) {
364
365            $t->restoreDir($file, $attr);
366
367        } elsif ( $attr->{type} == BPC_FTYPE_FILE ) {
368
369            $t->restoreFile($file, $attr);
370
371        } else {
372            #
373            # can't restore any other file types
374            #
375            $t->logWrite("restore($file): failed... unsupported file type $attr->{type}\n", 0);
376            $t->{xferErrCnt}++;
377        }
378    }
379    $t->{xferOK} = 1;
380    return 1;
381}
382
383
384sub restoreDir
385{
386    my ($t, $dirName, $dirAttr) = @_;
387
388    my $ftp    = $t->{ftp};
389    my $bpc    = $t->{bpc};
390    my $conf   = $t->{conf};
391    my $view   = $t->{view};
392
393    my $dirList = $view->dirAttrib($t->{bkupSrcNum}, $t->{bkupSrcShare}, $dirName);
394
395    (my $targetPath = "$t->{shareNamePath}/$dirName") =~ s{//+}{/}g;
396
397    my ( $fileName, $fileAttr, $fileType );
398
399    $t->logWrite("restoreDir($dirName) -> $targetPath\n", 4);
400
401    #
402    # Create the remote directory
403    #
404    undef $@;
405    eval { $ftp->mkdir( $targetPath, 1 ); };
406    if ( $@ ) {
407        $t->logFileAction("fail", $dirName, $dirAttr);
408        return;
409    } else {
410        $t->logFileAction("restore", $dirName, $dirAttr);
411    }
412
413    while ( ($fileName, $fileAttr ) = each %$dirList ) {
414
415        $t->logWrite("restoreDir: entry = $dirName/$fileName\n", 4);
416
417        if ( $fileAttr->{type} == BPC_FTYPE_DIR ) {
418
419            $t->restoreDir("$dirName/$fileName", $fileAttr);
420
421        } elsif ( $fileAttr->{type} == BPC_FTYPE_FILE ) {
422
423            $t->restoreFile("$dirName/$fileName", $fileAttr);
424
425        } else {
426            #
427            # can't restore any other file types
428            #
429            $t->logWrite("restore($fileName): failed... unsupported file type $fileAttr->{type}\n", 0);
430        }
431    }
432}
433
434
435sub restoreFile
436{
437    my ($t, $fileName, $fileAttr ) = @_;
438
439    my $conf   = $t->{conf};
440    my $ftp    = $t->{ftp};
441    my $bpc    = $t->{bpc};
442    my $TopDir = $bpc->TopDir();
443
444    my $poolFile = $fileAttr->{fullPath};
445    my $tempFile = "$TopDir/pc/$t->{client}/FtpRestoreTmp$$";
446    my $fout;
447
448    my $fileDest = ( $conf->{ClientCharset} ne "" )
449                 ? from_to( "$t->{shareNamePath}//$fileName",
450                            "utf8", $conf->{ClientCharset} )
451                 : "$t->{shareNamePath}/$fileName";
452
453    $t->logWrite("restoreFile($fileName) -> $fileDest\n", 4);
454
455    if ( $fileAttr->{compress} ) {
456        my $f = BackupPC::XS::FileZIO::open($poolFile, 0, $fileAttr->{compress});
457        if ( !defined($f) ) {
458            $t->logWrite("restoreFile: Unable to open file $poolFile (during restore of $fileName)\n", 0);
459            $t->{stats}{errCnt}++;
460            return;
461        }
462        if ( !open($fout, ">", $tempFile) ) {
463            $t->logWrite("restoreFile: Can't create/open temp file $tempFile (during restore of $fileName)\n", 0);
464            $t->{stats}{errCnt}++;
465            $f->close();
466            return;
467        }
468
469        my $data;
470        my $outData = "";
471        while ( $f->read(\$data, 65536) > 0 ) {
472            my $ret = syswrite($fout, $data);
473            if ( !defined($ret) || $ret != length($data) ) {
474                $t->logWrite("restoreFile: Can't write file $tempFile ($ret, $@) (during restore of $fileName)\n", 0);
475                $t->{stats}{errCnt}++;
476                $f->close();
477                close($fout);
478                return;
479            }
480        }
481        $f->close();
482        close($fout);
483    } else {
484        $tempFile = $poolFile;
485    }
486
487    undef $@;
488    eval {
489        if ( $ftp->put( $tempFile, $fileDest ) ) {
490            $t->logFileAction("restore", $fileName, $fileAttr);
491        } else {
492            $@ = 1 if ( !$@ );          # force the fail message below
493        }
494    };
495    unlink($tempFile);
496    if ($@) {
497        $t->logWrite("restoreFile($fileName) failed ($@)\n", 4);
498        $t->logFileAction("fail", $fileName, $fileAttr);
499    }
500}
501
502
503#
504#  usage:
505#   $t->backup($path);
506#
507# $t->backup() is a recursive function that takes a path as an
508# argument, and performs a backup on that folder consistent with the
509# configuration parameters.  $path is considered rooted at
510# $t->{shareName}, so no $ftp->cwd() command is necessary.
511#
512sub backup
513{
514    my ($t) =  @_;
515
516    my $ftp    = $t->{ftp};
517    my $bpc    = $t->{bpc};
518    my $conf   = $t->{conf};
519
520    #
521    # determine the filetype of the shareName and back it up
522    # appropriately.  For now, assume that $t->{shareName} is a
523    # directory.
524    #
525    my $f = {
526              name     => "/",
527              type     => BPC_FTYPE_DIR,
528              mode     => 0775,
529              mtime    => time,
530              compress => $t->{compress},
531            };
532    if ( $t->handleDir($f) ) {
533
534        $t->logWrite("adding top-level attrib for share $t->{shareName}\n", 4);
535        my $fNew = {
536                    name     => $t->{shareName},
537                    type     => BPC_FTYPE_DIR,
538                    mode     => 0775,
539                    uid      => 0,
540                    gid      => 0,
541                    size     => 0,
542                    mtime    => time(),
543                    inode    => $t->{Inode}++,
544                    nlinks   => 0,
545                    compress => $t->{compress},
546               };
547
548        $t->{AttrNew}->set("/", $fNew);
549
550        $t->{xferOK} = 1;
551        return 1;
552
553    } else {
554
555        $t->{xferBadShareCnt}++;
556        return;
557    }
558}
559
560
561####################################################################################
562# FTP-specific functions
563####################################################################################
564
565#
566# This is an encapulation of the logic necessary to grab the arguments
567# from %Conf and throw it in a hash pointer to be passed to the
568# Net::FTP object.
569#
570sub getFTPArgs
571{
572    my ($t)  = @_;
573    my $conf = $t->{conf};
574
575    return {
576        Host         => $t->{hostIP} || $t->{host},
577        Firewall     => undef,                            # not used
578        FirewallType => undef,                            # not used
579        BlockSize    => $conf->{FtpBlockSize} || 10240,
580        Port         => $conf->{FtpPort}      || 21,
581        Timeout      => defined($conf->{FtpTimeout}) ? $conf->{FtpTimeout} : 120,
582        Debug        => $t->{logLevel} >= 5 ? 1 : 0,
583        Passive      => (defined($conf->{FtpPassive}) ? $conf->{FtpPassive} : 1),
584        Hash         => undef,                            # do not touch
585    };
586}
587
588#
589#   usage:
590#     $dirList = $t->remotels($path);
591#
592# remotels() returns a reference to a list of hash references that
593# describe the contents of each file in the directory of the path
594# specified.
595#
596sub remotels
597{
598    my ( $t, $name ) = @_;
599
600    my $ftp  = $t->{ftp};
601    my $bpc  = $t->{bpc};
602    my $conf = $t->{conf};
603    my $nameClient = $name;
604    my $char2type = {
605        'f' => BPC_FTYPE_FILE,
606        'd' => BPC_FTYPE_DIR,
607        'l' => BPC_FTYPE_SYMLINK,
608    };
609    my ($dirContents, $remoteDir, $f, $linkname);
610
611    from_to( $nameClient, "utf8", $conf->{ClientCharset} )
612                            if ( $conf->{ClientCharset} ne "" );
613    $remoteDir = [];
614    undef $@;
615    $t->logWrite("remotels: about to list $name\n", 4);
616    eval {
617        $dirContents = ($nameClient =~ /^\.?$/ || $nameClient =~ /^\/*$/)
618                                ? $ftp->dir() : $ftp->dir("$nameClient/");
619    };
620    if ( !defined($dirContents) ) {
621        $t->{xferErrCnt}++;
622        $t->logWrite("remotels: can't retrieve remote directory contents of $name: $!\n", 1);
623        return "can't retrieve remote directory contents of $name: $!";
624    }
625    if ( $t->{logLevel} >= 4 ) {
626        my $str = join("\n", @$dirContents);
627        $t->logWrite("remotels: got dir() result:\n$str\n", 4);
628    }
629
630    foreach my $info ( @{parse_dir($dirContents)} ) {
631        my $dirStr = shift(@$dirContents);
632        my($uid, $gid);
633
634        next if ( $info->[0] eq "." || $info->[0] eq ".." );
635
636        if ( $info->[1] =~ /^l (.*)/ ) {
637            $linkname = $1;
638        }
639
640        #
641        # Try to extract number uid/gid, if present.  If there are special files (eg, devices or pipe) that are
642        # in the directoy listing, they won't be in $dirContents.  So $dirStr might not be the matching text
643        # for $info.  So we peel off more elements if they don't appear to match.  This is very fragile.
644        # Better solution would be to update $ftp->dir() to extract uid/gid if present.
645        #
646        while ( @$dirContents && $dirStr !~ m{\s+\Q$info->[0]\E$}
647                              && $dirStr !~ m{^l.*\s+\Q$info->[0] -> $linkname\E$} ) {
648            $t->logWrite("no match between $dirStr and $info->[0]\n", 4);
649            $dirStr = shift(@$dirContents);
650        }
651        my $fTypeChar = substr($info->[1], 0, 1);
652        if ( $dirStr =~ m{^.{10}\s+\d+\s+(\d+)\s+(\d+)\s+(\d+).*\Q$info->[0]\E} && ($fTypeChar ne "f" || $info->[2] == $3) ) {
653            $uid = $1;
654            $gid = $2;
655        }
656
657        from_to($info->[0], $conf->{ClientCharset}, "utf8")
658                                if ( $conf->{ClientCharset} ne "" );
659        from_to($linkname, $conf->{ClientCharset}, "utf8")
660                                if ( $linkname ne "" && $conf->{ClientCharset} ne "" );
661
662        my $dir = "$name/";
663        $dir = "" if ( $name eq "" );
664        $dir =~ s{^/+}{};
665
666        $f = {
667            name     => "$dir$info->[0]",
668            type     => defined($char2type->{$fTypeChar}) ? $char2type->{$fTypeChar} : BPC_FTYPE_UNKNOWN,
669            size     => $info->[2],
670            mtime    => $info->[3],
671            mode     => $info->[4],
672            uid      => $uid,
673            gid      => $gid,
674            compress => $t->{compress},
675        };
676        $f->{linkname} = $linkname if ( defined($linkname) );
677
678        $t->logWrite("remotels: adding name $f->{name}, type $f->{type} ($info->[1]), size $f->{size}, mode $f->{mode}, $uid/$gid\n", 4);
679
680        push( @$remoteDir, $f );
681    }
682    return $remoteDir;
683}
684
685#
686# handleSymlink() backs up a symlink.
687#
688sub handleSymlink
689{
690    my ( $t, $f ) = @_;
691    my $a = $t->{AttrNew}->get($f->{name});
692    my $stats = $t->{stats};
693    my($same, $exists, $digest, $outSize, $errs);
694
695    #
696    # Symbolic link: write the value of the link to a plain file,
697    # that we pool as usual (ie: we don't create a symlink).
698    # The attributes remember the original file type.
699    # We also change the size to reflect the size of the link
700    # contents.
701    #
702    $f->{size} = length($f->{linkname});
703    if ( $a && $a->{type} == BPC_FTYPE_SYMLINK ) {
704        #
705        # Check if it is the same
706        #
707        my $oldLink = $t->fileReadAll($a, $f);
708        if ( $oldLink eq $f->{linkname} ) {
709            logFileAction("same", $f) if ( $t->{logLevel} >= 1 );
710            $stats->{ExistFileCnt}++;
711            $stats->{ExistFileSize}     += $f->{size};
712            $stats->{ExistFileCompSize} += -s $a->{poolPath}
713                                      if ( -f $a->{poolPath} );
714            $same = 1;
715        }
716    }
717    if ( !$same ) {
718        $t->moveFileToOld($a, $f);
719        $t->logWrite("PoolWrite->new(name = $f->{name}, compress = $t->{compress})\n", 5);
720        my $poolWrite = BackupPC::XS::PoolWrite::new($t->{compress});
721        $poolWrite->write(\$f->{linkname});
722        ($exists, $digest, $outSize, $errs) = $poolWrite->close();
723        $f->{digest} = $digest;
724        if ( $errs ) {
725            $t->logFileAction( "fail", $f->{name}, $f );
726            $t->{xferBadFileCnt}++;
727            $stats->{errCnt} += scalar @$errs;
728            return;
729        }
730    }
731
732    #
733    # Update attribs
734    #
735    $t->attribUpdate($a, $f, $same);
736
737    #
738    # Perform logging
739    #
740    $t->logFileAction( $same ? "same" : $exists ? "pool" : "new", $f->{name}, $f );
741
742    #
743    # Cumulate the stats
744    #
745    $stats->{TotalFileCnt}++;
746    $stats->{TotalFileSize} += $f->{size};
747    if ( $exists ) {
748        $stats->{ExistFileCnt}++;
749        $stats->{ExistFileCompSize} += -s $a->{poolPath}
750                                  if ( -f $a->{poolPath} );
751        $stats->{ExistFileSize}     += $f->{size};
752    } else {
753        $stats->{NewFileCnt}++;
754        $stats->{NewFileCompSize} += -s $a->{poolPath}
755                                  if ( -f $a->{poolPath} );
756        $stats->{NewFileSize}     += $f->{size};
757    }
758    $t->{byteCnt} += $f->{size};
759    $t->{fileCnt}++;
760
761    return 1;
762}
763
764#
765# handleDir() backs up a directory, and initiates a backup of its
766# contents.
767#
768sub handleDir
769{
770    my ( $t, $f ) = @_;
771
772    my $ftp     = $t->{ftp};
773    my $bpc     = $t->{bpc};
774    my $conf    = $t->{conf};
775    my $stats   = $t->{stats};
776    my $AttrNew = $t->{AttrNew};
777    my $same    = 0;
778    my $a       = $AttrNew->get($f->{name});
779
780    my ( $exists, $digest, $outSize, $errs );
781    my ( $poolWrite, $poolFile );
782    my ( $localDir, $remoteDir, %expectedFiles );
783
784    $a->{poolPath} = $bpc->MD52Path($a->{digest}, $a->{compress}) if ( length($a->{digest}) );
785
786    my $pathNew = $AttrNew->getFullMangledPath($f->{name});
787
788    if ( -d $pathNew ) {
789        $t->logFileAction( "same", $f->{name}, $f );
790        $same = 1;
791    } else {
792        if ( -e $pathNew ) {
793            $t->logWrite("handleDir: $pathNew ($f->{name}) isn't a directory... renaming and recreating\n", 3)
794                                         if ( defined($a) );
795        } else {
796            $t->logWrite("handleDir: creating directory $pathNew ($f->{name})\n", 3)
797                                         if ( defined($a) );
798        }
799        $t->moveFileToOld($a, $f);
800        $t->logFileAction("new", $f->{name}, $f) if ( $t->{logLevel} >= 1 );
801        #
802        # make sure all the parent directories exist and have directory attribs
803        #
804        $t->pathCreate($pathNew, 1);
805        my $name = $f->{name};
806        $name = "/$name" if ( $name !~ m{^/} );
807        while ( length($name) > 1 ) {
808	    if ( $name =~ m{/} ) {
809		$name =~ s{(.*)/.*}{$1};
810	    } else {
811		$name = "/";
812	    }
813            my $a = $AttrNew->get($name);
814            last if ( defined($a) && $a->{type} == BPC_FTYPE_DIR );
815            $t->logWrite("handleDir: adding BPC_FTYPE_DIR attrib entry for $name\n", 3);
816            my $fNew = {
817                            name     => $name,
818                            type     => BPC_FTYPE_DIR,
819                            mode     => $f->{mode},
820                            uid      => $f->{uid},
821                            gid      => $f->{gid},
822                            size     => 0,
823                            mtime    => $f->{mtime},
824                            inode    => $t->{Inode}++,
825                            nlinks   => 0,
826                            compress => $t->{compress},
827                       };
828            $AttrNew->set($name, $fNew);
829            $t->moveFileToOld($a, $fNew);
830        }
831    }
832
833    #
834    # Update attribs
835    #
836    $t->attribUpdate($a, $f, $same);
837
838    $t->logWrite("handleDir: name = $f->{name}, pathNew = $pathNew\n", 4);
839
840    $remoteDir = $t->remotels( $f->{name} );
841
842    if ( ref($remoteDir) ne 'ARRAY' ) {
843        $t->logWrite("handleDir failed: $remoteDir\n", 1);
844        $t->logFileAction( "fail", $f->{name}, $f );
845        $t->{xferErrCnt}++;
846        return;
847    }
848
849    my $all = $AttrNew->getAll($f->{name});
850    $bpc->flushXSLibMesgs();
851
852    #
853    # take care of each file in the directory
854    #
855    foreach my $f ( @{$remoteDir} ) {
856
857        my $fullName = "$t->{shareName}/$f->{name}";
858        $fullName =~ s{/+}{/}g;
859        next if ( !$t->checkIncludeExclude($fullName) );
860
861        #
862        # handle based on filetype
863        #
864        if ( $f->{type} == BPC_FTYPE_FILE ) {
865
866            $t->handleFile($f);
867
868        } elsif ( $f->{type} == BPC_FTYPE_DIR ) {
869
870            $t->handleDir($f);
871
872        } elsif ( $f->{type} == BPC_FTYPE_SYMLINK ) {
873
874            $t->handleSymlink($f);
875
876        } else {
877
878            $t->logWrite("handleDir: unexpected file type $f->{type} for $f->{name})\n", 1);
879            $t->{xferBadFileCnt}++;
880
881        }
882
883        #
884        # Mark file as seen in expected files hash
885        #
886        $t->logWrite("dirLoop: handled $f->{name}\n", 5);
887        $expectedFiles{$f->{name}}++;
888
889    } # end foreach (@{$remoteDir})
890
891    #
892    # If we didn't see a file, move to old.
893    #
894    foreach my $name ( keys(%$all) ) {
895        next if ( $name eq "." || $name eq ".." );
896        my $path = "$f->{name}/$name";
897        $path =~ s{^/+}{};
898        $t->logWrite("dirCleanup: checking $path, expected = $expectedFiles{$path}\n", 5);
899        next if ( $expectedFiles{$path} );
900        $t->moveFileToOld($AttrNew->get($path), {name => $path});
901    }
902
903    #
904    # Explicit success
905    #
906    return 1;
907}
908
909
910#
911# handleFile() backs up a file.
912#
913sub handleFile
914{
915    my ( $t, $f ) = @_;
916
917    my $bpc        = $t->{bpc};
918    my $ftp        = $t->{ftp};
919    my $view       = $t->{view};
920    my $stats      = $t->{stats};
921
922    my ( $poolFile, $poolWrite, $data, $localSize );
923    my ( $exists, $digest, $outSize, $errs );
924    my ( $oldAttrib );
925    local *FTP;
926
927    my $a    = $t->{AttrNew}->get($f->{name});
928    my $aOld = $t->{AttrOld}->get($f->{name}) if ( $t->{AttrOld} );
929    my $same = 0;
930
931    #
932    # If this is an incremental backup and the file exists in a
933    # previous backup unchanged, write the attribInfo for the file
934    # accordingly.
935    #
936    if ( $t->{type} eq "incr" ) {
937        if ( $a
938                && $f->{type}  == $a->{type}
939                && $f->{mtime} == $a->{mtime}
940                && $f->{size}  == $a->{size}
941                && $f->{uid}   == $a->{uid}
942                && $f->{gid}   == $a->{gid} ) {
943            $t->logWrite("handleFile: $f->{name} has same attribs\n", 5);
944            return 1;
945        }
946    }
947
948    #
949    # If this is a full backup or the file has changed on the host,
950    # back it up.
951    #
952    # TODO: convert back to local charset?
953    #
954    undef $@;
955    eval { tie ( *FTP, 'Net::FTP::RetrHandle', $ftp, "$f->{name}" ); };
956    if ( !*FTP || $@ ) {
957        $t->logFileAction( "fail", $f->{name}, $f );
958        $t->{xferBadFileCnt}++;
959        $stats->{errCnt}++;
960        return;
961    }
962
963    $t->logWrite("PoolWrite->new(name = $f->{name}, compress = $t->{compress})\n", 5);
964    $poolWrite = BackupPC::XS::PoolWrite::new($t->{compress});
965    $localSize = 0;
966
967    undef $@;
968    eval {
969        while (<FTP>) {
970            $localSize += length($_);
971            $poolWrite->write( \$_ );
972        }
973    };
974    ( $exists, $digest, $outSize, $errs ) = $poolWrite->close();
975    $f->{digest} = $digest;
976
977    if ( $a && $a->{digest} eq $digest ) {
978        $same = 1 if ( $a->{nlinks} == 0 );
979    }
980
981    if ( !$same ) {
982        $t->moveFileToOld($a, $f);
983    }
984
985    if ( !*FTP || $@ || $errs ) {
986        $t->logFileAction( "fail", $f->{name}, $f );
987        $t->{xferBadFileCnt}++;
988        $stats->{errCnt} += ref($errs) eq 'ARRAY' ? scalar(@$errs) : 1;
989        return;
990    }
991
992    #
993    # this should never happen
994    #
995    if ( $localSize != $f->{size} ) {
996        $t->logFileAction( "fail", $f->{name}, $f );
997        $t->logWrite("Size mismatch on $f->{name} ($localSize vs $f->{size})\n", 3);
998        $stats->{xferBadFileCnt}++;
999        $stats->{errCnt}++;
1000        return;
1001    }
1002
1003    #
1004    # Update attribs
1005    #
1006    $t->attribUpdate($a, $f, $same);
1007
1008    #
1009    # Perform logging
1010    #
1011    $t->logFileAction( $same ? "same" : $exists ? "pool" : "new", $f->{name}, $f );
1012
1013    #
1014    # Cumulate the stats
1015    #
1016    $stats->{TotalFileCnt}++;
1017    $stats->{TotalFileSize} += $f->{size};
1018    if ( $exists ) {
1019        $stats->{ExistFileCnt}++;
1020        $stats->{ExistFileCompSize} += $outSize;
1021        $stats->{ExistFileSize}     += $f->{size};
1022    } else {
1023        $stats->{NewFileCnt}++;
1024        $stats->{NewFileCompSize} += $outSize;
1025        $stats->{NewFileSize}     += $f->{size};
1026    }
1027    $t->{byteCnt} += $localSize;
1028    $t->{fileCnt}++;
1029}
1030
1031#
1032# Generate a log file message for a completed file.  Taken from
1033# BackupPC_tarExtract. $f should be an attrib object.
1034#
1035sub logFileAction
1036{
1037    my ( $t, $action, $name, $attrib ) = @_;
1038
1039    my $owner = "$attrib->{uid}/$attrib->{gid}";
1040    my $type = BackupPC::XS::Attrib::fileType2Text($attrib->{type});
1041
1042    $type = $1 if ( $type =~ /(.)/ );
1043    $type = "" if ( $type eq "f" );
1044
1045    $name  = "."   if ( $name  eq "" );
1046    $owner = "-/-" if ( $owner eq "/" );
1047
1048    $t->{bpc}->flushXSLibMesgs();
1049
1050    my $fileAction = sprintf(
1051        "  %-6s %1s%4o %9s %11.0f %s\n",
1052        $action, $type, $attrib->{mode} & 07777,
1053        $owner, $attrib->{size}, $attrib->{name}
1054    );
1055
1056    if ( ($t->{stats}{TotalFileCnt} % 20) == 0 && !$t->{noProgressPrint} ) {
1057        printf("__bpc_progress_fileCnt__ %d\n", $t->{stats}{TotalFileCnt});
1058    }
1059
1060    return $t->logWrite( $fileAction, 1 );
1061}
1062
1063#
1064# Move $a to old; the new file $f will replace $a
1065#
1066sub moveFileToOld
1067{
1068    my($t, $a, $f) = @_;
1069    my $AttrNew = $t->{AttrNew};
1070    my $AttrOld = $t->{AttrOld};
1071    my $DeltaNew = $t->{DeltaNew};
1072    my $DeltaOld = $t->{DeltaOld};
1073    my $bpc = $t->{bpc};
1074
1075    if ( !$a || keys(%$a) == 0 ) {
1076        #
1077        # A new file will be created, so add delete attribute to old
1078        #
1079        if ( $AttrOld ) {
1080            $AttrOld->set($f->{name}, { type => BPC_FTYPE_DELETED });
1081            $t->logWrite("moveFileToOld: added $f->{name} as BPC_FTYPE_DELETED in old\n", 5);
1082        }
1083        return;
1084    }
1085    $t->logWrite("moveFileToOld: $a->{name}, $f->{name}, links = $a->{nlinks}, type = $a->{type}\n", 5);
1086    if ( $a->{type} != BPC_FTYPE_DIR ) {
1087        if ( $a->{nlinks} > 0 ) {
1088            if ( $AttrOld ) {
1089                if ( !$AttrOld->getInode($a->{inode}) ) {
1090                    #
1091                    # copy inode to old if it isn't already there
1092                    #
1093                    $AttrOld->setInode($a->{inode}, $a);
1094                    $DeltaOld->update($a->{compress}, $a->{digest}, 1);
1095                }
1096                #
1097                # copy to old - no need for refeence count update since
1098                # inode is already there
1099                #
1100                $AttrOld->set($f->{name}, $a, 1) if ( !$AttrOld->get($f->{name}) );
1101            }
1102            $a->{nlinks}--;
1103            if ( $a->{nlinks} <= 0 ) {
1104                $AttrNew->deleteInode($a->{inode});
1105                $DeltaNew->update($a->{compress}, $a->{digest}, -1);
1106            } else {
1107                $AttrNew->setInode($a->{inode}, $a);
1108            }
1109        } else {
1110            $DeltaNew->update($a->{compress}, $a->{digest}, -1);
1111            if ( $AttrOld && !$AttrOld->get($f->{name}) && $AttrOld->set($f->{name}, $a, 1) ) {
1112                $DeltaOld->update($a->{compress}, $a->{digest}, 1);
1113            }
1114        }
1115        $AttrNew->delete($f->{name});
1116    } else {
1117        if ( !$AttrOld || $AttrOld->get($f->{name}) ) {
1118            #
1119            # Delete the directory tree, including updating reference counts
1120            #
1121            my $pathNew = $AttrNew->getFullMangledPath($f->{name});
1122            $t->logWrite("moveFileToOld(..., $f->{name}): deleting $pathNew\n", 3);
1123            BackupPC::DirOps::RmTreeQuiet($bpc, $pathNew, $a->{compress}, $DeltaNew, $AttrNew);
1124        } else {
1125            #
1126            # For a directory we need to move it to old, and copy
1127            # any inodes that are referenced below this directory.
1128	    # Also update the reference counts for the moved files.
1129            #
1130            my $pathNew = $AttrNew->getFullMangledPath($f->{name});
1131            my $pathOld = $AttrOld->getFullMangledPath($f->{name});
1132            $t->logWrite("moveFileToOld(..., $f->{name}): renaming $pathNew to $pathOld\n", 5);
1133            $t->pathCreate($pathOld);
1134            $AttrNew->flush(0, $f->{name});
1135            if ( !rename($pathNew, $pathOld) ) {
1136                $t->logWrite(sprintf("moveFileToOld(..., %s: can't rename %s to %s ($!, %d, %d, %d)\n",
1137                                      $f->{name}, $pathNew, $pathOld, -e $pathNew, -e $pathOld, -d $pathOld));
1138                $t->{xferErrCnt}++;
1139            } else {
1140                BackupPC::XS::DirOps::refCountAll($pathOld, $a->{compress}, -1, $DeltaNew);
1141                BackupPC::XS::DirOps::refCountAll($pathOld, $a->{compress},  1, $DeltaOld);
1142                $t->copyInodes($f->{name});
1143                $AttrOld->set($f->{name}, $a, 1);
1144            }
1145        }
1146        $AttrNew->delete($f->{name});
1147    }
1148}
1149
1150sub copyInodes
1151{
1152    my($t, $dirName) = @_;
1153    my $AttrNew = $t->{AttrNew};
1154    my $AttrOld = $t->{AttrOld};
1155    my $DeltaNew = $t->{DeltaNew};
1156    my $DeltaOld = $t->{DeltaOld};
1157    my $bpc = $t->{bpc};
1158
1159    return if ( !defined($AttrOld) );
1160
1161    my $dirPath  = $AttrNew->getFullMangledPath($dirName);
1162
1163    $t->logWrite("copyInodes: dirName = $dirName, dirPath = $dirPath\n", 4);
1164
1165    my $attrAll = $AttrNew->getAll($dirName);
1166    $bpc->flushXSLibMesgs();
1167
1168    #
1169    # Add non-attrib directories (ie: directories that were created
1170    # to store attributes in deeper directories), since these
1171    # directories may not appear in the attrib file at this level.
1172    #
1173    if ( defined(my $entries = BackupPC::DirOps::dirRead($bpc, $dirPath)) ) {
1174        foreach my $e ( @$entries ) {
1175            next if ( $e->{name} eq "."
1176                   || $e->{name} eq ".."
1177                   || $e->{name} eq "inode"
1178                   || !-d "$dirPath/$e->{name}" );
1179            my $fileUM = $bpc->fileNameUnmangle($e->{name});
1180            next if ( $attrAll && defined($attrAll->{$fileUM}) );
1181            $attrAll->{$fileUM} = {
1182                type     => BPC_FTYPE_DIR,
1183                noAttrib => 1,
1184            };
1185        }
1186    }
1187
1188    foreach my $fileUM ( keys(%$attrAll) ) {
1189        next if ( $fileUM eq "." || $fileUM eq ".." );
1190        my $a = $attrAll->{$fileUM};
1191        if ( $a->{type} == BPC_FTYPE_DIR ) {
1192            #
1193            # recurse into this directory
1194            #
1195            $t->copyInodes("$dirName/$fileUM");
1196            next;
1197        }
1198        $t->logWrite("copyInodes($dirName): $fileUM has inode=$a->{inode}, links = $a->{nlinks}\n", 6);
1199        next if ( $a->{nlinks} == 0 );
1200        #
1201        # Copy the inode if it doesn't exist in old and increment the
1202        # digest reference count.
1203        my $aInode = $AttrNew->getInode($a->{inode});
1204        if ( !defined($AttrOld->getInode($a->{inode})) ) {
1205            $t->logWrite("copyInodes($dirName): $fileUM moving inode $a->{inode} to old\n", 5);
1206            $AttrOld->setInode($a->{inode}, $aInode);
1207            $DeltaOld->update($aInode->{compress}, $aInode->{digest}, 1);
1208        }
1209
1210        #
1211        # Also decrement the inode reference count in new.
1212        #
1213        $aInode->{nlinks}--;
1214        if ( $aInode->{nlinks} == 0 ) {
1215            $AttrNew->deleteInode($a->{inode});
1216            $t->logWrite("copyInodes($dirName): $fileUM deleting inode $a->{inode} in new\n", 5);
1217            $DeltaNew->update($aInode->{compress}, $aInode->{digest}, -1);
1218        } else {
1219            $AttrNew->setInode($a->{inode}, $aInode);
1220        }
1221        $bpc->flushXSLibMesgs();
1222    }
1223}
1224
1225sub attribUpdate
1226{
1227    my($t, $a, $f, $same) = @_;
1228
1229    #
1230    # If the file was the same, we have to check the attributes to see if they
1231    # are the same too.  If the file is newly written, we just write the
1232    # new attributes.
1233    #
1234    my $AttrNew     = $t->{AttrNew};
1235    my $AttrOld     = $t->{AttrOld};
1236    my $DeltaNew    = $t->{DeltaNew};
1237    my $DeltaOld    = $t->{DeltaOld};
1238    my $bpc         = $t->{bpc};
1239    my $attribSet   = 1;
1240    my $newCompress = $t->{compress};
1241
1242    $newCompress = $a->{compress} if ( $a && defined($a->{compress}) );
1243
1244    $t->logWrite(sprintf("File %s: old digest %s, new digest %s\n", $f->{name}, unpack("H*", $a->{digest}), unpack("H*", $f->{digest})), 5) if ( $a );
1245
1246    if ( $same && $a ) {
1247        if ( $a->{type}   == $f->{type}
1248          && $a->{mode}   == S_IMODE($f->{mode})
1249          && $a->{uid}    == $f->{uid}
1250          && $a->{gid}    == $f->{gid}
1251          && $a->{size}   == $f->{size}
1252          && $a->{mtime}  == $f->{mtime}
1253          && $a->{digest} eq $f->{digest} ) {
1254            #
1255            # same contents, same attributes, so no need to rewrite
1256            #
1257            $attribSet = 0;
1258        } else {
1259            #
1260            # same contents, different attributes, so copy to old and
1261            # we will write the new attributes below
1262            #
1263            if ( $AttrOld && !$AttrOld->get($f->{name}) ) {
1264                if ( $AttrOld->set($f->{name}, $a, 1) ) {
1265                    $DeltaOld->update($newCompress, $f->{digest}, 1);
1266                }
1267            }
1268            $f->{inode}  = $a->{inode};
1269            $f->{nlinks} = $a->{nlinks};
1270        }
1271    } else {
1272        #
1273        # file is new or changed; update ref counts
1274        #
1275        $DeltaNew->update($newCompress, $f->{digest}, 1)
1276                                                if ( $f->{digest} ne "" );
1277    }
1278
1279    if ( $attribSet ) {
1280        my $newInode = $f->{inode};
1281        $newInode = $t->{Inode}++ if ( !defined($newInode) );
1282        my $nlinks = 0;
1283        $nlinks = $f->{nlinks} if ( defined($f->{nlinks}) );
1284        $AttrNew->set($f->{name}, {
1285                        type     => $f->{type},
1286                        mode     => S_IMODE($f->{mode}),
1287                        uid      => $f->{uid},
1288                        gid      => $f->{gid},
1289                        size     => $f->{size},
1290                        mtime    => $f->{mtime},
1291                        inode    => $newInode,
1292                        nlinks   => $nlinks,
1293                        compress => $newCompress,
1294                        digest   => $f->{digest},
1295                   });
1296    }
1297    $bpc->flushXSLibMesgs();
1298}
1299
1300#
1301# Create the parent directory of $fullPath (if necessary).
1302# If $noStrip != 0 then $fullPath is the directory to create,
1303# rather than the parent.
1304#
1305sub pathCreate
1306{
1307    my($t, $fullPath, $noStrip) = @_;
1308
1309    #
1310    # Get parent directory of $fullPath
1311    #
1312    $t->logWrite("pathCreate: fullPath = $fullPath\n", 6);
1313    $fullPath =~ s{/[^/]*$}{} if ( !$noStrip );
1314    return 0 if ( -d $fullPath );
1315    unlink($fullPath) if ( -e $fullPath );
1316    eval { mkpath($fullPath, 0, 0777) };
1317    if ( $@ ) {
1318        $t->logWrite("Can't create $fullPath\n", 1);
1319        $t->{xferErrCnt}++;
1320        return -1;
1321    }
1322    return 0;
1323}
1324
1325sub fileReadAll
1326{
1327    my($t, $a, $f) = @_;
1328
1329    return "" if ( $a->{size} == 0 );
1330    my $f = BackupPC::XS::FileZIO::open($a->{poolPath}, 0, $a->{compress});
1331    if ( !defined($f) ) {
1332        print("fileReadAll: Unable to open file $a->{poolPath} (for $f->{name})\n");
1333        $t->{stats}{errCnt}++;
1334        return;
1335    }
1336    my $data;
1337    my $outData = "";
1338    while ( $f->read(\$data, 65536) > 0 ) {
1339        $outData .= $data;
1340    }
1341    $f->close;
1342    return $outData;
1343}
1344
13451;
1346