;#
;# Copyright (c) 1995-1998
;#	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: Fan.pm,v 1.42 1999/11/21 08:24:27 ikuo Exp $
;#
package Fan;

use strict;
use vars qw(@ISA $VERSION $LOG $sysconfdir $loader %pkeys %pnest %initval);

;# modules
use Carp;
use Fan::Param;
use Fan::Cool;
use Fan::Scan;
use Fan::Farm;
use Fan::Loader;
use AutoLoader 'AUTOLOAD';

;#
@ISA = qw(Fan::Param);
$VERSION = '0.03';
$LOG = 5;

;# Where configuration files are.
BEGIN {
	$sysconfdir = '%%PREFIX%%/etc';
}

;#
%pkeys = (
	'sysconfdir'			=> 'DIRECTORY',
	'todo'				=> '',
	'load_config'			=> '',
	'username'			=> '',
	'hostname'			=> '',
	'create_directory'		=> 'BOOLEAN',
	'alternate_package'		=> '',
	'debug'				=> 'BOOLEAN',
	'verbose'			=> 'BOOLEAN',
	'log_label'			=> '',
	'log_mask'			=> '',
	'change_directory'		=> 'BOOLEAN',
	'use_dirinfo'			=> 'BOOLEAN',
	'load_remote_dirinfo'		=> 'BOOLEAN',
	'load_local_dirinfo'		=> 'BOOLEAN',
	'store_local_dirinfo'		=> 'BOOLEAN',
	'ftp_debug'			=> 'BOOLEAN',
	'ftp_stats'			=> 'BOOLEAN',
	'ftp_timeout'			=> 'INTEGER',
	'ftp_bindaddr'			=> 'IPv4_ADDR',
	'ftp_passive'			=> 'BOOLEAN',
	'ftp_server'			=> '',
	'ftp_port'			=> '',
	'ftp_gateway'			=> '',
	'ftp_user'			=> '',
	'ftp_pass'			=> '',
	'ftp_group'			=> '',
	'ftp_gpass'			=> '',
	'ftp_login_retry'		=> 'INTEGER',
	'ftp_login_delay'		=> 'INTEGER',
	'ftp_idle'			=> 'INTEGER',
	'ftp_max_idle'			=> 'INTEGER',
	'ftp_offset'			=> 'INTEGER',
	'ftp_force_mtime'		=> 'BOOLEAN',
	'ftp_list_method'		=> 's/^(STAT|STAT-A|STAT-AT|LIST)$/\U$1/i || undef',
	'via_http'			=> 'ref($_) eq "Fan::HTTP" || undef',
	'via_ftp'			=> 'ref($_) eq "Fan::FTP" || undef',
	'http_proxy'			=> '',
	'lslR_file'			=> '',
	'lslR_copy'			=> '',
	'lslR_map'			=> '',
	'compare_stat'			=> 'BOOLEAN',
	'ignore_mtime'			=> 'BOOLEAN',
	'override_file_uid'		=> '',
	'override_file_gid'		=> '',
	'override_file_mode'		=> 'OCTAL',
	'override_directory_mode'	=> 'OCTAL',
	'default_file_uid'		=> '',
	'default_file_gid'		=> '',
	'default_file_mode'		=> 'OCTAL',
	'default_directory_mode'	=> 'OCTAL',
	'backup_suffix'			=> '',
	'test_mode'			=> 'BOOLEAN',
	'remote_timezone'		=> 'TIMEZONE',
	'lock_directory'		=> '',
	'lock_file'			=> '',
	'temp_directory'		=> '',
	'master_db_directory'		=> '',
	'local_db_directory'		=> '',
	'remote_db_directory'		=> '',
	'local_directory'		=> '',
	'remote_directory'		=> '',
	'transfer_file_regexp'		=> '',
	'transfer_file'			=> 'CODE',
	'transfer_directory_regexp'	=> '',
	'transfer_directory'		=> 'CODE',
	'override_file_regexp'		=> '',
	'override_file'			=> 'CODE',
	'override_directory_regexp'	=> '',
	'override_directory'		=> 'CODE',
	'follow_symlink_regexp'		=> '',
	'follow_symlink'		=> 'CODE',
	'symlink_map'			=> '',
	'parse_realpath'		=> 'BOOLEAN',
	'put_mode'			=> 'BOOLEAN',
	'umask'				=> 'OCTAL',
	'unlink'			=>
		'$_ = $_ eq "rename" ? 2 : &Fan::Param::want_boolean($_)',
	'unlink_limit'			=> 'INTEGER',
	'success_terminate'		=> 'BOOLEAN',
	'use_master_db'			=> 'BOOLEAN',
);

;# nesting parameters.
%pnest = (
	'archive'			=> 'PACKAGE::$_',
	'package'			=> 'PACKAGE::$_',
	'server'			=> 'SERVER::$_',
);

;# initial values.
%initval = (
	'sysconfdir'			=> $sysconfdir,
	'load_config'			=> "ftpmirror.cf",
	'create_directory'		=> 1,
	'override_file_uid'		=> 0,
	'override_file_gid'		=> 0,
	'override_file_mode'		=> '0644',
	'override_directory_mode'	=> '0755',
	'default_file_uid'		=> 0,
	'default_file_gid'		=> 0,
	'default_file_mode'		=> '0644',
	'default_directory_mode'	=> '0755',
	'unlink'			=> 'yes',
	'backup_suffix'			=> '~',
);

;# Generate key oriented subroutines.
;#
for my $n (keys %pkeys) {
	local $_ = $n;
eval "sub $n { my \$p = shift; \$p->setval('$n', shift) if \@_; \$p->getval('$n') }";
#eval "sub $n { my \$p = shift; \$p->{'$n'} = shift if \@_; \$p->{'$n'} }";
	confess($@) if $@;
}

;# A special marker for AutoSplit.
1;
__END__

;# Initialize routine.
;#
sub full_setup ($$) {
	my $this = shift; # may be class name.
	my $arg = shift; # must a reference for an array.

	# Cleanup loader first.
	undef $loader;

	# We must have loader.
	$loader = Fan::Loader->new(
		loader_keys => \%pkeys,
		loader_nest => \%pnest,
	);
	ref($loader) && $loader->isa('Fan::Loader')
		or croak("full_setup: can't create loader");

	# Initial default parameters.
	$loader->merge_hash(\%initval, 'INIT')
		or croak("full_setup: can't initialize values");

	# Parsing options.
	$loader->parse_option($arg, 'OPTION')
		or croak("full_setup: can't parse option");

	# Initial array
	my @array = qw(INIT OPTION);

	# Set logging level first.
	if (defined(my $mask = $loader->get_value('log_mask', @array))) {
		plog_mask($mask);
	}

	# Configuration files to load.
	if (defined(my $files = $loader->get_value('load_config', @array))) {

		# Default directory for configuration files.
		my $dir = $loader->get_value('sysconfdir', @array);

		# load configuration files
		for my $file (split(/\s+/, $files)) {
			next if $file eq '';
			$file = "$dir/$file"
				if ! -f $file && $file !~ /^\// && $dir ne '';
			warn("loading $file...\n") if $LOG > 5;
			$loader->parse_file($file, 'DEFAULT')
				or croak("full_setup: can't parse $file.\n");
		}
	}

	# Success to full setup.
	1;
}

;#
sub find_archive ($$) {
	my $this = shift; # may be class name.
	my $class = ref($this) || $this;
	my $name = shift;
	my $pack = 'PACKAGE::'.$name;

	# Search this package...
	unless ($loader->search($pack)) {
		warn("find_archive: package $pack not defined.\n");
		return undef;
	}

	# Parsers list.
	my @list = ('INIT', 'DEFAULT', $pack, 'OPTION');

	# Try to generate Archive object.
	if (defined(my $srv = $loader->get_value('ftp_server', @list))) {
		# If we have server parameter, try add it.
		if ($loader->search('SERVER::'.$srv)) {
			splice(@list, 2, 0, 'SERVER::'.$srv);
		}
	}

	# Generate a new Archive object.
	my $p = $class->new(param_name => 'RUN::'.$name);
	unless (ref($p) && $p->isa('Fan::Param')) {
		warn("find_archive: can't create Param object.\n");
		return undef;
	}

	# Merge parameters.
	for my $n (@list) {
		$p->merge($loader->search($n));
	}

	# Set verbose or debug.
	if ($p->debug || $p->verbose) {
		my $n = $p->debug ? 7 : 6;
		plog_mask("Fan=$n,Fan::Farm=$n");
		$p->ftp_stats(1);
	}

	# Set logging level if given.
	if (defined(my $mask = $p->log_mask)) {
		plog_mask($mask);
	}

	# Check it
	unless ($p->check) {
		warn("find_archive: archive check error.\n");
		return undef;
	}

	# Success.
	$p;
}

;#
sub DESTROY {
	my $p = shift;

	# cleanup myself first.
	$p->cleanup;

	# date string..
	my $t = time;
	my $s = str4date($t).' '.str4time($t);

	# result string.
	# my $result = $p->success_terminate ? "normally" : "abnormally";

	# package mirror done.
	warn("$s $p->{param_name} terminated.\n") if $LOG >= 5;

	# destroying log
	warn("Fan DELETE [$p->{param_name}]\n") if $LOG >= 6;

	# We also destroy my self in the super class.
	Fan::Param::DESTROY($p);
}

