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