#!/usr/local/bin/perl

# syncdir.perl -- 異なるホストに存在する2つのディレクトリ間のファイル
#                 の同期を取るスクリプト


# 利用及び再配布の際は、GNU 一般公用許諾書のバージョン2以降の適当なバー
# ジョンにしたがって下さい。
# このスクリプトは有益であることを目的として作成されていますが、無保証
# です。このスクリプトによって生じたいかなる損害についても、作者は責任
# を負いかねます。

# インストール手順
#   (1) ファイル先頭の perl のパスを、自サイトに合わせて変更します。 
#   (2) 42行目付近の変数 $RSH を、好みに合わせて変更します。
#   (3) パスの通っているディレクトリにコピーして、実行許可属性をセット
#       します。
#   (4) リモートホスト上に存在するファイルを調べるために、自分自身を子
#       プロセスとして呼び出しています。従って、リモートホスト上でも、
#       (1)〜(3) の手順にしたがってインストールを行ってください。
#   (5) 以下のようにコマンドを入力して、リモートホスト上にインストール
#       できたか確認してください。
#           echo exit | rsh host 'syncdir.perl --slave'
#       OK が2回出力されたら、正常に動作しています。

# 一次配布元
#     http://namazu.org/~tsuchiya/perl/syncdir.perl
# 連絡先
#     TSUCHIYA Masatoshi <tsuchiya@namazu.org>


use File::Find;
use File::Basename;
use IPC::Open3;


#===============================================================================
#	Configuration Section
#===============================================================================
# Remote Shell
# $RSH = "rsh";
# $RSH = "ssh";
$RSH = "ssh -C -e none";


# 通信のタイムアウト時間 [sec]
$READ_TIMEOUT  = 60;
$SLAVE_TIMEOUT = 3600;


# 各オプションのデフォルト値
@EXCLUDE     = ( 'core$' );		# --exclude
@INCLUDE     = ();			# --include
$UPDATE_ONLY = 0;			# --update
$DELETE      = 0;			# --delete
$REVERSE     = 0;			# --reverse
$INITFILE    = "$ENV{HOME}/.syncdir";	# --config
$KEYFILE     = "";			# --key
$DEBUG       = 0;			# --debug
$PARANOIA    = 0;			# --paranoia
$SUFFIX      = '~';			# バックアップファイルの接尾辞
$SUFFIX_REG  = '~$';			# $SUFFIX の正規表現
$TEX_SPECIAL = 'TeX';
$TEX_SUFFIX  = '\.(ps|aux|bbl|blg|dvi|log|toc|idx)$';



# プログラム内部で使われる大域変数
$PROGRAM               = basename($0);
$COMMAND{slave}        = "$RSH %s '$PROGRAM --slave'";
$COMMAND{remote_local} = "$RSH -n %s '(cd %s;tar cf - %s)'|(cd %s;tar xiBpf -)";
$COMMAND{local_remote} = "(cd %s;tar cf - %s)|$RSH %s '(cd %s;tar xiBpf -)'";
$COMMAND{local_local}  = "(cd %s;tar cf - %s)|(cd %s;tar xiBpf -)";
$VERSION  = "This is $PROGRAM, version 0.5beta\n";


#===============================================================================
#	本体
#===============================================================================
# start_slave 関数中で参照している大域変数
$FH="SLAVE000";

# 子プロセスとして呼び出された場合の処理
&slave();

# デフォルトの intialize file を読み込む
&read_initfile( $INITFILE );

# コマンドラインオプションを解釈・実行
&main_routin( @ARGV );

# 全ての slave を終了する
&stop_all_slaves();