;# Parse targets in the rest of the arguments.
sub new ($%) {
	my $this = shift;
	my $class = ref($this) || $this;
	my %param = @_;

	# set special keys for this param.
	$param{param_keys} = \%pkeys;

	# Generate a new Param object.
	my $p = Fan::Param->new(%param);
	ref($p) or confess("Can't create Param object");

	# bless this
	bless $p, $class;

	# log messages...
	warn("Fan CREATE [$p->{param_name}]\n") if $LOG >= 6;

	# clear flags
	$p->success_terminate(0);

	# date string..
	my $t = time;
	my $s = str4date($t).' '.str4time($t);

	# package mirror starting...
	warn("$s $p->{param_name} starting.....\n") if $LOG > 4;

	# return myself.
	$p;
}

;# Check parameters
;# Most of parameters are checked by Fan::Param::setval.
sub check ($) {
	my $p = shift; # Must be a generated module.
	my $tmpkey;
	my $tmpdir;
	local $_;

	# DEBUG purpose only...
	ref($p) && $p->isa('Fan::Param')
		or confess("$p must be a Fan::Param object");

	# Check package name.
	my $y = $p->{param_name};
	if ($y !~ s/^RUN:://) {
		# what's happen?
		confess("$p: package name \"$y\" invalid");
	}

	# Default value for umask operation.
	if (oct($p->umask)) {
		umask(oct($p->umask));
	}

	# Default backup suffix is a tilda.
	if ($p->backup_suffix eq '') {
		$p->setval('backup_suffix', '~');
	}

	# Check username.
	if ($p->username eq '') {
		my $name = getpwuid($<);
		defined($name) || die("getpwuid returns undef, at");
		$p->setval('username', $name);
	}

	# Check hostname.
	if ($p->hostname eq '') {
		my $host;
		chomp($host = `hostname`);
		$host = 'nowhere' if $host eq '';
		$p->setval('hostname', $host);
	}

	# Check FTP username.
	if (!defined($p->ftp_user)) {
		$p->setval('ftp_user', 'anonymous');
	}

	# Check FTP password string.
	if (!defined($p->ftp_pass)) {
		$p->setval('ftp_pass', $p->username.'@'.$p->hostname);
	}

	# Check existence of required directories.
	for (qw|lock temp local remote master_db local_db remote_db|) {
		my $key = $_.'_directory';
		my $t = $p->subst_directory($p->getval($key));

		if ($t ne '') {
			$p->setval($key, $t);
		} else {
			$p->delete($key);
		}
	}

	# Default value for temporary directory.
	if (!defined($p->temp_directory)) {
		$p->setval('temp_directory', $ENV{'TMPDIR'} || "/tmp");
	}

	# Default lock directory is local_directory...
	if (!defined($p->lock_directory)) {
		$p->setval('lock_directory', $p->temp_directory);
	}

	# Check required directories.
	for (qw|local temp lock|) {
		my $key = $_.'_directory';
		my $t = $p->getval($key);
		unless (defined($t)) {
			warn("ERR($y): $_ directory \"$t\" not defined.\n");
			return undef;
		}
		unless (-d $t) {
			unless ($p->create_directory && mkdirhier($t, 0755)) {
				warn("ERR($y): mkdirhier(\"$t\") failed.\n");
				return undef;
			}
		}
	}

	# Check archive database directories...
	# remote_db_directory
	# local_db_directory

	# Check index directory.
	# master_db_directory

	# default value of *_dirinfo
	if ($p->use_dirinfo) {
		$p->setval('load_remote_dirinfo', 1)
			if !defined($p->load_remote_dirinfo);
		$p->setval('load_local_dirinfo', 1)
			if !defined($p->load_local_dirinfo);
		$p->setval('store_local_dirinfo', 1)
			if !defined($p->store_local_dirinfo);
	}

	# load dirinfo?
	if ($p->load_remote_dirinfo) {
		my $z = $p->transfer_file_regexp;
		$p->setval('transfer_file_regexp', "\n".'!/\/\.dirinfo/'.$z);
	}

	# load dirinfo?
	if ($p->store_local_dirinfo) {
		my $z = $p->override_file_regexp;
		$p->setval('override_file_regexp', "\n".'!/\/\.dirinfo/'.$z);
	}

	# We must ignore lock files.
	if ($p->local_directory eq $p->lock_directory) {
		my $z = $p->override_file_regexp;
		$p->setval('override_file_regexp', "\n".'!/\.\/\.LOCK$/'.$z);
	}

	# We must not unlink renamed file if unlink == 2
	if ($p->unlink == 2) {
		my $z = $p->override_file_regexp;
		$p->setval('override_file_regexp',
			"\n".'!/'.$p->backup_suffix.'$/'.$z);
		$z = $p->override_directory_regexp;
		$p->setval('override_directory_regexp',
			"\n".'!/'.$p->backup_suffix.'\/$/'.$z);
	}

	# `change_directory = 1' is required
	# if `follow_symlink_regexp' is defined.
	$p->setval('change_directory', 1) if defined($p->follow_symlink);

	# Obsolete message.
	if (defined($p->{'lslR_map'})) {
		warn("WARN($y): lslR_map was obsoleted, ignored\n");
		delete($p->{'lslR_map'}); # obsolete
	}

	# If we create a copy of remote lslR file, we must not override it.
	if ($p->lslR_copy =~ /^[^\/]/) { # relative path...
		my $copy = lookup($p->lslR_copy);
		my $z = $p->override_file_regexp;
		$p->setval('override_file_regexp',
			"\n".'!/\.\/'.quotemeta($copy).'$/'.$z);
	}

	# Generate match routine
	for $tmpkey (qw(override_directory override_file
		transfer_directory transfer_file follow_symlink)) {
		$_ = $p->getval($tmpkey.'_regexp') || '';
		s/^\n//;
		my $c = &gen_match(split(/\n/));
		defined($c)
			or warn("ERR($y): $_ could not be defined\n"),
			return undef;
		$p->setval($tmpkey, $c);
	}

	# Generate substitution routine
	if (defined($_ = $p->symlink_map) && $_ ne '') {
		s/^\n//; # ignore first newline.
		my $c = &gen_subst(split(/\n/));
		ref($c) eq 'CODE'
			or warn("ERR($y): symlink-map error.\n"),
			return undef;
		$p->setval('symlink_subst', $c);
	}

	# Calculate timezone offset.
	if (defined($_ = $p->remote_timezone)) {
		if (/^(\+|-)(\d\d?)(\d\d)$/) {
			my $off = $2 * 3600 + $3 * 60;
			$p->setval('offset', $1 eq '+' ? $off : (0 - $off));
		}
	}

	;# success
	$p;
}

;# substitute directory names
sub subst_directory ($$) {
	my $self = shift; # this must be a Package object.
	my $dir = shift;

	# try to expand.
	defined($dir = &Fan::Param::want_path($dir)) || return undef;

	# try to substitute.
	my $name = $self->{param_name};
	if ($name =~ s/^(RUN|PACKAGE):://) {
		$dir =~ s/\%s/$name/g;
	}
	$dir;
}

;# make pattern match subroutine
sub gen_match ($) {
	my $func = undef;
	my $default = 1;
	my $s = "\$func = sub {\n\tlocal(\$_) = \@_;\n";
	for my $re (@_) {
		local $_ = $re;
		my $type = s/^!// ? 0 : 1;
		my $use_regexp = 0;

		if (m%^/(.*)/$%) { # use regexp
			$_ = $1; $use_regexp = 1;
		} elsif (m%^'(.*)'$%) { # just match
			$_ = $1;
		}
		if ($_ eq '') {
			$default = $type; last;
		}
		if ($use_regexp) {
			$s .= "\treturn $type if /$_/o;\n";
		} else {
			$s .= "\treturn $type if \$_ eq '$_';\n";
		}
	}
	$s .= "\t$default;\n}\n";

	# debug information
	print "match: $s" if $LOG > 7;

	# evaluate subroutine definition
	eval $s;
	confess $@ if $@;

	# success - returns CODE.
	$func;
}

;# make pattern substitute subroutine
sub gen_subst ($) {
	my $func = undef;
	my $s = "\$func = sub {\n\tlocal(\$_) = \@_;\n";
	for my $re (@_) {
		if ($re =~ m,^s/,) {
			$s .= "\t$re;\n";
		} elsif ($re =~ m,^/,) {
			$s .= "\ts$re;\n";
		} else {
			$s .= "\ts/$re/;\n";
		}
	}
	$s .= "\t\$_;\n}\n";

	# debug information
	print "subst: $s" if $LOG > 7;

	# evaluate subroutine definition
	eval $s;
	confess $@ if $@;

	# success
	$func;
}

;#
sub do_lock {
	my $p = shift;
	my $package = $p->{param_name};
	my $d = $p->lock_directory;

	# Check lock directory again.
	unless (-d $d && -w $d) {
		warn("$d: directory not found.\n");
		return undef;
	}

	# Try to lock this package...
	$package =~ s/^RUN:://
		or confess("ERR $package is invalid package name");

	my $lock = $d.'/LOCK.'.encode($package);

	# Lock mechanizm is supported by Cool.pm.
	plock($lock, 30) # wait max 30 seconds.
		or warn("plock($lock): $!\n"), return undef;

	# Register $lock as a temporary file.
	$p->{tempfiles}->{$lock}++;

	# Success
	1;
}

