;#
;# Copyright (c) 1995-1997
;# Ikuo Nakagawa. All rights reserved.
;#
;# Redistribution and use in source and binary forms, with or without
;# modification, are permitted provided that the following conditions
;# are met:
;#
;# 1. Redistributions of source code must retain the above copyright
;# notice unmodified, this list of conditions, and the following
;# disclaimer.
;# 2. Redistributions in binary form must reproduce the above copyright
;# notice, this list of conditions and the following disclaimer in the
;# documentation and/or other materials provided with the distribution.
;#
;# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
;# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
;# PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS
;# BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,
;# OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
;# OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
;# BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
;# OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
;# EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;#
;# $Id: Farm.pm,v 1.21 1997/09/26 04:48:32 ikuo Exp $
;#
package Fan::Farm;
use strict;
use vars qw($VERSION $LOG);
use Carp;
use Fan::MD5;
use Fan::Cool;
use Fan::Scan;
use AutoLoader 'AUTOLOAD';
$VERSION = '0.04';
$LOG = 5;
;# A special marker for AutoSplit.
1;
__END__
;#
;# Destroy FTP Archive Revision Manager object.
;#
sub DESTROY ($) {
my $p = shift; # myself.
my $dir = $p->{work_directory}; # farm directory.
# Unlink all temporary files, including the lock file
# for the working directory.
for my $file (keys %{$p->{tempfiles}}) {
warn("Fan::Farm unlink $file...\n") if $LOG > 5;
unlink($file) if -e $file;
}
# Log message.
carp("Fan::Farm DESTROYING $p") if $LOG > 5;
}
;#
;# Creating FTP Archive Revision Managemer object.
;#
;# Usage: THIS::CLASS->new(directory_name);
;#
;# where directory_name is the directory who contains index
;# or step files.
;#
;# Index files are named as: index.1, index.2, ...
;# And step files: step.1, step.2, ...
;# step.n contains all differences between index.n and
;# index.(n+1), that is, we can generate index.(n+1) if we
;# have index.n and step.n.
;#
;# There may be also local index file, named `index.local'
;# which contains index of this work directory itself.
;#
sub new ($$) {
my $this = shift;
my $class = ref($this) || $this;
my $dir = shift;
# Check directory definition.
if ($dir eq '') {
carp("Fan::Farm directory not defined") if $LOG > 5;
return undef;
}
# Check directory existence.
if (! -d $dir) {
carp("Fan::Farm no directory: $dir") if $LOG > 4;
return undef;
}
# Try bless this object before we lock this directory.
my $p = bless { work_directory => $dir }, $class;
ref($p) || croak("Fan::Farm can't bless object");
carp("Fan::Farm CREATING $p") if $LOG > 5;
# Add the lock file to the hash of temporary files.
my $lock = "$dir/.LOCK";
$p->{tempfiles}->{$lock}++;
# Try to lock directory.
unless (plock($lock, 30)) {
carp("Fan::Farm can't lock directory: $dir") if $LOG > 4;
return undef;
}
# Try to get revision.
unless ($p->getrev) {
carp("Fan::Farm can't get revision") if $LOG > 4;
return undef;
}
# Return myself.
$p;
}
;#
;# farm_begin ...
;# initialize farm index updater.
;#
sub d_begin ($) {
my $p = shift;
my $dir = $p->{work_directory};
my $fh;
# clear
$p->{pim_stack} = [];
$p->{pim_depth} = 0;
$p->{pim_modified} = 0;
# Check revisions...
exists($p->{pim_index_new}) || $p->getrev or return undef;
# check revision numbers
my $rev = $p->{pim_index_new};
$p->{pim_index} = "$dir/index.$rev";
$p->{pim_index_tmp} = $p->{pim_index}.'.tmp';
local *TMPINDEX;
unless (open(TMPINDEX, ">$p->{pim_index_tmp}")) {
carp("d_begin open($p->{pim_index_tmp}): $!");
return undef;
}
$p->{pim_index_handle} = *TMPINDEX;
# information log...
warn("Farm::begin: open $p->{pim_index_tmp}: o.k.\n") if $LOG > 5;
# CAUTION:
# WE CAN GENERATE STEP FILE EVEN IF WE ARE CREATING A NEW
# INDEX FILE, BUT WE SHOULD GENERATE STEP FILE FROM INDEX
# FILES...
return 1;
# shall we go step mode?
$rev > 1 || return 1;
# we are required step mode.
$rev--;
$p->{pim_step} = "$dir/step.$rev";
$p->{pim_step_tmp} = $p->{pim_step}.'.tmp';
#
local *TMPSTEP;
unless (open(TMPSTEP, ">$p->{pim_step_tmp}")) {
carp("Farm::begin: open($p->{pim_step_tmp}): $!");
return undef;
}
$p->{pim_step_handle} = *TMPSTEP;
# information log...
warn("Farm::begin: open $p->{pim_step_tmp}: o.k.\n") if $LOG > 5;
# success
1;
}
;#
;# farm_add
;# add a file (Attrib object) to updater
;#
sub d_add ($$) {
my $p = shift;
my $fh_index = $p->{pim_index_handle};
my $fh_step = $p->{pim_step_handle};
# check file handle first.
unless (defined($fh_index)) {
carp("Farm::add: has no file handle");
return undef;
}
my $y = shift; # Attribute.
my $t = $y->type; # Abbrev for type of $y.
my $f = $y->flag; # Abbrev for flag of $y.
# At first, check the depth of the current tree.
if ($t eq 'D') {
warn("Farm::add: down to \"".$y->name."\"\n") if $LOG > 6;
$p->{pim_depth}++;
} elsif ($t eq 'U') {
warn("Farm::add: up to \"..\"\n") if $LOG > 6;
$p->{pim_depth}--;
} else {
warn("Farm::add: checking ".$y->name." (type=$t)...\n")
if $LOG > 6;
}
# Check type/flag for given attribute.
if ($t eq '.') {
return $p->d_end; # terminator will be printed.
}
# check if we have any modification.
if ($f ne '') {
$p->{pim_modified} = 1;
}
# step mode ?
if (!defined($fh_step)) {
; # no step mode
} elsif ($t eq 'D' && $y->name eq '.') {
print $fh_step $y->to_line."\n";
} elsif ($f eq '') {
if ($t eq 'D') {
push(@{$p->{pim_stack}}, $y);
} elsif ($t eq 'U') {
if (@{$p->{pim_stack}}) {
pop(@{$p->{pim_stack}});
} else {
print $fh_step "U\n";
}
}
} else {
while (@{$p->{pim_stack}}) {
my $a = shift(@{$p->{pim_stack}});
print $fh_step $a->to_line."\n";
}
print $fh_step $y->to_line."\n";
}
# index mode
if ($f ne '-') { # ignore removed files.
$y->flag(''); # clear flag
print $fh_index $y->to_line."\n";
$y->flag($f); # restore.
}
# success
1;
}
;#
;# farm_end
;# terminate updater
;#
sub d_end ($) {
my $p = shift;
my $fh_index = $p->{pim_index_handle};
my $fh_step = $p->{pim_step_handle};
# Check file handle
unless (defined($fh_index)) {
carp("Farm::end: no file handle defined") if $LOG > 5;
return undef;
}
# Check depth of working tree.
if ($p->{pim_depth} < 1) {
carp("Farm::end: ouch! pim_depth is too small") if $LOG > 4;
close($fh_index); # We must close output file.
delete($p->{pim_index_handle});
unlink($p->{pim_index_tmp});
warn("Farm::end: $p->{pim_index_tmp} unlinked.\n")
if $LOG > 5;
if (defined($fh_step)) {
close($fh_step);
delete($p->{pim_step_handle});
unlink($p->{pim_step_tmp});
warn("Farm::end: $p->{pim_step_tmp} unlinked.\n")
if $LOG > 5;
}
return undef;
}
# Greater depth means "terminated abnormally"
if ($p->{pim_depth} > 1) {
carp("Farm::end: pim_depth > 1, index abort") if $LOG > 3;
close($fh_index); # We must close output file.
delete($p->{pim_index_handle});
unlink($p->{pim_index_tmp});
$fh_index = '';
warn("Farm::end: $p->{pim_index_tmp} unlinked.\n")
if $LOG > 5;
if (defined($fh_step)) {
warn("Farm::end: try to fix step files.....\n")
if $LOG > 5;
while ($p->{pim_depth} > 1) {
if (@{$p->{pim_stack}}) {
pop(@{$p->{pim_stack}});
} else {
print $fh_step "U\n";
}
$p->{pim_depth}--;
}
}
}
# put terminator, and close output file.
if (defined($fh_index)) {
print $fh_index ".\n";
close($fh_index);
delete($p->{pim_index_handle});
warn("Farm::end: $p->{pim_index_tmp} was closed.\n")
if $LOG > 5;
# modified flag
my $mod = 1;
# check modification if needed.
if ($p->{pim_index_max} > 0) { # exists last one
my $rev = $p->{pim_index_max};
my $dir = $p->{work_directory};
my $old = "$dir/index.$rev";
my $new = $p->{pim_index_tmp};
my $out = "$dir/step.$rev";
my $tmp = "$out.tmp";
$mod = &Fan::Scan::scan_mkdiff($tmp, $old, $new);
if (!defined($mod)) {
warn("Farm::end: can't generate step file"
. ", use this index.\n")
if $LOG >5;
warn("Farm::end: unlink $tmp\n") if $LOG > 5;
$mod = 1;
} elsif ($mod == 0) { # no modification...
warn("Farm::end: no change, $tmp removed.\n")
if $LOG > 5;
unlink($tmp);
} elsif (!rename($tmp, $out)) {
carp("Farm::end: rename $tmp -> $out: $!");
unlink($tmp);
}
}
# check index modification...
if ($mod == 0) {
unlink($p->{pim_index_tmp});
warn("Farm::end: no change"
. ", $p->{pim_index_tmp} removed.\n")
if $LOG > 5;
} elsif (rename($p->{pim_index_tmp}, $p->{pim_index})) {
warn("Farm::end: rename to $p->{pim_index}: o.k.\n")
if $LOG > 5;
} else {
carp("Farm::end: rename($p->{pim_index}): $!");
}
}
# step mode, skipped in this version.
if (0 && defined($fh_step)) {
print $fh_step ".\n";
close($fh_step);
delete($p->{pim_step_handle});
warn("Farm::end: $p->{pim_step_tmp} was closed.\n")
if $LOG > 5;
if ($p->{pim_modified} == 0) {
unlink($p->{pim_step_tmp});
warn("Farm::end: no chage"
. ", $p->{pim_step_tmp} removed.\n")
if $LOG > 5;
} elsif (rename($p->{pim_step_tmp}, $p->{pim_step})) {
warn("Farm::end: rename to $p->{pim_step}: o.k.\n")
if $LOG > 5;
} else {
carp("Farm::end: rename($p->{pim_step}): $!");
}
}
# success, but really?
1;
}
;# Master mode:
;# Generate full index of the given directory.
;# (as the newest index).
;#
;# this routine should be called after `update' routine.
;#
;# Usage:
;# $p->generate(directory);
;# where `directory' is the target directory.
;#
sub generate ($$) {
my $p = shift;
my $dir = $p->{work_directory};
my $target = shift;
# Check revisions...
exists($p->{pim_index_new}) || $p->getrev or return undef;
# Get revision...
my $rev = $p->{pim_index_new};
my $outp = "$dir/index.$rev";
my $temp = "$outp.tmp";
# open temorary output file.
unless (&Fan::Scan::scan_mklist($temp, $target)) {
carp("generate:Fan:: Scan::mklist failure");
return undef;
}
# try compare...
$rev--;
if (exists($p->{pim_index_max}) && $p->{pim_index_max} == $rev) {
my $old = "$dir/index.$rev";
my $step = "$dir/step.$rev";
my $tmps = "$step.tmp";
my $mod = &Fan::Scan::scan_mkdiff($tmps, $old, $temp);
if (!defined($mod)) {
warn("generate: scan_mkdiff failure, skipped.\n");
} elsif ($mod == 0) {
unlink($tmps);
warn("generate: no change, $tmps removed.\n")
if $LOG > 5;
unlink($temp);
warn("generate: no change, $temp removed.\n")
if $LOG > 5;
return 1; # this is success case.
} else {
if (rename($tmps, $step)) {
warn("generate: rename $tmps -> $step: o.k.\n")
if $LOG > 5;
} else {
carp("generate: rename $tmps -> $step: $!");
unlink($tmps);
}
}
}
# now, try to rename.
unless (rename($temp, $outp)) {
carp("generate: rename $temp -> $outp: $!");
unlink($temp);
return undef;
}
#
warn("generate: rename $temp -> $outp: o.k.\n") if $LOG > 5;
# success
1;
}
;# Master and slave mode:
;# Normalize index directory.
;# (a) generate all step files.
;# (b) index files are removed except the newest one.
;# (but, show warning messages only, in this version.)
;# (c) all step files remain.
;#
sub normalize ($;$) {
my $p = shift;
my $clean = shift;
my $dir = $p->{work_directory};
# Force to check revisions...
$p->getrev or return undef;
# Check existence of index files...
if (!exists($p->{pim_index_max})) { # we have no index file.
carp("normalize: have no index file") if $LOG > 4;
return undef;
}
# Update index files and calculate revisions again, if needed.
if (exists($p->{pim_step_max})) {
if ($p->{pim_step_max} >= $p->{pim_index_max}) {
$p->update && $p->getrev or return undef;
}
}
# Next, check step files.
my $max_i = $p->{pim_index_max}; # DOES exist
my $rev = $p->{pim_index_min}; # DOES exist
$rev = $p->{pim_step_max} + 1 if exists($p->{pim_step_max});
# loop.
while ($rev < $max_i) {
my $out = "$dir/step.$rev";
my $tmp = "$out.tmp";
my $old = "$dir/index.$rev";
$rev++;
my $new = "$dir/index.$rev";
unless (defined(&Fan::Scan::scan_mkdiff($tmp, $old, $new))) {
carp("normalize: can't make diff");
unlink($tmp);
return undef;
}
unless (rename($tmp, $out)) {
carp("normalize: rename $tmp -> $out: $!");
unlink($tmp);
return undef;
}
warn("normalize: rename $tmp -> $out: o.k.\n") if $LOG > 5;
}
# unlink redundant files...
for ($rev = $p->{pim_index_min}; $rev < $max_i; $rev++) {
if ($clean) {
unlink("$dir/index.$rev");
warn("normalize: unlink $dir/index.$rev\n") if $LOG > 5;
} else {
warn("normalize: we should unlink $dir/index.$rev\n")
if $LOG > 5;
}
}
# get revision numbers once more.
unless ($p->getrev) {
carp("normalize: can't update revision numbers");
return undef;
}
# shall we clean up?
$clean || return 1;
# abbrev for revision numbers.
my $min_s = 0;
my $min_i = 0;
# Initialize...
$min_s = $p->{pim_step_min} if exists($p->{pim_step_min});
$min_i = $p->{pim_index_min} if exists($p->{pim_index_min});
# Open working directory
local *DIR;
unless (opendir(DIR, $dir)) {
carp("normalize: opendir($dir): $!") if $LOG > 4;
return undef;
}
# Search invalid step/index files
my $e;
while (defined($e = readdir(DIR))) {
if ($e =~ /^step\.(\d+)(\.Z|\.gz)?$/) {
if (!$min_s || $1 < $min_s) {
warn("normalize: unlink $dir/$e\n")
if $LOG > 5;
# unlink("$dir/$e");
}
} elsif ($e =~ /^index\.(\d+)(\.Z|\.gz)?$/) {
if (!$min_i || $1 < $min_i) {
warn("normalize: unlink $dir/$e\n")
if $LOG > 5;
# unlink("$dir/$e");
}
} else {
; # simply ignored...
}
}
closedir(DIR);
# success code.
1;
}
;# Master and slave mode:
;# Generate the newest index file from step files.
;#
;# Usage:
;# $p->updage;
;#
sub update ($) {
my $p = shift;
my $dir = $p->{work_directory};
# Check revisions...
exists($p->{pim_index_new}) || $p->getrev or return undef;
# Check existence of index files...
if (!exists($p->{pim_index_max})) { # we have no index file.
carp("update: can't find base index file.\n") if $LOG > 4;
return undef;
}
# Next, check step files.
if (!exists($p->{pim_step_max})) { # no step file.
warn("update: no step file.\n") if $LOG > 5;
return 1; # seems good.
}
# Check revision numbers.
if ($p->{pim_step_max} < $p->{pim_index_max}) {
warn("update: revision check o.k.\n") if $LOG > 5;
return 1; # seems good.
}
# Now, we can generate the newest index file.
my $min = $p->{pim_index_max}; # we have...
my $max = $p->{pim_step_max}; # we have...
my $new = $max + 1;
# Open the index who has maximum number.
my $orig = "$dir/index.$min";
my @diff = ();
while ($min <= $max) {
push(@diff, "$dir/step.$max");
$min++;
}
my $outp = "$dir/index.$new";
my $temp = "$outp.tmp";
# update by Fan::Scan::scan_update.
unless (&Fan::Scan::scan_update($temp, $orig, @diff)) {
warn("update: Fan::Scan::scan_update failure\n");
unlink($temp); # unlink temporary file
return undef;
}
# now try to rename...
unless (rename($temp, $outp)) {
carp("update: rename($outp): $!") if $LOG > 4;
unlink($temp); # unlink temporary file
return undef;
}
# debug log
warn("update: rename $temp -> $outp: o.k.\n") if $LOG > 5;
# success
1;
}
;#
;# a fileter who pickup only step / index files.
;#
sub farm_filter {
my $y = shift; # Fan::Attrib object.
my $t = $y->type; # type abbrev
if ($t eq 'F') {
my $n = $y->name;
if ($n !~ /^(step|index)\.\d+(\.Z|\.gz)?$/) {
warn("farm_filter: $n was skipped.\n") if $LOG > 6;
return undef;
}
}
1;
}
;# Master mode:
;# Generate local index of the index directory.
;#
;# Usage:
;# $p->genindex;
;#
sub genindex ($) {
my $p = shift;
my $dir = $p->{work_directory};
my $scan = Fan::Scan->new(
scan_type => 'LOCAL',
scan_dir => $dir
);
unless (ref($scan)) {
carp("genindex: can't create Scan object");
return undef;
}
unless ($scan->add_filter(\&farm_filter)) {
carp("genindex: can't add filter");
return undef;
}
my $local_index = "$dir/index.local";
my $tmp_index = "$local_index.tmp";
local *TEMP;
unless (open(TEMP, ">$tmp_index")) {
carp("genindex: open($tmp_index): $!");
return undef;
}
warn("genindex: open $tmp_index: o.k.\n") if $LOG > 5;
my $y;
while (defined($y = $scan->get)) {
$y->fill_checksum;
print TEMP $y->to_line."\n";
}
close(TEMP);
unless(rename($tmp_index, $local_index)) {
carp("genindex: rename($local_index): $!");
unlink($tmp_index);
warn("genindex: rename failed, unlink $tmp_index...\n")
if $LOG > 5;
return undef;
}
warn("genindex: rename to $local_index: o.k.\n");
1;
}
;# Slave mode:
;# Synchronize index directory to the master.
;#
;# Usage:
;# $p->synch('/ftp/db/foo/index.local', $ftp);
;# where $ftp supports $ftp->get(remote-file, local-file), and
;# '/db/foo/index.local' is the local-index filename in localhost.
;#
sub synch ($$$$) {
my $p = shift; # myself
my $net = shift; # must support $net->get(remote, local).
my $pre = shift; # prefix of remote files.
my $start = shift; # file name we will start from.
my $dir = $p->{work_directory};
# check local file.
unless (-f $start) {
carp("synch: file $start not found");
return undef;
}
#
warn("synch: local file $start: o.k.\n") if $LOG > 5;
# scanner
my $scan = Fan::Scan->new(
scan_type => 'INDEX',
scan_index => $start,
);
unless (ref($scan)) {
carp("synch: can't create index scanner");
return undef;
}
# add filter
unless ($scan->add_filter(\&farm_filter)) {
carp("synch: can't add filter(index)");
return undef;
}
# local side scanner...
my $ours = Fan::Scan->new(
scan_type => 'LOCAL',
scan_dir => $p->{work_directory}
);
unless (ref($ours)) {
carp("synch: can't create local scanner");
return undef;
}
# add filter
unless ($ours->add_filter(\&farm_filter)) {
carp("synch: can't add filter(local)");
return undef;
}
# parsing...
# this is very simple mirror - only check size and checksum.
my $max_y = undef;
my $max_i = 0;
my $a;
my $b;
while (($a, $b) = $ours->getcmp($scan)) {
my $z;
my $t;
my $flag = 0;
if (!defined($a) && !defined($b)) {
confess("synch: UNEXPECTED CASE");
} elsif (!defined($a)) {
$z = $b;
$t = $z->type;
$flag++;
#warn("synch: local does not have $t $z->{y_name}.\n");
} elsif (!defined($b)) {
$z = $a;
$t = $z->type;
$flag--;
#warn("synch: remote does not have $t $z->{y_name}.\n");
} else {
$z = $b;
$t = $z->type;
if ($t eq '.') {
;
} elsif ($a->type ne $t) {
$flag++;
#warn("synch: type mismatch $t $z->{y_name}.\n");
} elsif ($t eq 'D') {
;
} elsif ($t eq 'U') {
;
} elsif ($t eq 'L') {
$flag++ if $a->linkto ne $b->linkto;
#warn("synch: linkto mismatch $t $z->{y_name}.\n");
} elsif ($t ne 'F') {
carp("synch: UNKNOWN TYPE $t");
return undef;
} elsif (!$a->fill_checksum) {
carp("synch: can't get checksum of "
. $a->realpath);
return undef;
} elsif ($a->size != $b->size) {
$flag++;
#warn("synch: size mismatch $t $z->{y_name}.\n");
} elsif ($b->checksum eq '') {
carp("synch: NO CHECKSUM for ".$b->path);
return undef;
} elsif ($a->checksum ne $b->checksum) {
$flag++;
#warn("synch: checksum mismatch $t $z->{y_name}.\n");
} else {
;
}
}
# check end.
if ($t eq '.') {
last; # done
}
# abbrev for path name
my $path = "$dir/".$z->path;
# check index file before $flag check.
if ($t eq 'F' && $z->name =~ /^index\.(\d+)/) {
($max_y, $max_i) = ($z, $1) if $max_i < $1;
next;
}
# check flag. we only check modified files.
$flag > 0 or next;
# check types...
if ($t eq 'D') {
unlink($path) if -e $path;
unless (mkdir($path, 0755)) {
carp("synch: mkdir($path): $!");
return undef;
}
warn("synch: mkdir($path, 0755): o.k.\n")
if $LOG > 5;
} elsif ($t eq 'U') {
;
} elsif ($t eq 'L') {
unlink($path) if -e $path;
symlink($z->linkto, $path);
warn("synch: symlink($path): o.k.\n") if $LOG > 5;
} elsif ($t eq 'F' && $z->name =~ /^step\./) {
unless ($net->get($pre.'/'.$z->path, $path)) {
carp("synch: GET($path): ".$net->error);
next; # skip this...
}
chmod((defined($z->perm) ? $z->perm : 0644), $path);
my $m = $z->mtime;
if ($m > 0) {
utime($m, $m, $path);
}
warn("synch: get $path: o.k.\n") if $LOG > 5;
} else {
; # what?
}
}
# calculate revision numbers...
$p->getrev || return undef;
# try update.
unless ($p->update) {
warn("synch: can't update $dir, try continue...\n")
if $LOG > 4;
# continue...
}
# calculate revision numbers once more
$p->getrev || return undef;
# check remote side index file.
unless (ref($max_y)) {
carp("synch: no index file in remote");
return undef;
}
# relative path name
my $path = $max_y->path;
# check index number...
# same index?
if ($max_i == $p->{pim_index_max}) {
if ($max_y->name !~ /^index\.(\d+)$/) {
if ($LOG > 4) {
warn("synch: remote index is compressed.\n");
warn("synch: skip checksum check.\n");
}
return 1;
}
# or checksum test.
if (MD5File("$dir/$path") eq $max_y->checksum) {
warn("synch: checksum($dir/$path) ok, very good!\n")
if $LOG > 5;
return 1;
} else { # checksum error
warn("synch: checksum error, unlink $dir/$path.\n")
if $LOG > 5;
unlink("$dir/$path");
}
} elsif ($max_i < $p->{pim_index_max}) {
if ($LOG > 5) {
warn("synch: local index($p->{pim_index_max}) was "
. "greater than remote($max_i)\n");
warn("synch: this may be good...\n");
}
return 1;
}
# remaining case is ($max_i > $p->{pim_index_max}),
# or checksum error
if (exists($p->{pim_index_max}) && $max_i > $p->{pim_index_max}) {
warn("synch: remtoe has greater index($max_i)"
." than local($p->{pim_index_max}).\n") if $LOG > 4;
}
if ($LOG > 4) {
warn("synch: try to get $path...\n");
}
unless ($net->get("$pre/$path", "$dir/$path")) {
carp("synch: GET($path): failed");
return undef;
}
unless ($max_y->checksum eq MD5File("$dir/$path")) {
warn("synch: CHECKSUM($path) mismatch, unlink it.\n");
unlink("$dir/$path");
return undef;
}
chmod(0644, "$dir/$path");
my $m = $max_y->mtime;
if ($m > 0) {
utime($m, $m, "$dir/$path");
}
# success to small mirror, get revisions again.
$p->getrev;
}
;# Get revision number for this package.
;# A file "step.i" is a diff file between "index.i" and
;# "index.(i+1)", that is, we can generate "index.12"
;# from "index.11" and "step.11".
;#
;# If this routine returns success code (== 1), you can
;# always access to $p->{pim_index_new};
;#
sub getrev ($) {
my $p = shift;
my $dir = $p->{work_directory};
# Clear old revision numbers.
delete($p->{pim_index_max});
delete($p->{pim_index_min});
delete($p->{pim_index_new});
delete($p->{pim_step_max});
delete($p->{pim_step_min});
# try to open directory...
local *DIR;
unless (opendir(DIR, $dir)) {
carp("getrev: opendir($dir): $!") if $LOG > 4;
return undef;
}
# local variables to search revisions.
my %steps = ();
my %indexes = ();
my $e;
# read directory entries, and search `index.n'.
while (defined($e = readdir(DIR))) {
if ($e =~ /^step\.(\d+)(\.Z|\.gz)?$/) {
$steps{$1 + 0}++;
} elsif ($e =~ /^index\.(\d+)(\.Z|\.gz)?$/) {
$indexes{$1 + 0}++;
} else {
; # simply ignored.
}
}
closedir(DIR);
# sort steps in reverse order...
my @steps = sort { $b <=> $a } keys %steps;
my @indexes = sort { $b <=> $a } keys %indexes;
# Maximum / minimum index of step files.
my $max_s = 0;
my $min_s = 0;
# Check the chain of step files.
# Search largest continuous block.
if (@steps) {
$min_s = $max_s = shift(@steps);
while (@steps) {
$min_s - 1 == shift(@steps) || last;
$min_s--;
}
}
# Indexes for index files.
my $max_i = 0;
my $min_i = 0;
# Check the chain of step files.
# Search largest continuous block.
if (@indexes) {
$min_i = $max_i = shift(@indexes);
while (@indexes) {
$min_i - 1 == shift(@indexes) || last;
$min_i--;
}
}
# Validation
if ($max_i == 0 && $max_s == 0) { # nothing found.
$p->{pim_index_new} = 1;
} elsif ($max_i < $min_s) { # unexpected case...
$p->{pim_index_new} = $max_s + 2; # skip one.
} elsif ($max_s == 0 || $min_i > $max_s + 1) { # step has no meaning
$p->{pim_index_max} = $max_i; # we have...
$p->{pim_index_min} = $min_i; # we have...
$p->{pim_index_new} = $max_i + 1; # we will...
} else { # seems good.
$p->{pim_step_max} = $max_s; # we have...
$p->{pim_step_min} = $min_s; # we have...
$p->{pim_index_max} = $max_i; # we have...
$p->{pim_index_min} = $min_i; # we have...
if ($max_i > $max_s) { # $max_i is maximum.
$p->{pim_index_new} = $max_i + 1; # we will...
} else { # we can generate ($max_s + 1).
$p->{pim_index_new} = $max_s + 2; # we will...
}
}
# return success code.
1;
}
;# end of Fan::Farm module
syntax highlighted by Code2HTML, v. 0.9.1