#===============================================================================
#	メイン・ルーチン
#===============================================================================
sub main_routin (@) {
    my $src_host    = "";
    my $src_root    = "";
    my %src_file    = ();
    my %src_size    = ();
    my %src_dir     = ();
    my $dist_host   = "";
    my $dist_root   = "";
    my %dist_file   = ();
    my %dist_size   = ();
    my %dist_dir    = ();
    my @exclude     = ();
    my @include     = ();
    my @volume      = ();
    my $update_only = $UPDATE_ONLY;
    my $delete      = $DELETE;
    my $reverse     = $REVERSE;
    my $keyfile     = $KEYFILE;

    # オプションの解析
    while( $_ = shift( @_ ) ){
	if( /^(-a|--all)$/ ){		# 設定ファイルに指定された全てのオプションを
	    for( keys %VOLUME ){	#	読み込むオプション
		push( @volume,$VOLUME{$_} );
	    }
	}elsif( /^(-n|--debug)$/ ){	# 実際の処理を行なわず、
	    $DEBUG=1;			#	実行するコマンドの表示のみを行なうオプション
	}elsif( /^--paranoia$/ ){	# 特殊なデバッグ用のメッセージを出力するオプション
	    $PARANOIA=1;
	}elsif( /^(-d|--delete)$/ ){	# 複製元のディレクトリに存在しない
	    $delete=1;			#	ディレクトリとファイルを消去するオプション
	}elsif( /^(-f|--config)$/ ){	# 設定ファイルをデフォルトから変更するオプション
	    my $initfile = shift( @_ );
	    &read_initfile( $initfile )||
		warn "Can't find initialize file: $initfile\n";
	}elsif( /^(-k|--key)$/ ){	# 認証ファイルを指定するオプション
	    $keyfile = shift( @_ );
	}elsif( /^(-r|--reverse)$/ ){	# SrcDir と DistDir を交換して再実行するオプション
	    $reverse = 1;
	}elsif( /^(-v|--volume)$/ ){	# 設定ファイルに指定された
	    my $id = shift( @_ );	#	コマンドラインオプションを読み込むオプション
	    if( defined($VOLUME{$id}) ){
		push( @volume,$VOLUME{$id} );
	    }else{
		&print_usage( "Volume is not defined: $id" );
	    }
	}elsif( /^(-x|--exclude)$/ ){	# 複製しないファイルを指示するための
	    my $reg = shift( @_ );	#	正規表現を与えるオプション
	    $reg =~ s/%/\\%/g;
	    push( @exclude,$reg );
	}elsif( /^(-i|--include)$/ ){	# 複製するファイルを限定する
	    my $reg = shift( @_ );	#	正規表現を与えるオプション
	    $reg =~ s/%/\\%/g;
	    push( @include,$reg );
	}elsif( /^(-u|--update)$/ ){	# 複製先に存在するファイルの更新のみを
	    $update_only=1;		#	行うオプション
	}elsif( /^--version$/ ){	# バージョンを表示するオプション
	    print $VERSION;
	    return;
	}elsif( /^(-h|-\?|--help)$/ ){	# 利用法を表示するためのオプション
	    &print_usage( $VERSION );
	}elsif( !$src_root ){		# 複製元のディレクトリを指定
	    if( /^([^:]+):/ ){		#	: が含まれていた場合は、host:dir 形式の
		$src_host = $1;		#	指定であると解釈する
		$src_root = $';
		$src_root = "." unless $src_root;
	    }else{
		$src_root=$_;
	    }				# 末尾の / を取り除く
	    $src_root=~s%/$%% if $src_root ne "/";
	}elsif( !$dist_root ){		# 複製先のディレクトリを指定
	    if( /^([^:]+):/ ){		#	: が含まれていた場合は、host:dir 形式の
		$dist_host = $1;	#	指定であると解釈する
		$dist_root = $';
		$dist_root = "." unless $dist_root;
	    }else{
		$dist_root=$_;
	    }				# 末尾の / を取り除く
	    $dist_root=~s%/$%% if $dist_root ne "/";
	}else{				# 解釈できないオプション
	    &print_usage( "Too many arguments or illegal argument." );
	}
    }

    # --volume オプションの実行
    if( @volume ){
	if( $src_root | $dist_root ){
	    &print_usage( "Illegal arguments." );
	}
	for $line ( @volume ){
	    print "$PROGRAM $line\n" if $DEBUG;
	    &main_routin( &purse($line) );
	}
	return;
    }

    if(( ! $src_root )&( ! $dist_root )){
	&print_usage( "Too few arguments." );
    }
    if( $src_host & $dist_host ){
	&print_usage( "Can't synchronize file between directorys on remote machine." );
    }

    # --exclude / --include オプションのデフォルト値の設定
    ( @exclude==0 )&&( @exclude=@EXCLUDE );
    ( @include==0 )&&( @include=@INCLUDE );
    push( @exclude,$SUFFIX_REG );

    # ファイルの検索
    $src_root  = search( $src_host,  $src_root,  \%src_file,  \%src_size,  \%src_dir  );
    $dist_root = search( $dist_host, $dist_root, \%dist_file, \%dist_size, \%dist_dir );

    # key file の存在を確認
    if(( $keyfile ne "" )&&( ! defined($src_file{$keyfile}) )){
	if( $src_host ){
	    warn "Can't find key file: $src_host:$src_root/$keyfile\n";
	}else{
	    warn "Can't find key file: $src_root/$keyfile\n";
	}
	return;
    }
    
    # Source -> Distination のファイル転送
    &synchronize( $src_host,  $src_root,  \%src_file,  \%src_size,  \%src_dir,
		  $dist_host, $dist_root, \%dist_file, \%dist_size, \%dist_dir,
		  \@exclude, \@include, $update_only, $reverse );

    # Source の存在しないファイルを削除
    &delete( $dist_host,$dist_root,\%dist_file,\%dist_dir,
	     \%src_file,\%src_dir,\@exclude,\@include ) if $delete;

    # Distination -> Source のファイル転送
    &synchronize( $dist_host, $dist_root, \%dist_file, \%dist_size, \%dist_dir,
		  $src_host,  $src_root,  \%src_file,  \%src_size,  \%src_dir,
		  \@exclude, \@include, $update_only+$delete, 1 ) if $reverse;
}