;#
sub cleanup ($) {
	my $p = shift;

	# cleanup network sessions
	$p->delete('via_http');
	$p->delete('via_ftp');

	# cleanup temporary files.
	for my $file (keys %{$p->{tempfiles}}) {
		if (-e $file) {
			warn("unlink $file...\n") if $LOG > 5;
			unlink($file); # ignore result
		}
	}

	# always success.
	1;
}

;# Initialize network
;# FTP or HTTP(proxy)
;#
sub net_init {
	my $p = shift;
	my $package = $p->{param_name};
	my $msg = '';

	# fast return for initialized package
	return 1 if $p->{net_initialized};

	# Check package name first.
	$package =~ s/^RUN:://
		or confess("ERR $package is invalid package name");

	# do lock in put mode
	unless ($p->put_mode || $p->do_lock) {
		warn("$package: can't lock the package.\n");
		return undef;
	}

	# Check ftp-server.
	if ($p->ftp_server eq '') {
		warn("ERR($package) no FTP server defined.\n");
		return undef;
	}

	# And remote_directory.
	if ($p->remote_directory eq '') {
		warn("ERR($package) no remote_directory defined.\n");
		return undef;
	}

	# abbrevs for remote directory.
	# You can use HTTP to transfer files.
	# In this case, at least one of lslR_file, archive_index,
	# or load_remote_dirinfo must be given.
	if ($p->http_proxy) {
		use Fan::HTTP;

		my $http = Fan::HTTP->new(
			http_proto => 'ftp',
			http_server => $p->ftp_server,
			http_proxy => $p->http_proxy);
		ref($http)
			or warn("Can't create HTTP object"), return undef;
		plog(5, "using HTTP proxy for file transfer.\n");

		$msg = "server = ".$p->ftp_server;
		$msg .= " (http via ".$p->http_proxy.")";
		plog(5, $msg."\n");

		$p->setval('via_http', $http);
	} else {
		use Fan::FTP;

		my %param = (
			ftp_server => $p->ftp_server,
			ftp_user => $p->ftp_user,
			ftp_pass => $p->ftp_pass,
			ftp_directory => $p->remote_directory,
		);
		$param{ftp_gateway} = $p->ftp_gateway
			if $p->ftp_gateway ne '';
		$param{ftp_bindaddr} = $p->ftp_bindaddr
			if $p->ftp_bindaddr ne '';
		$param{ftp_login_retry} = $p->ftp_login_retry
			if $p->ftp_login_retry > 0;
		$param{ftp_login_delay} = $p->ftp_login_delay
			if $p->ftp_login_delay > 0;
		$param{ftp_port} = $p->ftp_port
			if $p->ftp_port > 0;
		$param{ftp_group} = $p->ftp_group
			if $p->ftp_group ne '';
		$param{ftp_gpass} = $p->ftp_gpass
			if $p->ftp_gpass ne '';
		$param{ftp_passive} = 1
			if $p->ftp_passive;
		$param{ftp_idle} = $p->ftp_idle
			if $p->ftp_idle > 0;
		$param{ftp_idle} = -1
			if $p->ftp_max_idle;
		$param{ftp_timeout} = $p->ftp_timeout
			if $p->ftp_timeout > 0;
		$param{tcp_debug} = 1
			if $p->ftp_debug;
		$param{ftp_stats} = 1
			if $p->ftp_stats;

		my $ftp = Fan::FTP->new(%param);
		unless (ref($ftp)) {
			warn("Can't create FTP object");
			return undef;
		}
		plog(5, "using FTP for file transfer.\n");

		# Show server name.
		$msg = "server = ".$p->ftp_server;
		$msg .= " (ftp via ".$p->ftp_gateway.")" if $p->ftp_gateway;
		plog(5, $msg."\n");

		# Show user account.
		$msg = "username = ".$p->ftp_user;
		$msg .= '/'.$p->ftp_pass
			if $p->ftp_user eq 'ftp' || $p->ftp_user eq 'anonymous';
		plog(5, $msg."\n");

# WE USE DELAYED LOGIN, THAT IS, WE WILL LOGIN WHEN FIRST COMMAND
# WILL SEND TO THE SERVER.
#		plog(5, "try login...\n");
#
#		unless ($ftp->login) {
#			warn("net_init: can't login to the server");
#			return undef;
#		}

		$p->setval('via_ftp', $ftp);
	}

	# And, some additional information.
	plog(5, "transfer type = ".($p->put_mode ? 'put' : 'get')."\n");

	# network flag
	$p->{net_initialized}++;

	# success to init network methods...
	1;
}

;#
;#
sub last_seq ($;$) {
	my $p = shift;

	# writing lastest step file.
	local *FILE;

	my $last = @_ ? shift : 0;
	my $seq = $p->local_db_directory.'/work.seq';

	if ($last > 0) { # write mode
		unless (open(FILE, '>'.$seq)) {
			warn("last_seq: open(>$seq): $!\n");
			return undef;
		}
		print FILE $last."\n";
		close(FILE);
		warn("last_seq: wrote $last to $seq\n") if $LOG > 5;
	} else {
		unless (open(FILE, $seq)) {
			warn("last_seq: open($seq): $!\n") if $LOG > 5;
			return undef;
		}
		$last = <FILE>;
		close(FILE);
		chomp($last);
		unless ($last > 0) {
			warn("last_seq: can't read from $seq\n");
			return undef;
		}
		$last += 0;
		warn("last_seq: read last = $last from $seq\n") if $LOG > 5;
	}
	$last;
}

;#
;#
sub step_synch {
	my $p = shift; # Fan object...

	unless ($p->net_init) {
		warn("step_synch: can't initialize network");
		return undef;
	}

	my $ldb = $p->local_db_directory;
	if ($ldb eq '') {
		carp("step_synch: no local_db_directory defined");
		return undef;
	}
	if (! -d $ldb) {
		carp("step_synch: local_db_directory is not a directory");
		return undef;
	}

	my $db = Fan::Farm->new($ldb);
	unless (ref($db)) {
		carp("step_synch: can't create Fan::Farm object");
		return undef;
	}

	my $rdb = $p->remote_db_directory;
	if ($rdb eq '') {
		if (! -f "$ldb/index.local") {
			carp("step_synch: neither remote_db_directory nor"
				. " local index found");
			return undef;
		}
		warn("step_synch: no remote_db_directory"
			. ", use local mode.\n")
			if $LOG > 5;
	} else {
		my $notrans = 0;
		my $a = Fan::Attrib->new(
			y_type => 'F',
			y_path => "$rdb/index.local",
			y_name => "index.local",
		);
		unless (ref($a)) {
			carp("step_synch: can't create Fan::Attrib object");
			return undef;
		}
		if (-f "$ldb/index.local" && ref($a)) {
warn("step_synch: $ldb/index.local found\n") if $LOG > 6;
			$b = Fan::Attrib->new(attr_path => "$ldb/index.local");
			unless (ref($b)) {
				carp("step_synch: can't create"
					. " Fan::Attrib object");
				return undef;
			}
			$p->fill_size($a);
			$p->fill_mtime($a);
			if ($a->size == $b->size && $a->mtime == $b->mtime) {
				$notrans++;
			}
		} else {
warn("step_synch: $ldb/index.local not found\n") if $LOG > 6;
		}

		if ($notrans) {
			warn("step_synch: no need to transfer index.local\n")
				if $LOG > 5;
		} elsif ($p->get("$rdb/index.local", "$ldb/index.local")) {
			warn("step_synch: got index.local: o.k.\n")
				if $LOG > 5;
		} else {
			carp("step_synch: can't retrieve index.local");
			return undef;
		}

		my $m = $a->mtime;
		utime($m, $m, "$ldb/index.local") if $m > 0;

		unless ($db->synch($p, $rdb, "$ldb/index.local")) {
			carp("step_synch: can't synchronise to remote");
			return undef;
		}

		warn("step_synch: synch o.k.\n") if $LOG > 5;
	}

	# get local revisions, again.
	unless ($db->getrev) {
		carp("step_synch: can't get revision");
		return undef;
	}

	# check latest index file
	unless ($db->{pim_index_max} > 0) {
		carp("step_synch: no index file found");
		return undef;
	}

	# get index file, and step files
	$p->{newest_index} = $db->{pim_index_max};
	$p->{newest_index_file} = "$ldb/index.$p->{newest_index}";

	# log it
	warn("step_synch: newest index is $p->{newest_index_file}.\n")
		if $LOG > 5;

	# can we get last seq?
	my $last = $p->last_seq;
	unless ($last > 0) {
		warn("step_synch: last# is not found $last.\n") if $LOG > 5;
		return 1;
	}

	# search step files
	$p->{newer_step_files} = [];
	if ($db->{pim_step_max} > $last) {
		if ($last < $db->{pim_step_min}) {
			warn("step_synch: step index is larger than mine.\n")
				if $LOG > 4;
			$last = $db->{pim_step_min};
		}
		for (my $i = $last; $i <= $db->{pim_step_max}; $i++) {
			push(@{$p->{newer_step_files}}, "$ldb/step.$i");
			warn("step_synch: add step $ldb/step.$i.\n")
				if $LOG > 5;
			$p->{newest_step} = $i;
		}
	}

	# success
	1;
}

