#!/usr/bin/perl

use strict;
use File::Basename;
use Socket;
use POSIX 'setsid';

use lib 'd:/Programs/Perl/lib';
use lib "$ENV{TkPerlDir}/lib";

use Utils;
use MyApplication;

#===============================================
# スクリプト大域変数
#===============================================
my $DaemonMode    = 1;
my $RedirectIO    = 1;
my $ServerPort    = 7797;
my $Perl          = '/usr/bin/perl';
my $SleepInterval = 0; # sec

#アクセス制限の有無
my $IsLimitAccess = 1;
#許可するIPアドレス
my @AllowedIPAddresses =
	(
	 "^127\.0\.0\.1\$",
	 "^192\.168\.1\.\\d{1,3}\$",
	 "^192\.168\.11\.\\d{1,4}\$",
	 "^192\.168\.10\.\\d{1,4}\$",
	 "^131\.112\.130\.56\$"
	);

#==========================================
# メインルーチン
#==========================================
my $App = new MyApplication;
exit if($App->Initialize() < 0);

my $ProgramPath = $App->SpeculateProgramPath($0, "");
my ($drive, $directory, $filename, $ext1, $lastdir, $filebody) = Deps::SplitFilePath($ProgramPath);
my $BaseDir   = "$drive$directory";
my $NowTime   = time();
my $Today     = &BuildDateString($NowTime);
my $IPAddress = $ENV{REMOTE_ADDR};
print "Program Path=$ProgramPath\n";
print "Base Dir=$BaseDir\n";

&init();
&run();
exit;

#==========================================
# Subroutines
#==========================================
sub action {
	my ($port, $iaddr, $name, $CLIENT) = @_;
#print "Enter to action\n";

	my $ClientCommand = <$CLIENT>;
	chomp($ClientCommand);
	$ClientCommand =~ s/[\r\n]//g;
print $CLIENT "ClientCommand: $ClientCommand\n";

	my $IPAddress = inet_ntoa($iaddr);
	if($IsLimitAccess and !&IsAllowedIPAddress($IPAddress, @AllowedIPAddresses)) {
		print $CLIENT "Your access is not allowed ($IPAddress).\n";
		return 0;
	}

	my $now = localtime(time);
	print $CLIENT "Local time: $now\n";

	if($ClientCommand eq '' or $ClientCommand =~ /^(bye|exit|quit)$/i) {
		print $CLIENT "Bye!\n";
		close($CLIENT);
		return 1;
	}
	elsif($ClientCommand eq '-reboot') {
		print $CLIENT "Launch [$Perl $ProgramPath] and shutdown this server.\n";
		exec("$Perl $ProgramPath");
#		close(SOCK);
#		close($CLIENT);
#		exit;
	}
	elsif($ClientCommand =~ /^(.*)@(.*?)$/) {
#For relay: ex. ps@vasp
		my $nextcmd = $1;
		my $nexthost = $2;
print CLIENT "Forward $nextcmd to $nexthost\n";
		my ($accesshost, $accessport) = ($nexthost =~ /^(.*):(.*?)$/);
		my $proto = getprotobyname('tcp');
		my $iaddr = inet_aton($accesshost);
		next if($iaddr eq '');

		my $paddr = sockaddr_in($accessport, $iaddr);
print CLIENT "Response for $nextcmd from $accesshost:$accessport\n";
print CLIENT "\n";
		socket(OUTSOCK, PF_INET, SOCK_STREAM, $proto) or next;
		connect(OUTSOCK, $paddr) or next;

		my @result;
#バッファに入れず、そのまま出力にまわす
		select OUTSOCK; $| = 1; select STDOUT; 
		print OUTSOCK "$nextcmd\n";	
		@result = <OUTSOCK>;
		print $CLIENT @result;
		close(OUTSOCK);
	}
	else {
#print "Execute command [$ClientCommand]\n";
		my $localcmd = Deps::MakePath($BaseDir, ["remotecmd", $ClientCommand], 0);
#print "   => [$localcmd]\n";
		if(-f $localcmd) {
			print CLIENT "CMD: $ClientCommand [$localcmd]\n";
			my $result = `$localcmd`;
			print $CLIENT $result;
		}
		else {
			print $CLIENT "Invalid command: [$localcmd] => [$ClientCommand]\n";
		}
	}

    return 1;
}

sub interrupt {
#    eval{ close(XXXXX);  };  # グローバルで開いているファイルがあれば、閉じる
    my $sig = shift; 
    setpgrp();                 # I *am* the leader 
    $SIG{$sig} = 'IGNORE';
    kill($sig, 0);            # death to all-comers
    die "killed by $sig"; 

    exit(0);
}

sub init {
	$SIG{INT}  = 'interrupt';         # Ctrl-C が押された場合
	$SIG{HUP}  = 'interrupt';         # HUP  シグナルが送られた場合
	$SIG{QUIT} = 'interrupt';         # QUIT シグナルが送られた場合
	$SIG{KILL} = 'interrupt';         # KILL シグナルが送られた場合
	$SIG{TERM} = 'interrupt';         # TERM シグナルが送られた場合

#===============================================
# Daemon fork off process
#===============================================
	if($DaemonMode) {
		my $ChildPId = fork;
		if(!defined $ChildPId) {
			die "Can not fork" 
		}
		elsif($ChildPId == 0) {
#print "This is child process.\n";
		}
		else {
#print "This is parent process. Exit\n";
		exit 0; # 親が終了する
		}
	}

	my $proto = getprotobyname('tcp');
	socket(SOCK, PF_INET, SOCK_STREAM, $proto) or die "socket: $!";
	setsockopt(SOCK, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) or die "setsockopt: $!";

	bind(SOCK, sockaddr_in($ServerPort, INADDR_ANY)) or die "bind: $!";
	listen(SOCK, SOMAXCONN) or die "listen: $!";
print "Access by http://localhost:$ServerPort/\n";

#===============================================
# Daemonプロセスへの移行に伴い、入出力をconsoleから切り離す
#===============================================
	if($DaemonMode) {
		if($RedirectIO) {
			open(STDIN,  "</dev/null");
			open(STDOUT, ">/dev/null");
			open(STDERR, ">&STDOUT");
		}

		if($^O eq 'MSWin32') {
		}
		else {
			setsid(); #セッションリーダーになる
#			chdir('/');
			umask(0); #ファイルモードの作成マスクをリセットする
			$ENV{PATH} = "/bin:sbin:/usr/bin:/usr/sbin";
		}
	}
}

#===============================================
# $SleepIntervalごとに action を呼び出す
#===============================================
sub run {
	while(1) {
		my $CLIENT;
		my $paddr = accept($CLIENT, SOCK);
		if(!$paddr) {
			close($CLIENT);
			return 0;
		}
#print "paddr: $paddr\n";

		my ($port, $iaddr) = sockaddr_in($paddr);
		my $name = gethostbyaddr($iaddr, AF_INET);
#print "paddr: $port, $iaddr, $name\n";

		&action($port, $iaddr, $name, $CLIENT);

		sleep($SleepInterval) if($SleepInterval > 0);
#print "Exit from action\n";
	}
}

sub IsAllowedIPAddress
{
	my ($IPAddress, @allowed) = @_;
	
	foreach my $exp (@allowed) {
		return 1 if($IPAddress =~ /$exp/i);
	}
	return 0;
}

sub BuildDateString
{
	my ($time) = (@_);
	
	my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($time);
	$year += 1900;
	$mon++;
	my $str = sprintf("%02d/%02d/%02d %02d:%02d:%02d", $year, $mon, $mday, $hour, $min, $sec);
	return $str;
}