# initialize file を読み込む関数
sub read_initfile ($) {
    my $file = shift;
    warn "read_initfile($file)\n" if $PARANOIA;
    my @l = ();
    open( FILE,"< $file" )||return 0;
    while( <FILE> ){
	next if /^#/;			# 行頭が # の行はコメントとして無視される
	next if /^$/;			# 空行を無視
	s/^\s+/ /;
	s/\s+$//;
	push( @l,$_ );
    }
    close FILE;
    my $l = join( "\n",@l );
    $l =~ s/\\\n//g;			# \ で終わっている行を継続行として連結
    for( split( "\n",$l ) ){
	( /^(\w[^:]*):\s+/ )||die "Format error in initialize file: $file\n";
	( ! $VOLUME{$1} )||warn "Conflict volume definition: $1\n";
	$VOLUME{$1}=$';
	warn "read_initfile():\$VOLUME{$1}=\"$'\"\n" if $PARANOIA;
    }
    1;
}



# 文字列をオプションのリストに分解する関数
sub purse ($) {
    my $s = shift;
    warn "purse($s)\n" if $PARANOIA;
    my @quote;
    while( $s=~/[\"\']/ ){ #"
	if( $s=~s/^(^[^\"\']*)\"([^\"]*)\"/$1$;/ ){
	    push( @quote,$2 );
	}elsif( $s=~s/^(^[^\"\']*)\'([^\']*)\'/$1$;/ ){ #"
	    push( @quote,$2 );
	}
    }
    my @argv = split( /[ \t]+/,$s );
    grep( s/$;/shift( @quote )/ge, @argv );
    warn "purse(): ",join("▽",@argv),"\n" if $PARANOIA;
    return @argv;
}



# ファイル/ディレクトリを複製する関数
sub synchronize ($$$$$$$$$$$$$$) {
    my( $src_host,  $src_root,  $src_file,  $src_size,  $src_dir,
        $dist_host, $dist_root, $dist_file, $dist_size, $dist_dir,
        $exclude, $include, $update_only, $reverse )=@_;
    warn "synchronize($src_host,$src_root,$src_file,$src_size,$src_dir,$dist_host,$dist_root,$dist_file,$dist_size,$dist_dir,$exclude,$include,$update_only,$reverse)\n" if $PARANOIA;

    # 複製するファイルのリストを生成する
    my @F;
    my $tex_exclude = grep( $_ eq $TEX_SPECIAL,@$exclude );
    for $file ( &restrict( $exclude, $include, sort keys %$src_file ) ){
	next if( $tex_exclude
		 && $file=~m%$TEX_SUFFIX%
		 && defined( $$src_file{"$`.tex"} ) );
	if( $$src_file{$file} > $$dist_file{$file} ){
	    push( @F,$file ) if( $update_only==0 || defined($$dist_file{$file}) );
	}elsif( $$src_file{$file} < $$dist_file{$file} ){
	    warn "Distination is newer: ",
	         $dist_host ? "$dist_host:" : "" ,"$dist_root/$file\n" unless $reverse;
	}else{ # $$src_file{$file}==$$dist_file{$file}
	    if( $$src_size{$file} > $$dist_size{$file} ){
		push( @F,$file );
	    }elsif( $$src_size{$file} < $$dist_size{$file} ){
		warn "Distination is larger: ",
		     $dist_host ? "$dist_host:" : "" ,"$dist_root/$file\n" unless $reverse;
	    }
	}
    }

    # 複製するべきファイルが存在しない場合
    return 0 if @F==0;

    # ディレクトリを複製する
    for $dir ( sort grep( !defined($$dist_dir{$_}),(keys %$src_dir) ) ){
	for( @F ){
	    if( ( length($_) > length($dir) )
	       && ( "$dir/" eq substr($_,0,length($dir)+1) ) ){
		&mkdir( $dist_host,$$src_dir{$dir},"$dist_root/$dir" )||return 0;
		last;
	    }
	}
    }

    # ファイルのバックアップを作成する
    for $file ( @F ){
	&unlink( $dist_host,"$dist_root/$file$SUFFIX" )
	    if defined( $$dist_file{$file.$SUFFIX} );
	&backup( $dist_host,"$dist_root/$file" ) if defined( $$dist_file{$file} );
    }

    # ファイルを転送する
    my $c;
    if( $src_host ){
	$c = sprintf( $COMMAND{remote_local},$src_host,$src_root,join(" ",@F),$dist_root );
    }elsif( $dist_host ){
	$c = sprintf( $COMMAND{local_remote},$src_root,join(" ",@F),$dist_host,$dist_root );
    }else{
	$c = sprintf( $COMMAND{local_local},$src_root,join(" ",@F),$dist_root );
    }
    if( $DEBUG ){
	print "$c\n";
    }else{
	warn "synchronize: $c\n" if $PARANOIA;
	system( $c );
    }

    # 転送結果を確認する
    print $src_host ? "$src_host:" : "","$src_root -> ",
          $dist_host ? "$dist_host:" : "","$dist_root\n";
    for $file ( @F ){
	if( &check( $dist_host,"$dist_root/$file",$$src_file{$file},$$src_size{$file} ) ){
	    print "  $file\n";
	    &unlink_nomsg( $dist_host,"$dist_root/$file$SUFFIX" ) if defined( $$dist_file{$file} );
	}else{
	    print "  $file - transfer error\n";
	    if( defined($$dist_file{$file}) ){
		&restore( $dist_host,"$dist_root/$file" )
	    } else {
		&unlink_nomsg( $dist_host,"$dist_root/$file" );
	    }
	}
    }
    1;
}



# 複製元に存在しないファイル/ディレクトリを削除する関数
sub delete ($$$$$$) {
    my( $dist_host,$dist_root,$dist_file,$dist_dir,$src_file,$src_dir,$exclude,$include )=@_;
    
    # 複製元にないファイルのリストを生成
    my @F =&restrict( $exclude,$include,
		     ( grep(!defined($$src_file{$_}),(sort keys %$dist_file)) ) );

    # 複製元にないディレクトリのリストを生成
    my @D = grep( !defined($$src_dir{$_}),(sort keys %$dist_dir) );

    # ファイル/ディレクトリを削除
    for $f ( @F ){
	&unlink( $dist_host,"$dist_root/$f" )||return 0;
    }
    for $d ( @D ){
	&rmdir( $dist_host,"$dist_root/$d" );
    }
    1;
}



# --exclude / --include オプションに従ってファイルを制限する関数
sub restrict ($$@) {
    my $exclude = shift;
    my $include = shift;
    my @file    = @_;
    warn "restrict((",join(",",@$exclude),"),(",join(",",@$include),"),(",join(",",@file),"))\n" if $PARANOIA;

    # --exclude オプションで指定されたファイルを除去する
    for $reg ( @$exclude ){
	next if $reg eq $TEX_SPECIAL;
	@file = grep( $_!~m%$reg%,@file );
    }

    # --include オプションで指定されたファイルに限定する
    if( @$include==0 ){
	warn "restrict(): (",join(",",@file),")\n" if $PARANOIA;
	return @file;
    }else{
	my @F;
	for $f ( @file ){
	    for $r ( @$include ){
		if( $f=~m%$r% ){
		    push( @F,$f );
		    last;
		}
	    }
	}
	warn "restrict(): (",join(",",@F),")\n" if $PARANOIA;
	return @F;
    }
}



# 指定されたディレクトリ以下のファイルを調べる関数
sub search ($$$$$) {
    ( $search_host,$search_root,$search_file,$search_size,$search_dir )=@_;
    warn "search($search_host,$search_root,$search_file,$search_size,$search_dir)\n" if $PARANOIA;
    if( $search_host ){
	&send_command( $search_host,"search $search_root" )
	    || die "Can't find dir: $search_host:$search_root\n";
	my $s;
	while( 1 ){
	    $s = &read_slave($search_host);
	    if( $s=~/^f (\d+) (\d+) / ){
		$$search_file{$'}=$1;
		$$search_size{$'}=$2;
	    }elsif( $s=~/^d (\d+) / ){
		$$search_dir{$'}=$1;
	    }elsif( $s=~/^ROOT=/ ){
		$search_root=$';
		last;
	    }else{
		die "search: illegal string : $search_host : $s\n";
	    }
	}
    }else{
	$search_root =~ s%^([^/])%$ENV{HOME}/$1%; # 絶対パスに変換
	( -d $search_root )||die "Can't find dir: $search_root\n";
	&find( \&wanted, $search_root );
    }
    warn "search(): $search_root\n" if $PARANOIA;
    return $search_root;		# 指定されたディレクトリの絶対パスを返す
}



sub backup ($$) {
    my( $host,$file )=@_;
    warn "backup($host,$file)\n" if $PARANOIA;
    unless( $DEBUG ){
	if( $host ){
	    unless( &send_command($host,"backup $file") ){
		warn "Can't make backup file: $host:$file ($err)\n";
		return 0;
	    }
	}else{
	    unless( rename($file,$file.$SUFFIX) ){
		warn "Can't make backup file: $file ($!)\n";
		return 0;
	    }
	}
    }else{
	print "debug: Make backup file: ", $host ? "$host:$file" : $file ,"\n";
    }
    1;
}



sub restore ($$) {
    my( $host,$file )=@_;
    warn "restore($host,$file)\n" if $PARANOIA;
    unless( $DEBUG ){
	if( $host ){
	    unless( &send_command($host,"restore $file") ){
		warn "Can't restore file: $host:$file ($err)\n";
		return 0;
	    }
	}else{
	    unless( rename($file.$SUFFIX,$file) ){
		warn "Can't restore file: $file ($!)\n";
		return 0;
	    }
	}
    }else{
	print "debug: ";
    }
    print "Restore file: ", $host ? "$host:$file" : $file ,"\n";
    1;
}



sub check ($$$$) {
    my( $host,$file,$ftime,$fsize )=@_;
    warn "check($host,$file,$ftime,$fsize)\n" if $PARANOIA;
    unless( $DEBUG ){
	if( $host ){
	    &send_command( $host,"check $ftime $fsize $file" ) || return 0;
	}else{
	    if( -f $file ){
		my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime)=lstat(_);
		return 0 unless( $mtime==$ftime & $size==$fsize );
	    }
	}
    }else{
	print "debug: Checking file: ", $host ? "$host:$file" : $file ,"\n";
    }
    1;
}



sub mkdir ($$$) {
    my( $host,$mode,$dir )=@_;
    warn "mkdir($host,$mode,$dir)\n" if $PARANOIA;
    unless( $DEBUG ){
	if( $host ){
	    unless( &send_command( $host,"mkdir $mode $dir" ) ){
		warn "Can't make directory: $host:$dir ($err)\n";
		return 0;
	    }
	}else{
	    unless( mkdir($dir,$mode) ){
		warn "Can't make directory: $dir ($!)\n";
		return 0;
	    }
	}
    }else{
	print "debug: ";
    }
    print "Make directory: ", $host ? "$host:" : "" ,"$dir\n";
    1;
}



sub rmdir ($$) {
    my( $host,$dir )=@_;
    warn "rmdir($host,$dir)\n" if $PARANOIA;
    unless( $DEBUG ){
	if( $host ){
	    unless( &send_command( $host,"rmdir $dir" ) ){
		warn "Can't remove directory: $host:$dir ($err)\n";
		return 0;
	    }
	}else{
	    unless( rmdir($dir) ){
		warn "Can't remove directory: $dir ($!)\n";
		return 0;
	    }
	}
    }else{
	print "debug: ";
    }
    print "Remove directory: ", $host ? "$host:" : "" ,"$dir\n";
    1;
}



sub unlink ($$) {
    my( $host,$file )=@_;
    warn "unlink($host,$file)\n" if $PARANOIA;
    &unlink_nomsg( $host,$file ) || return 0;
    print "debug: " if $DEBUG;
    print "Remove file: ", $host ? "$host:" : "" ,"$file\n";
    1;
}



sub unlink_nomsg ($$) {
    my( $host,$file )=@_;
    warn "unlink_nomsg($host,$file)\n" if $PARANOIA;
    unless( $DEBUG ){
	if( $host ){
	    unless( &send_command( $host,"unlink $file" ) ){
		warn "Can't remove file: $host:$file ($err)\n";
		return 0;
	    }
	}else{
	    unless( unlink($file) ){
		warn "Can't remove file: $file ($!)\n";
		return 0;
	    }
	}
    }
    1;
}



sub send_command ($$) {
    my( $host,$command ) = @_;
    warn "send_command($host,$command)\n" if $PARANOIA;
    defined( $HOST{$host} ) || &start_slave( $host ) || return 0;
    my $fh = $HOST{$host}{WRITE};
    print $fh "$command\n";
    my $s = &read_slave( $host );
    warn "send_command(): $s\n" if $PARANOIA;
    if( $s=~/^OK$/ ){
	return 1;
    }elsif( $s=~/^ERROR / ){
	$err = $';
	return 0;
    }else{
	die "send_command: illegal string : $host : $command : $s\n";
    }
}



sub read_slave ($) {
    my $host = shift;
    warn "read_slave($host)\n" if $PARANOIA;
    defined( $HOST{$host} ) || return 0;
    my $fh = $HOST{$host}{READ};
    local $SIG{ALRM} = sub { die "read_slave: timeout($host): $READ_TIMEOUT\n" };
    alarm $READ_TIMEOUT;
    my $s = <$fh>;
    alarm 0;
    $s =~ s/\r?\n$//;
    warn "read_slave(): $s\n" if $PARANOIA;
    $s;
}



# slave を起動する関数
sub start_slave ($) {
    my $host = shift;
    warn "start_slave($host)\n" if $PARANOIA;
    if( defined($HOST{$host}) ){
	return 1 if &send_command( $host,"nop" );
    }
    my( $r,$w,$e ) = ( $FH++,$FH++,$FH++ );
    my $c = sprintf( $COMMAND{slave},$host );
    warn "open3($r,$w,$e,$c)\n" if $PARANOIA;
    my $pid = &open3( $w,$r,$e,$c );
    select( (select($w),$|=1)[0] );
    if( $pid > 0 ){
	local $SIG{ALRM} = sub { die "start_slave: timeout($host): $READ_TIMEOUT\n" };
	alarm $READ_TIMEOUT;
	my $s = <$r>;
	alarm 0;
	if( $s=~/^OK $VERSION$/ ){
	    $HOST{$host} = { 'READ'  => $r,
			     'WRITE' => $w,
			     'ERROR' => $e };
	    &send_command( $host,"suffix $SUFFIX" ) && return $pid;
	    warn "Failure to set suffix: $host\n";
	}else{
	    warn "Version of slave program is mismatched: $host ($')\n" if $s=~/^OK /;
	}
    }
    warn "start_slave(): can't start slave $_\n" if $PARANOIA;
    warn "Can't start slave : $c\n",
	"Please check that $PROGRAM is executable on $host\n";
    0;
}



# 全ての slave を終了する関数
sub stop_all_slaves {
    warn "stop_all_slaves()\n" if $PARANOIA;
    for $h ( keys %HOST ){
	&send_command( $h,"exit" );
    }
    1;
}



# slave mode のコマンドを処理する関数
sub slave {
    return unless ( @ARGV==1 )&&( $ARGV[0] eq '--slave' );
    $|=1;
    print "OK $VERSION";
    local $SIG{ALRM} = sub { exit(1) };
    alarm $SLAVE_TIMEOUT;
    while( <STDIN> ){
	alarm 0;
	s/\r?\n//;			# 改行コードを削除
	# 指定されたディレクトリ以下のファイルを検索する : search <dir>
	if( /^search / ){
	    $search_root = $';
	    $search_root =~ s%^([^/])%$ENV{HOME}/$1%;
	    $search_root =~ s%/$%% if $search_root ne "/";
	    if( ! -d $search_root ){
		print "ERROR $search_root\n";
		next;
	    }
	    my( %file,%size,%dir );
	    $search_file = \%file;	# 各ファイルの更新日時を格納するハッシュ
	    $search_size = \%size;	# 各ファイルの大きさを格納するハッシュ
	    $search_dir  = \%dir;	# 各ディレクトリの permission を格納するハッシュ
	    &find( \&wanted,$search_root );
	    print "OK\n";
	    for( sort keys %dir ){
		print "d $dir{$_} $_\n";
	    }
	    for( sort keys %file ){
		print "f $file{$_} $size{$_} $_\n";
	    }
	    print "ROOT=$search_root\n";
	}
	# バックアップファイルの接尾辞を設定する : suffix <str>
	elsif( /^suffix / ){
	    $SUFFIX=$';
	    print "OK\n";
	}
	# 指定されたファイルのバックアップを作成する : backup <file>
	elsif( /^backup / ){
	    my $f = $';
	    if( rename($f,$f.$SUFFIX) ){
		print "OK\n";
	    }else{
		print "ERROR $!\n";
	    }
	}
	# 指定されたファイルをバックアップから回復する : restore <file>
	elsif( /^restore / ){
	    my $f = $';
	    if( rename($f.$SUFFIX,$f) ){
		print "OK\n";
	    }else{
		print "ERROR $!\n";
	    }
	}
	# 指定されたファイルの状態を調べる : check <mtime> <size> <file>
	elsif( /^check (\d+) (\d+) / ){
	    my $t = $1;
	    my $s = $2;
	    my $f = $';
	    if( -f $f ){
		my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime)=lstat(_);
		if(( $mtime==$t )&&( $size==$s )){
		    print "OK\n";
		}else{
		    print "ERROR $mtime $size\n";
		}
	    }else{
		print "ERROR $!\n";
	    }
	}
	# 指定されたディレクトリを作成する : mkdir <mode> <dir>
	elsif( /^mkdir (\d+) / ){
	    my $m = $1;
	    my $d = $';
	    if( mkdir($d,$m) ){
		print "OK\n";
	    }else{
		print "ERROR $!\n";
	    }
	}
	# 指定されたディレクトリを削除する : rmdir <dir>
	elsif( /^rmdir / ){
	    my $d = $';
	    if( rmdir($d) ){
		print "OK\n";
	    }else{
		print "ERROR $!\n";
	    }
	}
	# 指定されたファイルを削除する : unlink <file>
	elsif( /^unlink / ){
	    my $f = $';
	    if( unlink($f) ){
		print "OK\n";
	    }else{
		print "ERROR $!\n";
	    }
	}
	# 何もしない : nop
	elsif( /^nop$/ ){
	    print "OK\n";
	}
	# slave を終了する : exit
	elsif( /^(exit|quit)$/ ){
	    print "OK\n";
	    last;
	}
	alarm $SLAVE_TIMEOUT;
    }
    exit(0);
}



# search / slave から利用されるサブルーチン
sub wanted {
    warn "wanted($_)\n" if $PARANOIA;
    return if /^\.\.?$/;
    my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime)=lstat($_);
    my $name = substr( $File::Find::name,length($search_root)+1 );
    if( -f _ ){
	warn "wanted(): f $mtime $size $name\n" if $PARANOIA;
	$$search_file{$name}=$mtime;
	$$search_size{$name}=$size;
    }elsif( -d _ ){
	warn "wanted(): d $mode $name\n" if $PARANOIA;
	$$search_dir{$name}=$mode;
    }
}



# 簡易ヘルプの表示
sub print_usage ($) {
    my $s = shift;
    warn "$s\n" if $s;
    die <<"__END_OF_USAGE__";
NAME
	$PROGRAM - Synchronize two directories

SYNOPSIS
	$PROGRAM [options] [SrcHost:]SrcDir [DistHost:]DistDir
	  or $PROGRAM [options] -v Volume
	  or $PROGRAM [options] -a

OPTIONS
	-a		Do the job for all volumes defined in the initialize file
	-d		Delete files in DestDir that are nonexistent in SrcDir
	-f FILE		Use FILE as initialize file instead of ~/.syncdir
	-h		Print this message
	-i REGEX	Exclude files that don't match REGEX as perl-regex
	-k FILE		Use FILE as keyfile		
	-n		No execute, print jobs to stdout
	-r		Swap src and dest for each volume
	-u		Update files exist in distination directory
	-v VOLUME	Do the job spcified as VOLUME in the initialize file
	-x REGEX	Exclude files that match REGEX as perl-regexp
	-?		Print this message
	--all		Equivalent to -a
	--config	Equivalent to -f
	--debug		Equivalent to -n
	--delete	Equivalent to -d
	--exclude	Equivalent to -x
	--include	Equivalent to -i
	--key		Equivalent to -k
	--reverse	Equivalent to -r
	--update	Equivalent to -u
	--version	Show version number of this program
	--volume	Equivalent to -v
	--help		Print this message

INITIALIZE FILE FORMAT
	Each line of the file contains an identifier specify a volume
	(empty lines and lines stating with a '#' are ignored as comments).
	Each line consists of the following 2 fields, separated by
	semicolon and spaces : an identifier, options.

	For example, your ~/.syncdir contains a line as:
		src: remote:src src
	In this case, "$PROGRAM -v src" is equivalent to
	"$PROGRAM remote:src src"

FILES
	~/.syncdir	Default initialize file.

BUGS
	This program applies only plain file and directory.
	Then, a symbolic link, a named pipe (FIFO), a socket, a block special
	file, a character special file will not be applied as target.

	Empty directory under source dirctory will not be synchoronized.
__END_OF_USAGE__
}