;#
;#
sub run_step_mirror {
	my $p = shift;

	unless ($p->net_init) {
		warn("step_synch: can't initialize network");
		return undef;
	}

	#
	unless ($p->step_synch) {
		carp("step_mirror: can't sync..., try full mirror");
		return undef;
	}

	# check if we have newer step files?
	unless (exists($p->{newer_step_files})) {
		warn("step_mirror: no step files to synch.\n") if $LOG > 4;
		return 1;
	}

	# check if we have newer step files?
	unless (@{$p->{newer_step_files}}) {
		warn("step_mirror: empty step file array.\n") if $LOG > 4;
		return 1;
	}

	# or we have something to mirror
	my @newer_scan = ();

	# generate scans... 
	for my $i (@{$p->{newer_step_files}}) {
		my $scan = Fan::Scan->new(
			scan_type => 'INDEX',
			scan_index => $i
		);
		unless (ref($scan)) {
			carp("step_mirror: can't create Scan for $i");
			return undef;
		}
		unless ($scan->add_filter(\&server_filter, $p)) {
			carp("step_mirror: can't add filter for $i");
			return undef;
		}
		push(@newer_scan, $scan);
	}

	#
	warn("step_mirror: starting\n") if $LOG > 5;

	my $base = shift(@newer_scan);
	my @x;
	while (@x = $base->getcmp(@newer_scan)) {
		my $x;

		# search lastest one
		for my $y (@x) {
			$x = $y if ref($y);
		}
		ref($x) or confess("UNEXPECTED CASE");

		my $f = $x->flag;
		my $t = $x->type;

		# check end-of-data
		last if $t eq '.';

		# get pathname
		my $path = $x->path;
		my $show = &Fan::Attrib::attr_encode($path);

		# check flag...
		if ($f eq '-') { # DELETE
			if ($t eq 'D') {
				; # simply ignored
			} elsif ($p->del($x)) {
				plog(5, "-$t $show: success\n");
			} else {
				plog(5, "-$t $show: failure\n");
			}
		} elsif ($f eq '+' || $f eq '') { # ADD
			my $realpath = $p->local_directory.'/'.$x->path;
			my $a = undef;
			my $m = 0;
			my $op = $p->test_mode ? 3 : 2;

			$a = Fan::Attrib->new(attr_path => $realpath)
				if $t ne 'U' && -e $realpath;
			if ($t eq 'U') {
				; # simply ignored
			} elsif ($a && defined($m = $p->besame($a, $x, $op))) {
				if ($m) {
					plog(5, "+$t $show: modified\n");
				} else {
					plog(5, "#$t $show: o.k.\n");
				}
			} elsif ($p->add($x)) {
				plog(5, "+$t $show: success\n");
			} else {
				plog(5, "+$t $show: failure\n");
			}
		} else {
			; # unknown flags...
		}
	}

	# writing lastest step file.
	unless ($p->last_seq($p->{newest_step} + 1)) {
		warn("step_mirror: can't write last seq.\n") if $LOG > 5;
		return undef;
	}

	warn("step_mirror: done.\n") if $LOG > 5;

	#
	1;
}

;#
;#
sub run_full_mirror {
	my $p = shift; # Fan object...

	warn("full_mirror: started\n") if $LOG > 5;

	unless ($p->net_init) {
		warn("step_synch: can't initialize network");
		return undef;
	}

	my $server = $p->remote_scanner;
	unless (ref($server)) {
		# carp("Can't create Scan object for FTP");
		return undef;
	}

	# local side scanner
	my $client = $p->local_scanner;
	unless (ref($client)) {
		# carp("Can't create Scan object");
		return undef;
	}

	# temporary variables...
	my $farm = undef;

	# check transfer mode
	if ($p->put_mode) {
		($server, $client) = ($client, $server);
	} else {
		# check index directory
		my $d = $p->master_db_directory;

		if (-d $p->local_db_directory) {
			; # this is slave server.
		} elsif ($d eq '') {
			; # no master_db_directory defined
		} elsif (! -d $d) { # warn, but ignored...
			warn("full_mirror: $d is not a directory.\n")
				if $LOG > 4;
		} else {
			$farm = Fan::Farm->new($d);
			unless (ref($farm) && $farm->d_begin) {
				warn("full_mirror: can't initialize Farm\n")
					if $LOG > 5;
				undef $farm;
			}
		}
	}

	my $x;
	my $y;
	while (($x, $y) = $client->getcmp($server)) {

		# result should be in $z.
		my $z;
		my $flag;
		my $modify = undef;

		# One of $x or $y must be defined.
		if (!defined($x) && !defined($y)) {
			die("Both of \$x and \$y are undef");
		} elsif (!defined($x)) { # only in server.
			$z = $y;
			$flag++;
		} elsif (!defined($y)) { # only in client.
			$z = $x;
			$flag--;
		} else { # in both of client and server
			$z = $y;
			$flag = 0;
		}

		# type abbrev...
		my $t = $z->type;

		# Is this END-OF-DATA?
		if ($t eq '.') {
			$flag == 0 or die("UNEXPECTED END-OF-DATA");
			$p->setval('success_terminate', 1);
			last;
		}

		# Check if we must get mtime of the file.
		# This must be before besame in the next block.
		if ($t eq 'F' && $p->ftp_force_mtime) {
			$p->fill_mtime($x) if ref($x) && !defined($x->mtime);
			$p->fill_mtime($y) if ref($y) && !defined($y->mtime);
		}

		# $flag == 0 means, both of server and client have
		# a file named $z->path.
		# Check if we must get/put file or not.
		# Besame returns undef if we must transfer the target.
		if ($flag == 0) {
			# Is checksum required?
			if ($t eq 'F' && !$p->put_mode) {
				# If target has checksum, we should fill it.
				if (length($y->checksum) == 32) {
					$x->fill_checksum if -f $x->realpath;
				}
			}
			# Check if we can modify or we must transfer.
			my $op = $p->test_mode ? 3 : 2; 
			$op |= 8 unless $p->ignore_mtime;
			$modify = $p->besame($x, $y, $op);
			$flag++ if !defined($modify);
		}

		# DEBUG only - check override...
		# This block can be skipped, since override check
		# was already done in add_filter for Scan object.
		# Can we override this?
		if ($t eq 'D') {
			my $file = $z->path;

			unless (&{$p->override_directory}($file.'/')) {
die("overrite_directory violation: $file/\n");
			}
		} elsif ($t eq 'F' || $t eq 'L') {
			my $file = $z->path;

			unless(&{$p->override_file}($file)) {
die("overrite_file violation: $file/\n");
			}
		}

		# show logging
		my $show = &Fan::Attrib::attr_encode($z->path);

		# Now, we can override.
		# Do real action.
		if ($flag < 0) { # DELETE
			$z->flag('-');

			if ($t eq 'D') {
				; # simply ignored
			} elsif ($p->del($z)) {
				plog(5, "-$t $show: success\n");
			} else {
				plog(5, "-$t $show: failure\n");
			}
		} elsif ($flag > 0) { # ADD
			$z->flag('+');

			if ($t eq 'U') {
				; # simply ignored
			} elsif ($p->add($z)) {
				plog(5, "+$t $show: success\n");
			} else {
				plog(5, "+$t $show: failure\n");
				$flag = -1;
			}
		} else {
			$z->flag('');

			if ($t eq 'U') {
				; # do nothing...
			} elsif ($modify) {
				$z->flag('+');
				plog(5, "+$t $show: modified\n");
			} else {
				plog(6, "#$t $show: ok\n");
			}
		}

		# Package index mangement tools
		if (ref($farm)) {
			# fill attributes...
			if ($flag >= 0) {
				$z->fill($p->local_directory.'/'.$z->path)
					or confess("Can't fill Fan::Attrib("
						. $z->path . ")");
				if ($t eq 'F' && length($z->checksum) != 32) {
					$z->fill_checksum;
				}
			}
			$farm->d_add($z);
		}

		# Check critical error...
		die("Fatal error detected in ftp connection, at")
			if ref($p->via_ftp) &&
			   $p->via_ftp->error == &Fan::TCP::FATAL;
	}

	# terminate network connection before heavy processing...
	undef $x;
	undef $y;
	$p->quit;

	# try terminate updater
	if (ref($farm)) {
		warn("full_mirror: terminate updater...\n") if $LOG > 5;
		$farm->d_end;
		warn("full_mirror: normalize my farm...\n") if $LOG > 5;
		$farm->normalize;
		warn("full_mirror: generate local index...\n") if $LOG > 5;
		$farm->genindex;
	}

	# writing lastest step file.
	if ($p->{newest_index} > 0) {
		my $seq = $p->{newest_index};

		if ($seq > 0 && $p->last_seq($seq)) {
			warn("full_mirror: wrote last seq = $seq.\n")
				if $LOG > 5;
		} else {
			warn("full_mirror: can't write last seq.\n")
				if $LOG > 5;
		}
	}

	# cleanup.
	$p->cleanup;

	# debug log...
	warn("full_mirror: done.\n") if $LOG > 5;

	#
	1;
}

