1;# 2;# Copyright (c) 1995-1997 3;# Ikuo Nakagawa. All rights reserved. 4;# 5;# Redistribution and use in source and binary forms, with or without 6;# modification, are permitted provided that the following conditions 7;# are met: 8;# 9;# 1. Redistributions of source code must retain the above copyright 10;# notice unmodified, this list of conditions, and the following 11;# disclaimer. 12;# 2. Redistributions in binary form must reproduce the above copyright 13;# notice, this list of conditions and the following disclaimer in the 14;# documentation and/or other materials provided with the distribution. 15;# 16;# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 17;# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 18;# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 19;# PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS 20;# BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, 21;# OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT 22;# OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR 23;# BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 24;# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE 25;# OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, 26;# EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27;# 28;# $Id: Farm.pm,v 1.21 1997/09/26 04:48:32 ikuo Exp $ 29;# 30package Fan::Farm; 31 32use strict; 33use vars qw($VERSION $LOG); 34 35use Carp; 36use Fan::MD5; 37use Fan::Cool; 38use Fan::Scan; 39use AutoLoader 'AUTOLOAD'; 40 41$VERSION = '0.04'; 42$LOG = 5; 43 44;# A special marker for AutoSplit. 451; 46__END__ 47 48;# 49;# Destroy FTP Archive Revision Manager object. 50;# 51sub DESTROY ($) { 52 my $p = shift; # myself. 53 my $dir = $p->{work_directory}; # farm directory. 54 55 # Unlink all temporary files, including the lock file 56 # for the working directory. 57 for my $file (keys %{$p->{tempfiles}}) { 58 warn("Fan::Farm unlink $file...\n") if $LOG > 5; 59 unlink($file) if -e $file; 60 } 61 62 # Log message. 63 carp("Fan::Farm DESTROYING $p") if $LOG > 5; 64} 65 66;# 67;# Creating FTP Archive Revision Managemer object. 68;# 69;# Usage: THIS::CLASS->new(directory_name); 70;# 71;# where directory_name is the directory who contains index 72;# or step files. 73;# 74;# Index files are named as: index.1, index.2, ... 75;# And step files: step.1, step.2, ... 76;# step.n contains all differences between index.n and 77;# index.(n+1), that is, we can generate index.(n+1) if we 78;# have index.n and step.n. 79;# 80;# There may be also local index file, named `index.local' 81;# which contains index of this work directory itself. 82;# 83sub new ($$) { 84 my $this = shift; 85 my $class = ref($this) || $this; 86 my $dir = shift; 87 88 # Check directory definition. 89 if ($dir eq '') { 90 carp("Fan::Farm directory not defined") if $LOG > 5; 91 return undef; 92 } 93 94 # Check directory existence. 95 if (! -d $dir) { 96 carp("Fan::Farm no directory: $dir") if $LOG > 4; 97 return undef; 98 } 99 100 # Try bless this object before we lock this directory. 101 my $p = bless { work_directory => $dir }, $class; 102 ref($p) || croak("Fan::Farm can't bless object"); 103 carp("Fan::Farm CREATING $p") if $LOG > 5; 104 105 # Add the lock file to the hash of temporary files. 106 my $lock = "$dir/.LOCK"; 107 $p->{tempfiles}->{$lock}++; 108 109 # Try to lock directory. 110 unless (plock($lock, 30)) { 111 carp("Fan::Farm can't lock directory: $dir") if $LOG > 4; 112 return undef; 113 } 114 115 # Try to get revision. 116 unless ($p->getrev) { 117 carp("Fan::Farm can't get revision") if $LOG > 4; 118 return undef; 119 } 120 121 # Return myself. 122 $p; 123} 124 125;# 126;# farm_begin ... 127;# initialize farm index updater. 128;# 129sub d_begin ($) { 130 my $p = shift; 131 my $dir = $p->{work_directory}; 132 my $fh; 133 134 # clear 135 $p->{pim_stack} = []; 136 $p->{pim_depth} = 0; 137 $p->{pim_modified} = 0; 138 139 # Check revisions... 140 exists($p->{pim_index_new}) || $p->getrev or return undef; 141 142 # check revision numbers 143 my $rev = $p->{pim_index_new}; 144 $p->{pim_index} = "$dir/index.$rev"; 145 $p->{pim_index_tmp} = $p->{pim_index}.'.tmp'; 146 147 local *TMPINDEX; 148 unless (open(TMPINDEX, ">$p->{pim_index_tmp}")) { 149 carp("d_begin open($p->{pim_index_tmp}): $!"); 150 return undef; 151 } 152 $p->{pim_index_handle} = *TMPINDEX; 153 154 # information log... 155 warn("Farm::begin: open $p->{pim_index_tmp}: o.k.\n") if $LOG > 5; 156 157 # CAUTION: 158 # WE CAN GENERATE STEP FILE EVEN IF WE ARE CREATING A NEW 159 # INDEX FILE, BUT WE SHOULD GENERATE STEP FILE FROM INDEX 160 # FILES... 161 return 1; 162 163 # shall we go step mode? 164 $rev > 1 || return 1; 165 166 # we are required step mode. 167 $rev--; 168 $p->{pim_step} = "$dir/step.$rev"; 169 $p->{pim_step_tmp} = $p->{pim_step}.'.tmp'; 170 171 # 172 local *TMPSTEP; 173 unless (open(TMPSTEP, ">$p->{pim_step_tmp}")) { 174 carp("Farm::begin: open($p->{pim_step_tmp}): $!"); 175 return undef; 176 } 177 $p->{pim_step_handle} = *TMPSTEP; 178 179 # information log... 180 warn("Farm::begin: open $p->{pim_step_tmp}: o.k.\n") if $LOG > 5; 181 182 # success 183 1; 184} 185 186;# 187;# farm_add 188;# add a file (Attrib object) to updater 189;# 190sub d_add ($$) { 191 my $p = shift; 192 my $fh_index = $p->{pim_index_handle}; 193 my $fh_step = $p->{pim_step_handle}; 194 195 # check file handle first. 196 unless (defined($fh_index)) { 197 carp("Farm::add: has no file handle"); 198 return undef; 199 } 200 201 my $y = shift; # Attribute. 202 my $t = $y->type; # Abbrev for type of $y. 203 my $f = $y->flag; # Abbrev for flag of $y. 204 205 # At first, check the depth of the current tree. 206 if ($t eq 'D') { 207 warn("Farm::add: down to \"".$y->name."\"\n") if $LOG > 6; 208 $p->{pim_depth}++; 209 } elsif ($t eq 'U') { 210 warn("Farm::add: up to \"..\"\n") if $LOG > 6; 211 $p->{pim_depth}--; 212 } else { 213 warn("Farm::add: checking ".$y->name." (type=$t)...\n") 214 if $LOG > 6; 215 } 216 217 # Check type/flag for given attribute. 218 if ($t eq '.') { 219 return $p->d_end; # terminator will be printed. 220 } 221 222 # check if we have any modification. 223 if ($f ne '') { 224 $p->{pim_modified} = 1; 225 } 226 227 # step mode ? 228 if (!defined($fh_step)) { 229 ; # no step mode 230 } elsif ($t eq 'D' && $y->name eq '.') { 231 print $fh_step $y->to_line."\n"; 232 } elsif ($f eq '') { 233 if ($t eq 'D') { 234 push(@{$p->{pim_stack}}, $y); 235 } elsif ($t eq 'U') { 236 if (@{$p->{pim_stack}}) { 237 pop(@{$p->{pim_stack}}); 238 } else { 239 print $fh_step "U\n"; 240 } 241 } 242 } else { 243 while (@{$p->{pim_stack}}) { 244 my $a = shift(@{$p->{pim_stack}}); 245 print $fh_step $a->to_line."\n"; 246 } 247 print $fh_step $y->to_line."\n"; 248 } 249 250 # index mode 251 if ($f ne '-') { # ignore removed files. 252 $y->flag(''); # clear flag 253 print $fh_index $y->to_line."\n"; 254 $y->flag($f); # restore. 255 } 256 257 # success 258 1; 259} 260 261;# 262;# farm_end 263;# terminate updater 264;# 265sub d_end ($) { 266 my $p = shift; 267 my $fh_index = $p->{pim_index_handle}; 268 my $fh_step = $p->{pim_step_handle}; 269 270 # Check file handle 271 unless (defined($fh_index)) { 272 carp("Farm::end: no file handle defined") if $LOG > 5; 273 return undef; 274 } 275 276 # Check depth of working tree. 277 if ($p->{pim_depth} < 1) { 278 carp("Farm::end: ouch! pim_depth is too small") if $LOG > 4; 279 close($fh_index); # We must close output file. 280 delete($p->{pim_index_handle}); 281 unlink($p->{pim_index_tmp}); 282 warn("Farm::end: $p->{pim_index_tmp} unlinked.\n") 283 if $LOG > 5; 284 if (defined($fh_step)) { 285 close($fh_step); 286 delete($p->{pim_step_handle}); 287 unlink($p->{pim_step_tmp}); 288 warn("Farm::end: $p->{pim_step_tmp} unlinked.\n") 289 if $LOG > 5; 290 } 291 return undef; 292 } 293 294 # Greater depth means "terminated abnormally" 295 if ($p->{pim_depth} > 1) { 296 carp("Farm::end: pim_depth > 1, index abort") if $LOG > 3; 297 close($fh_index); # We must close output file. 298 delete($p->{pim_index_handle}); 299 unlink($p->{pim_index_tmp}); 300 $fh_index = ''; 301 warn("Farm::end: $p->{pim_index_tmp} unlinked.\n") 302 if $LOG > 5; 303 if (defined($fh_step)) { 304 warn("Farm::end: try to fix step files.....\n") 305 if $LOG > 5; 306 while ($p->{pim_depth} > 1) { 307 if (@{$p->{pim_stack}}) { 308 pop(@{$p->{pim_stack}}); 309 } else { 310 print $fh_step "U\n"; 311 } 312 $p->{pim_depth}--; 313 } 314 } 315 } 316 317 # put terminator, and close output file. 318 if (defined($fh_index)) { 319 print $fh_index ".\n"; 320 close($fh_index); 321 delete($p->{pim_index_handle}); 322 warn("Farm::end: $p->{pim_index_tmp} was closed.\n") 323 if $LOG > 5; 324 325 # modified flag 326 my $mod = 1; 327 328 # check modification if needed. 329 if ($p->{pim_index_max} > 0) { # exists last one 330 my $rev = $p->{pim_index_max}; 331 my $dir = $p->{work_directory}; 332 my $old = "$dir/index.$rev"; 333 my $new = $p->{pim_index_tmp}; 334 my $out = "$dir/step.$rev"; 335 my $tmp = "$out.tmp"; 336 337 $mod = &Fan::Scan::scan_mkdiff($tmp, $old, $new); 338 if (!defined($mod)) { 339 warn("Farm::end: can't generate step file" 340 . ", use this index.\n") 341 if $LOG >5; 342 warn("Farm::end: unlink $tmp\n") if $LOG > 5; 343 $mod = 1; 344 } elsif ($mod == 0) { # no modification... 345 warn("Farm::end: no change, $tmp removed.\n") 346 if $LOG > 5; 347 unlink($tmp); 348 } elsif (!rename($tmp, $out)) { 349 carp("Farm::end: rename $tmp -> $out: $!"); 350 unlink($tmp); 351 } 352 } 353 354 # check index modification... 355 if ($mod == 0) { 356 unlink($p->{pim_index_tmp}); 357 warn("Farm::end: no change" 358 . ", $p->{pim_index_tmp} removed.\n") 359 if $LOG > 5; 360 } elsif (rename($p->{pim_index_tmp}, $p->{pim_index})) { 361 warn("Farm::end: rename to $p->{pim_index}: o.k.\n") 362 if $LOG > 5; 363 } else { 364 carp("Farm::end: rename($p->{pim_index}): $!"); 365 } 366 } 367 368 # step mode, skipped in this version. 369 if (0 && defined($fh_step)) { 370 print $fh_step ".\n"; 371 close($fh_step); 372 delete($p->{pim_step_handle}); 373 warn("Farm::end: $p->{pim_step_tmp} was closed.\n") 374 if $LOG > 5; 375 if ($p->{pim_modified} == 0) { 376 unlink($p->{pim_step_tmp}); 377 warn("Farm::end: no chage" 378 . ", $p->{pim_step_tmp} removed.\n") 379 if $LOG > 5; 380 } elsif (rename($p->{pim_step_tmp}, $p->{pim_step})) { 381 warn("Farm::end: rename to $p->{pim_step}: o.k.\n") 382 if $LOG > 5; 383 } else { 384 carp("Farm::end: rename($p->{pim_step}): $!"); 385 } 386 } 387 388 # success, but really? 389 1; 390} 391 392;# Master mode: 393;# Generate full index of the given directory. 394;# (as the newest index). 395;# 396;# this routine should be called after `update' routine. 397;# 398;# Usage: 399;# $p->generate(directory); 400;# where `directory' is the target directory. 401;# 402sub generate ($$) { 403 my $p = shift; 404 my $dir = $p->{work_directory}; 405 my $target = shift; 406 407 # Check revisions... 408 exists($p->{pim_index_new}) || $p->getrev or return undef; 409 410 # Get revision... 411 my $rev = $p->{pim_index_new}; 412 my $outp = "$dir/index.$rev"; 413 my $temp = "$outp.tmp"; 414 415 # open temorary output file. 416 unless (&Fan::Scan::scan_mklist($temp, $target)) { 417 carp("generate:Fan:: Scan::mklist failure"); 418 return undef; 419 } 420 421 # try compare... 422 $rev--; 423 if (exists($p->{pim_index_max}) && $p->{pim_index_max} == $rev) { 424 my $old = "$dir/index.$rev"; 425 my $step = "$dir/step.$rev"; 426 my $tmps = "$step.tmp"; 427 428 my $mod = &Fan::Scan::scan_mkdiff($tmps, $old, $temp); 429 if (!defined($mod)) { 430 warn("generate: scan_mkdiff failure, skipped.\n"); 431 } elsif ($mod == 0) { 432 unlink($tmps); 433 warn("generate: no change, $tmps removed.\n") 434 if $LOG > 5; 435 unlink($temp); 436 warn("generate: no change, $temp removed.\n") 437 if $LOG > 5; 438 return 1; # this is success case. 439 } else { 440 if (rename($tmps, $step)) { 441 warn("generate: rename $tmps -> $step: o.k.\n") 442 if $LOG > 5; 443 } else { 444 carp("generate: rename $tmps -> $step: $!"); 445 unlink($tmps); 446 } 447 } 448 } 449 450 # now, try to rename. 451 unless (rename($temp, $outp)) { 452 carp("generate: rename $temp -> $outp: $!"); 453 unlink($temp); 454 return undef; 455 } 456 457 # 458 warn("generate: rename $temp -> $outp: o.k.\n") if $LOG > 5; 459 460 # success 461 1; 462} 463 464;# Master and slave mode: 465;# Normalize index directory. 466;# (a) generate all step files. 467;# (b) index files are removed except the newest one. 468;# (but, show warning messages only, in this version.) 469;# (c) all step files remain. 470;# 471sub normalize ($;$) { 472 my $p = shift; 473 my $clean = shift; 474 my $dir = $p->{work_directory}; 475 476 # Force to check revisions... 477 $p->getrev or return undef; 478 479 # Check existence of index files... 480 if (!exists($p->{pim_index_max})) { # we have no index file. 481 carp("normalize: have no index file") if $LOG > 4; 482 return undef; 483 } 484 485 # Update index files and calculate revisions again, if needed. 486 if (exists($p->{pim_step_max})) { 487 if ($p->{pim_step_max} >= $p->{pim_index_max}) { 488 $p->update && $p->getrev or return undef; 489 } 490 } 491 492 # Next, check step files. 493 my $max_i = $p->{pim_index_max}; # DOES exist 494 my $rev = $p->{pim_index_min}; # DOES exist 495 $rev = $p->{pim_step_max} + 1 if exists($p->{pim_step_max}); 496 497 # loop. 498 while ($rev < $max_i) { 499 my $out = "$dir/step.$rev"; 500 my $tmp = "$out.tmp"; 501 my $old = "$dir/index.$rev"; 502 $rev++; 503 my $new = "$dir/index.$rev"; 504 505 unless (defined(&Fan::Scan::scan_mkdiff($tmp, $old, $new))) { 506 carp("normalize: can't make diff"); 507 unlink($tmp); 508 return undef; 509 } 510 unless (rename($tmp, $out)) { 511 carp("normalize: rename $tmp -> $out: $!"); 512 unlink($tmp); 513 return undef; 514 } 515 warn("normalize: rename $tmp -> $out: o.k.\n") if $LOG > 5; 516 } 517 518 # unlink redundant files... 519 for ($rev = $p->{pim_index_min}; $rev < $max_i; $rev++) { 520 if ($clean) { 521 unlink("$dir/index.$rev"); 522 warn("normalize: unlink $dir/index.$rev\n") if $LOG > 5; 523 } else { 524 warn("normalize: we should unlink $dir/index.$rev\n") 525 if $LOG > 5; 526 } 527 } 528 529 # get revision numbers once more. 530 unless ($p->getrev) { 531 carp("normalize: can't update revision numbers"); 532 return undef; 533 } 534 535 # shall we clean up? 536 $clean || return 1; 537 538 # abbrev for revision numbers. 539 my $min_s = 0; 540 my $min_i = 0; 541 542 # Initialize... 543 $min_s = $p->{pim_step_min} if exists($p->{pim_step_min}); 544 $min_i = $p->{pim_index_min} if exists($p->{pim_index_min}); 545 546 # Open working directory 547 local *DIR; 548 unless (opendir(DIR, $dir)) { 549 carp("normalize: opendir($dir): $!") if $LOG > 4; 550 return undef; 551 } 552 553 # Search invalid step/index files 554 my $e; 555 while (defined($e = readdir(DIR))) { 556 if ($e =~ /^step\.(\d+)(\.Z|\.gz)?$/) { 557 if (!$min_s || $1 < $min_s) { 558 warn("normalize: unlink $dir/$e\n") 559 if $LOG > 5; 560 # unlink("$dir/$e"); 561 } 562 } elsif ($e =~ /^index\.(\d+)(\.Z|\.gz)?$/) { 563 if (!$min_i || $1 < $min_i) { 564 warn("normalize: unlink $dir/$e\n") 565 if $LOG > 5; 566 # unlink("$dir/$e"); 567 } 568 } else { 569 ; # simply ignored... 570 } 571 } 572 closedir(DIR); 573 574 # success code. 575 1; 576} 577 578;# Master and slave mode: 579;# Generate the newest index file from step files. 580;# 581;# Usage: 582;# $p->updage; 583;# 584sub update ($) { 585 my $p = shift; 586 my $dir = $p->{work_directory}; 587 588 # Check revisions... 589 exists($p->{pim_index_new}) || $p->getrev or return undef; 590 591 # Check existence of index files... 592 if (!exists($p->{pim_index_max})) { # we have no index file. 593 carp("update: can't find base index file.\n") if $LOG > 4; 594 return undef; 595 } 596 597 # Next, check step files. 598 if (!exists($p->{pim_step_max})) { # no step file. 599 warn("update: no step file.\n") if $LOG > 5; 600 return 1; # seems good. 601 } 602 603 # Check revision numbers. 604 if ($p->{pim_step_max} < $p->{pim_index_max}) { 605 warn("update: revision check o.k.\n") if $LOG > 5; 606 return 1; # seems good. 607 } 608 609 # Now, we can generate the newest index file. 610 my $min = $p->{pim_index_max}; # we have... 611 my $max = $p->{pim_step_max}; # we have... 612 my $new = $max + 1; 613 614 # Open the index who has maximum number. 615 my $orig = "$dir/index.$min"; 616 my @diff = (); 617 while ($min <= $max) { 618 push(@diff, "$dir/step.$max"); 619 $min++; 620 } 621 622 my $outp = "$dir/index.$new"; 623 my $temp = "$outp.tmp"; 624 625 # update by Fan::Scan::scan_update. 626 unless (&Fan::Scan::scan_update($temp, $orig, @diff)) { 627 warn("update: Fan::Scan::scan_update failure\n"); 628 unlink($temp); # unlink temporary file 629 return undef; 630 } 631 632 # now try to rename... 633 unless (rename($temp, $outp)) { 634 carp("update: rename($outp): $!") if $LOG > 4; 635 unlink($temp); # unlink temporary file 636 return undef; 637 } 638 639 # debug log 640 warn("update: rename $temp -> $outp: o.k.\n") if $LOG > 5; 641 642 # success 643 1; 644} 645 646;# 647;# a fileter who pickup only step / index files. 648;# 649sub farm_filter { 650 my $y = shift; # Fan::Attrib object. 651 my $t = $y->type; # type abbrev 652 653 if ($t eq 'F') { 654 my $n = $y->name; 655 656 if ($n !~ /^(step|index)\.\d+(\.Z|\.gz)?$/) { 657 warn("farm_filter: $n was skipped.\n") if $LOG > 6; 658 return undef; 659 } 660 } 661 1; 662} 663 664;# Master mode: 665;# Generate local index of the index directory. 666;# 667;# Usage: 668;# $p->genindex; 669;# 670sub genindex ($) { 671 my $p = shift; 672 my $dir = $p->{work_directory}; 673 my $scan = Fan::Scan->new( 674 scan_type => 'LOCAL', 675 scan_dir => $dir 676 ); 677 unless (ref($scan)) { 678 carp("genindex: can't create Scan object"); 679 return undef; 680 } 681 unless ($scan->add_filter(\&farm_filter)) { 682 carp("genindex: can't add filter"); 683 return undef; 684 } 685 686 my $local_index = "$dir/index.local"; 687 my $tmp_index = "$local_index.tmp"; 688 local *TEMP; 689 690 unless (open(TEMP, ">$tmp_index")) { 691 carp("genindex: open($tmp_index): $!"); 692 return undef; 693 } 694 warn("genindex: open $tmp_index: o.k.\n") if $LOG > 5; 695 696 my $y; 697 while (defined($y = $scan->get)) { 698 $y->fill_checksum; 699 print TEMP $y->to_line."\n"; 700 } 701 close(TEMP); 702 703 unless(rename($tmp_index, $local_index)) { 704 carp("genindex: rename($local_index): $!"); 705 unlink($tmp_index); 706 warn("genindex: rename failed, unlink $tmp_index...\n") 707 if $LOG > 5; 708 return undef; 709 } 710 warn("genindex: rename to $local_index: o.k.\n"); 711 1; 712} 713 714;# Slave mode: 715;# Synchronize index directory to the master. 716;# 717;# Usage: 718;# $p->synch('/ftp/db/foo/index.local', $ftp); 719;# where $ftp supports $ftp->get(remote-file, local-file), and 720;# '/db/foo/index.local' is the local-index filename in localhost. 721;# 722sub synch ($$$$) { 723 my $p = shift; # myself 724 my $net = shift; # must support $net->get(remote, local). 725 my $pre = shift; # prefix of remote files. 726 my $start = shift; # file name we will start from. 727 my $dir = $p->{work_directory}; 728 729 # check local file. 730 unless (-f $start) { 731 carp("synch: file $start not found"); 732 return undef; 733 } 734 735 # 736 warn("synch: local file $start: o.k.\n") if $LOG > 5; 737 738 # scanner 739 my $scan = Fan::Scan->new( 740 scan_type => 'INDEX', 741 scan_index => $start, 742 ); 743 unless (ref($scan)) { 744 carp("synch: can't create index scanner"); 745 return undef; 746 } 747 748 # add filter 749 unless ($scan->add_filter(\&farm_filter)) { 750 carp("synch: can't add filter(index)"); 751 return undef; 752 } 753 754 # local side scanner... 755 my $ours = Fan::Scan->new( 756 scan_type => 'LOCAL', 757 scan_dir => $p->{work_directory} 758 ); 759 unless (ref($ours)) { 760 carp("synch: can't create local scanner"); 761 return undef; 762 } 763 764 # add filter 765 unless ($ours->add_filter(\&farm_filter)) { 766 carp("synch: can't add filter(local)"); 767 return undef; 768 } 769 770 # parsing... 771 # this is very simple mirror - only check size and checksum. 772 my $max_y = undef; 773 my $max_i = 0; 774 my $a; 775 my $b; 776 while (($a, $b) = $ours->getcmp($scan)) { 777 my $z; 778 my $t; 779 my $flag = 0; 780 781 if (!defined($a) && !defined($b)) { 782 confess("synch: UNEXPECTED CASE"); 783 } elsif (!defined($a)) { 784 $z = $b; 785 $t = $z->type; 786 $flag++; 787#warn("synch: local does not have $t $z->{y_name}.\n"); 788 } elsif (!defined($b)) { 789 $z = $a; 790 $t = $z->type; 791 $flag--; 792#warn("synch: remote does not have $t $z->{y_name}.\n"); 793 } else { 794 $z = $b; 795 $t = $z->type; 796 797 if ($t eq '.') { 798 ; 799 } elsif ($a->type ne $t) { 800 $flag++; 801#warn("synch: type mismatch $t $z->{y_name}.\n"); 802 } elsif ($t eq 'D') { 803 ; 804 } elsif ($t eq 'U') { 805 ; 806 } elsif ($t eq 'L') { 807 $flag++ if $a->linkto ne $b->linkto; 808#warn("synch: linkto mismatch $t $z->{y_name}.\n"); 809 } elsif ($t ne 'F') { 810 carp("synch: UNKNOWN TYPE $t"); 811 return undef; 812 } elsif (!$a->fill_checksum) { 813 carp("synch: can't get checksum of " 814 . $a->realpath); 815 return undef; 816 } elsif ($a->size != $b->size) { 817 $flag++; 818#warn("synch: size mismatch $t $z->{y_name}.\n"); 819 } elsif ($b->checksum eq '') { 820 carp("synch: NO CHECKSUM for ".$b->path); 821 return undef; 822 } elsif ($a->checksum ne $b->checksum) { 823 $flag++; 824#warn("synch: checksum mismatch $t $z->{y_name}.\n"); 825 } else { 826 ; 827 } 828 } 829 830 # check end. 831 if ($t eq '.') { 832 last; # done 833 } 834 835 # abbrev for path name 836 my $path = "$dir/".$z->path; 837 838 # check index file before $flag check. 839 if ($t eq 'F' && $z->name =~ /^index\.(\d+)/) { 840 ($max_y, $max_i) = ($z, $1) if $max_i < $1; 841 next; 842 } 843 844 # check flag. we only check modified files. 845 $flag > 0 or next; 846 847 # check types... 848 if ($t eq 'D') { 849 unlink($path) if -e $path; 850 unless (mkdir($path, 0755)) { 851 carp("synch: mkdir($path): $!"); 852 return undef; 853 } 854 warn("synch: mkdir($path, 0755): o.k.\n") 855 if $LOG > 5; 856 } elsif ($t eq 'U') { 857 ; 858 } elsif ($t eq 'L') { 859 unlink($path) if -e $path; 860 symlink($z->linkto, $path); 861 warn("synch: symlink($path): o.k.\n") if $LOG > 5; 862 } elsif ($t eq 'F' && $z->name =~ /^step\./) { 863 unless ($net->get($pre.'/'.$z->path, $path)) { 864 carp("synch: GET($path): ".$net->error); 865 next; # skip this... 866 } 867 chmod((defined($z->perm) ? $z->perm : 0644), $path); 868 my $m = $z->mtime; 869 if ($m > 0) { 870 utime($m, $m, $path); 871 } 872 warn("synch: get $path: o.k.\n") if $LOG > 5; 873 } else { 874 ; # what? 875 } 876 } 877 878 # calculate revision numbers... 879 $p->getrev || return undef; 880 881 # try update. 882 unless ($p->update) { 883 warn("synch: can't update $dir, try continue...\n") 884 if $LOG > 4; 885 # continue... 886 } 887 888 # calculate revision numbers once more 889 $p->getrev || return undef; 890 891 # check remote side index file. 892 unless (ref($max_y)) { 893 carp("synch: no index file in remote"); 894 return undef; 895 } 896 897 # relative path name 898 my $path = $max_y->path; 899 900 # check index number... 901 # same index? 902 if ($max_i == $p->{pim_index_max}) { 903 if ($max_y->name !~ /^index\.(\d+)$/) { 904 if ($LOG > 4) { 905 warn("synch: remote index is compressed.\n"); 906 warn("synch: skip checksum check.\n"); 907 } 908 return 1; 909 } 910 # or checksum test. 911 if (MD5File("$dir/$path") eq $max_y->checksum) { 912 warn("synch: checksum($dir/$path) ok, very good!\n") 913 if $LOG > 5; 914 return 1; 915 } else { # checksum error 916 warn("synch: checksum error, unlink $dir/$path.\n") 917 if $LOG > 5; 918 unlink("$dir/$path"); 919 } 920 } elsif ($max_i < $p->{pim_index_max}) { 921 if ($LOG > 5) { 922 warn("synch: local index($p->{pim_index_max}) was " 923 . "greater than remote($max_i)\n"); 924 warn("synch: this may be good...\n"); 925 } 926 return 1; 927 } 928 929 # remaining case is ($max_i > $p->{pim_index_max}), 930 # or checksum error 931 if (exists($p->{pim_index_max}) && $max_i > $p->{pim_index_max}) { 932 warn("synch: remtoe has greater index($max_i)" 933 ." than local($p->{pim_index_max}).\n") if $LOG > 4; 934 } 935 if ($LOG > 4) { 936 warn("synch: try to get $path...\n"); 937 } 938 unless ($net->get("$pre/$path", "$dir/$path")) { 939 carp("synch: GET($path): failed"); 940 return undef; 941 } 942 unless ($max_y->checksum eq MD5File("$dir/$path")) { 943 warn("synch: CHECKSUM($path) mismatch, unlink it.\n"); 944 unlink("$dir/$path"); 945 return undef; 946 } 947 chmod(0644, "$dir/$path"); 948 949 my $m = $max_y->mtime; 950 if ($m > 0) { 951 utime($m, $m, "$dir/$path"); 952 } 953 954 # success to small mirror, get revisions again. 955 $p->getrev; 956} 957 958;# Get revision number for this package. 959;# A file "step.i" is a diff file between "index.i" and 960;# "index.(i+1)", that is, we can generate "index.12" 961;# from "index.11" and "step.11". 962;# 963;# If this routine returns success code (== 1), you can 964;# always access to $p->{pim_index_new}; 965;# 966sub getrev ($) { 967 my $p = shift; 968 my $dir = $p->{work_directory}; 969 970 # Clear old revision numbers. 971 delete($p->{pim_index_max}); 972 delete($p->{pim_index_min}); 973 delete($p->{pim_index_new}); 974 delete($p->{pim_step_max}); 975 delete($p->{pim_step_min}); 976 977 # try to open directory... 978 local *DIR; 979 unless (opendir(DIR, $dir)) { 980 carp("getrev: opendir($dir): $!") if $LOG > 4; 981 return undef; 982 } 983 984 # local variables to search revisions. 985 my %steps = (); 986 my %indexes = (); 987 my $e; 988 989 # read directory entries, and search `index.n'. 990 while (defined($e = readdir(DIR))) { 991 if ($e =~ /^step\.(\d+)(\.Z|\.gz)?$/) { 992 $steps{$1 + 0}++; 993 } elsif ($e =~ /^index\.(\d+)(\.Z|\.gz)?$/) { 994 $indexes{$1 + 0}++; 995 } else { 996 ; # simply ignored. 997 } 998 } 999 closedir(DIR); 1000 1001 # sort steps in reverse order... 1002 my @steps = sort { $b <=> $a } keys %steps; 1003 my @indexes = sort { $b <=> $a } keys %indexes; 1004 1005 # Maximum / minimum index of step files. 1006 my $max_s = 0; 1007 my $min_s = 0; 1008 1009 # Check the chain of step files. 1010 # Search largest continuous block. 1011 if (@steps) { 1012 $min_s = $max_s = shift(@steps); 1013 while (@steps) { 1014 $min_s - 1 == shift(@steps) || last; 1015 $min_s--; 1016 } 1017 } 1018 1019 # Indexes for index files. 1020 my $max_i = 0; 1021 my $min_i = 0; 1022 1023 # Check the chain of step files. 1024 # Search largest continuous block. 1025 if (@indexes) { 1026 $min_i = $max_i = shift(@indexes); 1027 while (@indexes) { 1028 $min_i - 1 == shift(@indexes) || last; 1029 $min_i--; 1030 } 1031 } 1032 1033 # Validation 1034 if ($max_i == 0 && $max_s == 0) { # nothing found. 1035 $p->{pim_index_new} = 1; 1036 } elsif ($max_i < $min_s) { # unexpected case... 1037 $p->{pim_index_new} = $max_s + 2; # skip one. 1038 } elsif ($max_s == 0 || $min_i > $max_s + 1) { # step has no meaning 1039 $p->{pim_index_max} = $max_i; # we have... 1040 $p->{pim_index_min} = $min_i; # we have... 1041 $p->{pim_index_new} = $max_i + 1; # we will... 1042 } else { # seems good. 1043 $p->{pim_step_max} = $max_s; # we have... 1044 $p->{pim_step_min} = $min_s; # we have... 1045 $p->{pim_index_max} = $max_i; # we have... 1046 $p->{pim_index_min} = $min_i; # we have... 1047 if ($max_i > $max_s) { # $max_i is maximum. 1048 $p->{pim_index_new} = $max_i + 1; # we will... 1049 } else { # we can generate ($max_s + 1). 1050 $p->{pim_index_new} = $max_s + 2; # we will... 1051 } 1052 } 1053 1054 # return success code. 1055 1; 1056} 1057 1058;# end of Fan::Farm module 1059