;#
;#
sub quit ($) {
	my $p = shift;
	my $x;

	if (ref($x = $p->via_http)) {
		;
	} elsif (ref($x = $p->via_ftp)) {
		$x->quit;
	} else {
		;
	}
	1;
}

;#
;#
sub list ($$) {
	my $p = shift;
	my $dir = shift;
	my $x;

	if (ref($x = $p->via_http)) {
		confess("HTTP does not support LIST");
	} elsif (ref($x = $p->via_ftp)) {
		unless ($x->ascii) {
			warn("FTP->ascii failed");
			return undef;
		}
		if ($p->ftp_list_method eq 'LIST') {
			return $x->list($dir);
		} elsif ($p->ftp_list_method eq 'STAT-A') {
			$x->chdir($dir) || return undef;
			return $x->stat("-A .");
			;# if ( not $x->chdir($p->remote_directory) ) { return 1; }
		} elsif ($p->ftp_list_method eq 'STAT-AT') {
			$x->chdir($dir) || return undef;
			return $x->stat("-AT .");
			;# if ( not $x->chdir($p->remote_directory) ) { return 1; }
                } else {
			my $temp = $x->stat($dir);
			if ($temp eq "" ) {
				$p->ftp_list_method eq 'LIST';
				return $x->list($dir);
			} else {
				return $temp;
			}
		}
	} else {
		confess("No listing method");
	}

	undef;
}

;#
;#
sub get ($$;$) {
	my $p = shift;
	my $remote_file = shift;
	my $local_file = @_ ? shift : $remote_file;
	my $x;

	if (ref($x = $p->via_http)) {
		$remote_file = $p->remote_directory.'/'.$remote_file
			if $remote_file !~ /^\//;
		unless ($x->get($remote_file, $local_file)) {
			warn("HTTP->get($remote_file) error ".$x->error);
			return undef;
		}
	} elsif (ref($x = $p->via_ftp)) {
		unless ($x->image) {
			warn("FTP->image failed");
			return undef;
		}
		unless ($x->get($remote_file, $local_file)) {
			warn("FTP->get($remote_file) error ".$x->error);
			return undef;
		}
	} else {
		confess("No transfer method"), return undef;
	}

	# success to get files.
	1;
}

;#
;#
sub put ($$;$) {
	my $p = shift;
	my $local_file = shift;
	my $remote_file = @_ ? shift : $local_file;
	my $x;

	if (ref($x = $p->via_http)) {
		confess("HTTP does not support PUT");
	} elsif (ref($x = $p->via_ftp)) {
		$x->image
			or warn("FTP->image failed"), return undef;
		$x->put($local_file, $remote_file)
			or warn("FTP->put failed"), return undef;
	} else {
		confess("No transfer method"), return undef;
	}

	# success to get files.
	1;
}

;#
sub fill_mtime ($$) {
	my $p = shift; # myself
	my $y = shift; # Attrib

	# debug log...
	warn("fill_mtime: try ".$y->path."\n") if $LOG > 6;

	# check if $y->mtime is defined.
	if (defined($y->mtime)) {
		warn("fill_mtime: already has mtime.\n") if $LOG > 6;
		return 1;
	}

	# we need ftp to get mtime.
	my $ftp = $p->via_ftp;
	unless (ref($ftp)) {
		warn("fill_mtime: no ftp session found.\n") if $LOG > 6;
		return undef;
	}

	# try to get mtime.
	my $m = $ftp->mtime($y->path);
	unless (defined($m) && $y->mtime($m)) {
		warn("fill_mtime: fail to get mtime\n") if $LOG > 6;
		return undef;
	}

	# mtime found, debug log...
	warn("fill_mtime: $m (".$y->path.").\n") if $LOG > 6;

	# can we set offset value?
	if ($y->date =~ /\d\d+:\d\d/) {
		my $off = $p->ftp_offset;
		my $off2 = $y->time0 - $y->mtime;
		if (!defined($off) || abs($off - $off2) > 600) {
			$p->adjust_offset($y->mtime, $y->time0);
		}
	}

	# result must be o.k.
	1;
}

;#
sub fill_size ($$) {
	my $p = shift; # myself
	my $y = shift; # Attrib

	# debug log...
	warn("fill_size: try ".$y->path."\n") if $LOG > 6;

	# check if $y->size is defined.
	if (defined($y->size)) {
		warn("fill_size: already has size.\n") if $LOG > 6;
		return 1;
	}

	# we need ftp to get size.
	my $ftp = $p->via_ftp;
	unless (ref($ftp)) {
		warn("fill_size: no ftp session found.\n") if $LOG > 6;
		return undef;
	}

	# size command requires image mode
	unless ($ftp->image) {
		warn("fill_size: can't goto image mode\n") if $LOG > 6;
		return undef;
	}

	# try to get size.
	my $s = $ftp->size($y->path);
	unless (defined($s) && $y->size($s)) {
		warn("fill_size: fail to get size\n") if $LOG > 6;
		return undef;
	}

	# size found, debug log...
	warn("fill_size: $s (".$y->path.").\n") if $LOG > 6;

	# result must be o.k.
	1;
}

;#
sub add {
	my $p = shift;

	$p->put_mode ? $p->remote_add(@_) : $p->local_add(@_);
}

;#
sub del {
	my $p = shift;

	$p->put_mode ? $p->remote_del(@_) : $p->local_del(@_);
}

;#
sub local_add {
	my $p = shift; # Fan
	my $y = shift; # Attrib we should add
	my $t = $y->type;
	my $from = $y->path; # server side file
	my $to = $p->local_directory.'/'.$from;
	1 while $to =~ s|/\./|/|;

	if ($t eq 'D') {
		return 1 if $p->test_mode;
		unlink($to); # force to remove
		unless (mkdir($to, 0755)) {
			warn("mkdir($to): $!");
			return undef;
		}
		warn("mkdir($from, 0755): o.k.\n") if $LOG > 6;
	} elsif ($t eq 'U') {
		; # simply ignored
	} elsif ($t eq 'F') {
		return 1 if $p->test_mode;
		# fill mtime if we don't have it
		$p->fill_mtime($y);
		# try to get file.
		unless ($p->get($from, $to)){
			warn("get($from, $to) failed: ");
			return undef;
		}
		warn("net::get($from): o.k.\n") if $LOG > 6;
	} elsif ($t eq 'L') {
		return 1 if $p->test_mode;
		unlink($to); # force to remove
		unless (symlink($y->linkto, $to)) {
			warn("symlink: $!");
			return undef;
		}
		warn("symlink($from): o.k.\n") if $LOG > 6;
	} else {
		; # what?
	}

	# Check modified file.
	my $a = Fan::Attrib->new(attr_path => $to);
	unless (ref($a) && $a->isa('Fan::Attrib')) {
		warn("Fan::Attrib::new $!");
		return undef;
	}

	# copy path variable
	$a->path($from);

	# check attribute again
	unless (defined($p->besame($a, $y, 2))) {
		warn("Can't modify $from");
		return undef;
	}

	# success
	1;
}

;#
sub local_del {
	my $p = shift; # Fan
	my $y = shift; # Attrib
	my $t = $y->type;
	my $org = $y->path;
	my $old = $p->local_directory.'/'.$org;
	1 while $old =~ s|/\./|/|;

	if ($p->unlink == 0) {
		warn("unlink($org) skipped by unlink-mode\n") if $LOG > 5;
		return 0;
	} elsif ($p->unlink == 2) {
		my $xx = $old.$p->backup_suffix;
		return 1 if $p->test_mode;
		unless (rename($old, $xx)) {
			warn("rename($old, $xx): $!");
			return undef;
		}
		warn("rename $org: o.k.\n") if $LOG > 6;
		return 1;
	}

	if ($t eq 'D') {
		; # rmdir when 'U' was found
	} elsif ($t eq 'U') {
		return 1 if $p->test_mode;
		unless (rmdir($old)) {
			warn("rmdir($old): $!");
			return undef;
		}
		warn("rmdir($org): o.k.\n") if $LOG > 6;
	} else {
		return 1 if $p->test_mode;
		unless (unlink($old)) {
			warn("unlink($old): $!");
			return undef;
		}
		warn("unlink($org): o.k.\n") if $LOG > 6;
	}
	1;
}

;#
sub remote_add {
	my $p = shift; # Fan
	my $y = shift; # Attrib
	my $t = $y->type;
	my $to = $y->path;
	my $from = $p->local_directory.'/'.$to;
	1 while $from =~ s|/\./|/|;

	my $ftp = $p->via_ftp;
	ref($ftp) or confess("FTP is required for remote operation");

	if ($t eq 'L') {
		plog(7, "! We can't put symlink for $to, try real data.\n");
		$t = 'F';
	}

	if ($t eq 'D') {
		return 1 if $p->test_mode;
		$ftp->unlink($to); # ignore result.
		unless ($ftp->mkdir($to)) {
			warn("net::mkdir($to): ".$ftp->error);
			return undef;
		}
		warn("FTP::mkdir($to): o.k.\n") if $LOG > 6;
	} elsif ($t eq 'U') {
		; # simply ignored
	} elsif ($t eq 'F') {
		return 1 if $p->test_mode;
		unless ($ftp->image) {
			warn("FTP::image failed ".$ftp->error);
			return undef;
		}
		unless ($ftp->put($from, $to)) {
			warn("FTP::put($to): ".$ftp->error);
			return undef;
		}
		warn("FTP::put($to): o.k.\n") if $LOG > 6;
	} else {
		; # what?
	}

	if (($t eq 'D' || $t eq 'F') && (my $val = $y->perm) > 0) {
# warn("try chmod $to\n");
		unless ($ftp->chmod($val, $to)) {
			warn("FTP::chmod($to): [".$ftp->error."]\n")
				if $LOG >= 6;
			# but ignore this error
		}
	}

	1;
}

;#
sub remote_del {
	my $p = shift; # Fan
	my $y = shift; # Attrib
	my $t = $y->type;
	my $old = $y->path;
	my $ftp = $p->via_ftp;

	ref($ftp) or confess("FTP is required for remote operation");

	if ($p->unlink == 0) {
		warn("unlink($old) skipped by unlink-mode\n") if $LOG > 5;
		return 0;
	} elsif ($p->unlink == 2) {
		my $xx = $old.$p->backup_suffix;
		return 1 if $p->test_mode;
		unless ($ftp->rename($old, $xx)) {
			warn("FTP::rename($old, $xx): $!");
			return undef;
		}
		warn("FTP::rename $old: o.k.\n") if $LOG > 6;
		return 1;
	}

	if ($t eq 'D') {
		; # rmdir when 'U' was found
	} elsif ($t eq 'U') {
		plog(7, "FTP::rmdir($old)\n");
		return 1 if $p->test_mode;
		unless ($ftp->rmdir($old)) {
			warn("FTP::rmdir($old): ".$ftp->error);
			return undef;
		}
		warn("FTP::rmdir($old): o.k.\n") if $LOG > 6;
	} else {
		plog(7, "FTP::unlink($old)\n");
		return 1 if $p->test_mode;
		unless ($ftp->unlink($old)) {
			warn("FTP::unlink($old): ".$ftp->error);
			return undef;
		}
		warn("FTP::unlink($old): o.k.\n") if $LOG > 6;
	}

	1;
}

;#
;# $p->besame($a, $b, $op)
;#	where $a and $b are Attrib objects,
;#
;# $op is the operation code and flags.
;#
;# case of ($op & 7) == 0:
;#	Function `besame' simply checks whether $a is same as $b.
;#	If $a is equevalent to $b then 0(zero) will be returned,
;#	otherwise undef will be returned.
;# case of ($op & 7) == 1:
;#	Same as the case of $op == 0, but modification times are
;#	good if the condition (mtime_of_$a >= mtime_of_$b) holds.
;# case of ($op & 7) == 2:
;#	Function `besame' checks and try to modify $a to be same
;#	as $b. If $a could be same as $b, the # of modifications
;#	will be returned (this may be zero or positive integer.).
;#	If $a has no possibility to become $b, undef is returned.
;#	In this case, `$a->realpath' must exists.
;#	In a modified time check, if ($op & 0x80) is not zero,
;#	modified time must be same, e.g., undef is returned when
;#	modified time mismatch found.
;# case of ($op & 7) == 3:
;#	Same as the case of $op == 2, but no real modification
;#	will be performed. This is useful for test mode.
;#
;# and if ($op & 8) is true, `besame' requires mtimes for $a and
;# $b must match.
;#
sub besame ($$$;$) {
	my $p = shift; # myself
	my $a = shift; # Attrib object
	my $b = shift; # Attrib object
	my $modify = 0;
	my $op;
	my $path = undef;
	my $key;
	my $val;
	my $ftp = $p->{via_ftp};

	# DEBUG purpose only.
	confess("$a must be an Attrib")
		unless ref($a) && $a->isa('Fan::Attrib');
	confess("$b must be an Attrib")
		unless ref($b) && $b->isa('Fan::Attrib');

	# Set operation type.
	if (@_) {
		$op = shift;
	} else { # or default operation type.
		$op = $p->put_mode ? 1 :
			$p->test_mode ? 3 : 2; 
	}

	# Must we check mtime?
	my $check_mtime = $op & 8;
	$op &= 7;

	plog(8, "* besame($a, $b, $op)\n");

	# $op == 2 may modify real path attributes.
	if ($op == 2) {
		my $t = $a->{y_realpath};
		$path = $t if $t ne '' && -e $t; # check existence
	}

	# for logging
	my $x = $a->path;

	# Types must match.
	$key = 'y_type';
	$val = exists($b->{$key}) ? $b->{$key} : undef;
	if ($a->{$key} ne $val) {
		plog(7, "$x: type differs.\n");
		return undef;
	}

	# Check symlink
	if ($val eq 'L') {
		$key = 'y_linkto';
		$val = exists($b->{$key}) ? $b->{$key} : undef;
		if ($a->{$key} eq $val) {
			plog(8, "$x: symlink check ok.\n");
		} elsif ($op == 2 && $path) { # modification is permitted
			unlink($path); # type == symlink was checked.
			symlink($val, $path);
			$a->{$key} = $val;
			$modify++;
			plog(8, "$x: symlink modify ok.\n");
		} elsif ($op == 3) {
			$a->{$key} = $val;
			$modify++;
			plog(8, "$x: symlink will be changed.\n");
		} else {
			plog(7, "$x: symlink mismatch.\n");
			return undef;
		}
		## return $modify; # no more check is required for symlink. 

	} elsif ($val eq 'F') { # Check a regular file.

		# Size must match, too.
		$key = 'y_size';
		$val = exists($b->{$key}) ? $b->{$key} : undef;
		if (!exists($a->{$key}) || !defined($val)) {
			plog(8, "$x: skip size test.\n");
		} elsif ($a->{$key} == $val) {
			plog(8, "$x: size check ok.\n");
		} else {
			plog(7, "$x: size differs.\n");
			return undef; # this is a critical error
		}

		# MD5 checksum must match if exists.
		$key = 'y_checksum';
		$val = exists($b->{$key}) ? $b->{$key} : undef;
		if (!exists($a->{$key}) || !defined($val)) {
			plog(8, "$x: skip checksum test.\n");
		} elsif ($a->{$key} eq $val) {
			plog(8, "$x: checksum test ok.\n");
			# In this case, MD5CHECKSUM is same, so
			# We need not check mtime.
			$check_mtime = 0;
		} else {
			plog(7, "$x: checksum differs.\n");
			return undef; # this is a critical error
		}

		# By default we require mtime check.
		my $need_mtime_check = 0;
		my $ta;
		my $tb;
		my $tt;
		my $z;

		# Undefined modified time means that the attribute was
		# filled with FTP LIST information (including ls-lR).
		# So, at least one of $a or $b must have modified time.
		$key = 'y_mtime';
		if (exists($a->{$key}) && exists($b->{$key})) {
			$need_mtime_check++;
		} elsif (exists($a->{$key})) {
			if (!defined($p->ftp_offset) &&
				$b->{y_date} =~ /\d\d?:\d\d/ &&
				$p->fill_mtime($b)) {
				$need_mtime_check++;
			} else {
				$tt = $ta = $a->{$key} + $p->ftp_offset;
				$tb = $b->{y_time0};
				$z = $b;
			}
		} elsif (exists($b->{$key})) {
			if (!defined($p->ftp_offset) &&
				$a->{y_date} =~ /\d\d?:\d\d/ &&
				$p->fill_mtime($a)) {
				$need_mtime_check++;
			} else {
				$ta = $a->{y_time0};
				$tt = $tb = $b->{$key} + $p->ftp_offset;
				$z = $a;
			}
		} else { # THIS MUST NOT OCCUR
			confess("neither of $a or $b has no mtime");
			die; die; die;
		}

		# check time0 / date before mtime check.
		if ($need_mtime_check) {
			; # skip this
		} elsif ($ta == $tb) {
			plog(8, "$x: time0 check ok.\n");
		} elsif ($op == 1 && $ta > $tb) {
			plog(8, "$x: time0 seems good.\n");
		} elsif (date_check($z->date, $tt)) {
			plog(8, "$x: time0(date) check ok.\n");
		} elsif ($p->fill_mtime($z)) {
			$need_mtime_check++; # get mtime o.k., warp to next.
		} elsif ($check_mtime) {
			plog(8, "$x: time0 check failed.\n"), return undef;
		} elsif ($op == 2) {
			if ($p->put_mode) { # this is FTP server's file
				plog(7, "$x: time0 do nothing, ignored.\n");
			} elsif ($path && ! -l $path) {
				unless (utime($tb, $tb, $path)) {
					warn("utime($path): $!");
					return undef;
				}
				$a->{y_time0} = $tb;
				$modify++;
				plog(8, "$x: time0 modify ok.\n");
			} else {
				plog(7, "$x: time0 no file found.\n");
				### return undef;
			}
		} elsif ($op == 3) {
			$a->{y_time0} = $val;
			$modify++;
			plog(8, "$x: mtime will be changed.\n");
		} else {
			plog(8, "$x: time0 check error.\n"), return undef;
		}

		#
		$key = 'y_mtime';
		$val = $b->{$key};
		if (!$need_mtime_check) {
			; # simply skip this check
		} elsif (!exists($a->{$key}) || !defined($val)) {
			plog(8, "$x: skip mtime check.\n"); # really?
		} elsif ($a->{$key} == $val) {
			plog(8, "$x: mtime check ok.\n");
		} elsif ($op == 1 && $a->{$key} > $val) {
			plog(8, "$x: mtime seems good.\n");
		} elsif ($check_mtime) {
			plog(8, "$x: mtime check failed.\n"), return undef;
		} elsif ($op == 2) {
			if ($p->put_mode) { # this is FTP server's file
				plog(7, "$x: mtime do nothing, ignored.\n");
			} elsif ($path && ! -l $path) {
				unless (utime($val, $val, $path)) {
					warn("utime($path): $!");
					return undef;
				}
				$a->{$key} = $val;
				$modify++;
				plog(8, "$x: mtime modify ok.\n");
			} else {
				plog(7, "$x: mtime no file found, ignored.\n");
				### return undef;
			}
		} elsif ($op == 3) {
			$a->{$key} = $val;
			$modify++;
			plog(8, "$x: mtime will be changed.\n");
		} else {
			plog(8, "$x: mtime check error.\n"), return undef;
		}
	}

	# Addtional checks are only for $op == 2 || $op == 3.
	return 0 unless $op == 2 || $op == 3;

	# Check permission.
	$key = 'y_perm';
	$val = $b->{$key};
	if (!exists($a->{$key}) || !defined($val)) {
		plog(8, "$x: skip perm test.\n");
	} elsif ($a->{$key} == $val) {
		plog(8, "$x: perm check ok.\n");
	} elsif ($op == 2) {
		if ($p->put_mode) { # this is FTP server's file
			my $ftp = $p->{via_ftp}; # MUST EXIST
			warn("try chmod $path\n") if $LOG >= 5;
			if ($ftp->chmod($val, $path)) {
				$modify++;
				plog(8, "$x: perm modify ok.\n");
			} else {
				warn("FTP::chmod($path): [".$ftp->error."]\n")
					if $LOG >= 6;
				# but ignore this error
				plog(7, "$x: perm could not modify.\n");
			}
		} elsif ($path && ! -l $path) {
			unless (chmod($val, $path)) {
				warn("chmod($path): $!");
				return undef;
			}
			$a->{$key} = $val;
			$modify++;
			plog(8, "$x: perm modify ok.\n");
		} else {
			plog(7, "$x: mtime no file found, ignored.\n");
			### return undef;
		}
	} elsif ($op == 3) {
		$modify++;
		plog(8, "$x: perm will be changed.\n");
	} else {
		plog(7, "$x: perm check error.\n");
		return undef;
	}

	# Check owner / group
	$key = 'y_owner';
	$val = $b->{$key};
	if ($< || !exists($a->{$key}) || !defined($val)) {
		plog(8, "$x: skip owner test.\n");
	} elsif ($a->{$key} == $val && $a->{y_group} == $b->{y_group}) {
		plog(8, "$x: owner check ok.\n");
	} elsif ($op == 2) {
		if ($p->put_mode) { # this is FTP server's file
			plog(7, "$x: time0 do nothing, ignored.\n");
		} elsif ($path) {
			my $g = $b->{y_group};
			if (!defined($g) && !defined($g = (stat($path))[5])) {
				warn("stat($path): $!\n");
				return undef;
			}
			unless (chown($val, $g, $path)) {
				warn("chown($path): $!");
				return undef;
			}
			$a->{$key} = $val;
			$a->{y_group} = $g;
			$modify++;
			plog(8, "$x: owner modify ok.\n");
		} else {
			plog(7, "$x: owner no file found, ignored.\n");
			### return undef;
		}
	} elsif ($op == 3) {
		$modify++;
		plog(8, "$x: owner will be changed.\n");
	} else {
		plog(7, "$x: owner check error.\n");
		return undef;
	}

	# DEBUG only: At last, we validate once more.
	return undef unless $a->validate;

	# result is # of modifications.
	$modify;
}

;#
;# date_check returns 1 if check is o.k.
;#
sub date_check ($$) {
	my $date = shift;
	my $time = shift;

	$date =~ s/\s+/ /g || return undef; # maybe null string.

warn("date_check: $time vs [$date]\n") if $LOG > 7;

	my($sec, $min, $hour, $day, $month, $year) = gmtime($time);
	my $mon = $Fan::Cool::nameofmonth[$month];
	$month++;

	my $d;
	if ($date =~ /^\d\d-\d\d-\d\d \d\d:\d\d(AM|PM)$/i) { # DOS?
		$d = sprintf("%02d-%02d-%02d %02d:%02d%s",
		$month + 1, $day, $year, ($hour > 12 ? $hour - 12 : $hour),
		$min, ($hour > 12 ? 'PM' : 'AM'));
	} elsif ($date =~ / \d\d:\d\d:\d\d \d\d\d\d$/) { # long format
		$d = sprintf("%s %d %02d:%02d:%02d %04d", $mon, $day,
			$hour, $min, $sec, $year + 1900);
	} elsif ($date =~ / \d\d:\d\d$/) { # time
		$d = sprintf("%s %d %02d:%02d", $mon, $day, $hour, $min);
	} elsif ($date =~ / \d:\d\d$/) {
		$d = sprintf("%s %d %d:%02d", $mon, $day, $hour, $min);
	} else {
		$d = sprintf("%s %d %04d", $mon, $day, $year + 1900);
	}

	my $result = $date eq $d ? 1 : 0;
warn("date_check: [$d] vs [$date] results $result\n") if $LOG > 7;

	$result;
}

;#
;# Calculate offset of server's timezone.
;# Usage:
;#	$offset = &calc_offset(time_in_gmt, time_in_local);
;#
sub calc_offset ($$) {
	my $exact = shift;
	my $wrong = shift;
	my $diff = $wrong - $exact;

	# $z is the timezone
	my $h = int((abs($diff) + 1800) / 3600);

	# check offset value
	if ($h >= 24) {
		warn("calc_offset: diff=$diff seems wrong.\n");
		return undef;
	}

	# debug log
	# my $z = ($diff < 0 ? '-' : '+').sprintf("%02d00", $h);
	# plog(6, "calc_offset: timezone seems to be $z\n");

	# result is the offset value of timezone.
	my $offset = 3600 * $h;
	$offset = - $offset if $diff < 0;
	$offset;
}

;#
;# $p->adjust_offset(time_in_gmt, time_in_local);
;# adjust $p->{'offset'}.
;#
;#
sub adjust_offset ($$$) {
	my $self = shift; # Package object.
	my $offset = &calc_offset(@_);

	unless (defined($offset)) {
		warn("adjust_offset: could not find offset.\n") if $LOG > 5;
		return undef;
	}
	unless (defined($self->setval('ftp_offset', $offset))) {
		warn("adjust_offset: could not set offset.\n") if $LOG > 5;
		return undef;
	}
	warn("adjust_offset: offset = $offset\n") if $LOG > 5;
	1;
}

;#
;# Generate .dirinfo files for the local directory.
;#
sub mkdirinfo ($) {
	my $p = shift;
	my $dir = $p->local_directory;

	# try generate DIR object.
	use Fan::DIR;
	my $info = Fan::DIR->new(dir_path => $dir);

	# check result.
	unless (ref($info)) {
		carp("DIR($dir) can't be initialized.\n");
		return undef;
	}

	# let's try.
	if ($info->update) { # this is a recursive call.
		warn("$dir: modified.\n") if $LOG > 5;
	} else {
		warn("$dir: not modified.\n") if $LOG > 5;
	}

	# success to update .dirinfo files.
	1;
}

;#
;# generate server side scanner.
;# returning Scan object.
;#
sub remote_scanner ($;$) {
	my $p = shift; # Fan object.
	my $force_ftp = @_ ? shift : 0;
	my $scan = undef;

	# Check network initialization.
	unless ($p->net_init) {
		warn("step_synch: can't initialize network");
		return undef;
	}

	# Check index directories.
	# SHOULD WE HAVE A NEW FLAG FOR INDEX MODE?
	if (!$force_ftp && $p->local_db_directory) { # index mode
		unless ($p->step_synch) {
			carp("remote_scanner: can't synch step files");
			return undef;
		}
		$scan = Fan::Scan->new(
			scan_type => 'INDEX',
			scan_index => $p->{newest_index_file},
		);
		unless (defined($scan)) {
			carp("remote_scanner: Can't create Scan(INDEX)");
			return undef;
		}
	}

	# Try to get remote lslR file if required.
	my $file = $p->lslR_file;
	my $copy = $p->lslR_copy;
	my $lslR_mode = $file || $copy;
	if (!$force_ftp && !defined($scan) && $lslR_mode) {
		my $notrans = 0;
		my $a = undef;
		my $m = 0;

		# if we have remote lslR_file.
		if ($file ne '') {
			my $tail;
			($tail) = $file =~ m|([^/]+)$|;
			$a = Fan::Attrib->new(
				y_type => 'F',
				y_path => $file,
				y_name => $tail,
			);
			$p->fill_size($a);
			$p->fill_mtime($a);
			$m = $a->mtime;
		}

		# change to absulte if needed.
		if ($copy =~ /^[^\/]/) {
			$copy = $p->local_directory.'.'.$copy;
		}

		# check if we should transfer lslR_file or not.
		if ($copy eq '') {
			$copy = $p->temp_directory."/ls$$";
			$copy .= $& if $file =~ /\.(gz|Z)$/;
			$p->{tempfiles}->{$copy}++;
		} elsif (-f $copy) {
			my $y = Fan::Attrib->new(attr_path => $copy);
			if (!ref($a)) {
				$notrans++;
			} elsif ($a->size == $y->size && $y->mtime eq $m) {
				$notrans++; # no need to transfer...
			}
		} elsif (!ref($a)) {
			carp("remote_scanner: no remote lslR_file");
			return undef;
		}

		# notrans flags or try to retrieve server's lslR file.
		unless ($notrans || $p->get($file, $copy)) {
			carp("remote_scanner: can't get $file");
			return undef;
		}

		# try to set modified time of local copy.
		if ($m > 0) {
			utime($m, $m, $copy); # ignore result.
		}

		# now, generate scanner.
		$scan = Fan::Scan->new(
			scan_type => 'LSLR',
			scan_lslR => $copy
		);

		# check result.
		unless (defined($scan)) {
			carp("remote_scanner: can't create Scan(LSLR)");
			return undef;
		}
	}

	# try normal FTP session
	if (!defined($scan)) { # normal FTP session
		if ($p->load_remote_dirinfo) { # we can load dirinfo?
			plog(5, "load dirinfo = yes\n");
		}
		$scan = Fan::Scan->new(
			scan_type => 'FTP',
			scan_ftp => $p,	# myself
			scan_dir => $p->remote_directory,
			scan_dirinfo => $p->load_remote_dirinfo
		);
		unless (defined($scan)) {
			carp("remote_scanner: can't create Scan(FTP)");
			return undef;
		}
	}

	# additional filters
	my $code = $p->put_mode ? \&client_filter : \&server_filter;
	unless ($scan->add_filter($code, $p)) {
		carp("remote_scanner: can't add filter");
		return undef;
	}

	# additional filters for file uid/gid, file mode
	unless ($p->put_mode) {
		unless ($scan->add_filter(\&changer_filter, $p)) {
			carp("remote_scanner: can't add changer");
			return undef;
		}
	}

	# information log...
	warn("remote directory = ".$p->remote_directory."\n") if $LOG >= 5;

	# $scan is defined on success
	$scan;
}

;#
sub local_scanner ($;$) {
	my $p = shift; # Fan object
	my $force_local = @_ ? shift : !$p->use_master_db;
	my $dir = $p->master_db_directory;
	my $scan = undef;

	# local index file can be used for local scanner...
	if (!$force_local && $dir ne '' && -d $dir) {
		my $farm = Fan::Farm->new($dir);
		if (defined($farm) && $farm->{pim_index_max} > 0) {
			my $index = "$dir/index.$farm->{pim_index_max}";
			$scan = Fan::Scan->new(
				scan_type => 'INDEX',
				scan_index => $index
			);
		}
	}

	# local side scanner
	if (!defined($scan)) {
		$scan = Fan::Scan->new(
			scan_type => 'LOCAL',
			scan_dir => $p->local_directory,
		);
	}

	unless (defined($scan)) {
		carp("local_scanner: can't create Scan(LOCAL)");
		return undef;
	}

	# additional filters
	my $code = $p->put_mode ? \&server_filter : \&client_filter;
	unless ($scan->add_filter($code, $p)) {
		carp("local_scanner: can't add filter");
		return undef;
	}

	# additional filters for file uid/gid, file mode
	if ($p->put_mode) {
		unless ($scan->add_filter(\&changer_filter, $p)) {
			carp("remote_scanner: can't add changer");
			return undef;
		}
	}

	# information log...
	warn("local directory = ".$p->local_directory."\n") if $LOG >= 5;

	#
	$scan;
}

;#
sub server_filter {
	my $y = shift; # Fan::Attrib object.
	my $p = shift; # Argument == Fan object.
	my $t = $y->type;
	my $x = $y->path;

	if ($t eq 'D' || $t eq 'U') {
		unless (&{$p->transfer_directory}($x.'/')) {
plog(7, "$x/... server file ignored (transfer)\n");
			return 0;
		}
		unless (&{$p->override_directory}($x.'/')) {
plog(7, "$x/... server file ignored (override)\n");
			return 0;
		}
	} elsif ($t eq 'F' || $t eq 'L') {
		unless (&{$p->transfer_file}($x)) {
plog(7, "$x... server file ignored (transfer)\n");
			return 0;
		}
		unless (&{$p->override_file}($x)) {
plog(7, "$x... server file ignored (override)\n");
			return 0;
		}
	}
plog(8, "$t $x... server file found\n") if defined($x);
	1;
}

;#
sub client_filter {
	my $y = shift; # Fan::Attrib object.
	my $p = shift; # Argument == Fan object.
	my $t = $y->type;
	my $x = $y->path;

	if ($t eq 'D' || $t eq 'U') {
		unless (&{$p->override_directory}($x.'/')) {
plog(7, "$x/... client file ignored (override)\n");
			return 0;
		}
	} elsif ($t eq 'F' || $t eq 'L') {
		unless (&{$p->override_file}($x)) {
plog(7, "$x... client file ignored (override)\n");
			return 0;
		}
	}
plog(8, "$t $x... client file found\n") if defined($x);
	1;
}

;#
sub changer_filter {
	my $y = shift; # Fan::Attrib object.
	my $p = shift; # Argument == Fan object.
	my $t = $y->type;

	# change file mode
	if ($t eq 'D' || $t eq 'U') {
		my $mode = $p->override_directory_mode;
		if ($p->override_directory_mode) {
			$mode = oct($p->override_directory_mode);
		} elsif (defined($y->perm)) {
			$mode = $y->perm; # not in octal
		} elsif ($p->default_directory_mode) {
			$mode = oct($p->default_directory_mode);
		} else {
			$mode = 0755;
		}
		$y->perm($mode);
	} elsif ($t eq 'F') {
		my $mode;
		if ($p->override_file_mode) {
			$mode = oct($p->override_file_mode);
		} elsif (defined($y->perm)) {
			$mode = $y->perm; # not octal
		} elsif ($p->default_file_mode) {
			$mode = oct($p->default_file_mode);
		} else {
			$mode = 0644;
		}
		$y->perm($mode);
	}

	# only super user can change owner
	if ($< == 0 && ($t eq 'D' || $t eq 'U' || $t eq 'F')) {
		my $uid;
		my $gid;

		if (defined($uid = get_uid($p->override_file_uid))) {
			; # o.k.
		} elsif (defined($uid = get_uid($y->owner))) {
			; # o.k.
		} elsif (defined($uid = get_uid($p->default_file_uid))) {
			; # o.k.
		} else {
			$uid = 0;
		}
		$y->owner($uid);

		if (defined($gid = get_gid($p->override_file_gid))) {
			; # o.k.
		} elsif (defined($gid = get_gid($y->group))) {
			; # o.k.
		} elsif (defined($gid = get_gid($p->default_file_gid))) {
			; # o.k.
		} else {
			$gid = (split(/\s+/, $)))[0];
		}
		$y->group($gid);
	}

	# and we always return success
	1;
}

;#
sub get_uid {
	my $uid = shift;
	$uid eq '' ? undef : $uid =~ /^\d+$/ ? $& : (getpwnam($uid))[2];
}

;#
sub get_gid {
	my $gid = shift;
	$gid eq '' ? undef : $gid =~ /^\d+$/ ? $& : (getgrnam($gid))[2];
}

;#
sub scan_any ($$) {
	my $p = shift;
	my $scan = shift;

	my $x;
	while (defined($x = $scan->get)) {
		my $t = $x->type;
		print $x->path."\n" if $t ne 'U' && $t ne '.';
	}
	1;
}

;#
sub scan_remote ($) {
	my $p = shift;

	my $scan = $p->remote_scanner;
	unless (ref($scan)) {
		carp("scan_remote: can't create Scan object");
		return undef;
	}
	$p->scan_any($scan);
}

;#
sub scan_local ($) {
	my $p = shift;

	my $scan = $p->local_scanner;
	unless (ref($scan)) {
		carp("scan_local: can't create Scan object");
		return undef;
	}
	$p->scan_any($scan);
}

;#
sub update_master ($) {
	my $p = shift;
	my $dir = $p->master_db_directory;

	my $farm = Fan::Farm->new($dir);
	unless (defined($farm)) {
		carp("update_master: can't create Farm");
		return undef;
	}
	unless ($farm->generate($p->local_directory)) {
		carp("update_master: can't update index");
		return undef;
	}
	unless ($farm->normalize) {
		carp("update_master: can't normalize farm");
		return undef;
	}
	unless ($farm->genindex) {
		carp("update_master: can't generate local index");
		return undef;
	}
	1;
}

;# end of Fan module