#!/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 $ServerPort = 7797;
my $Perl = '/usr/bin/perl';

#アクセス制限の有無
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";

#===============================================
# 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) {
	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";
	}
}

#==========================================
# メインルーチンスタート
#==========================================
my $paddr;
for( ; $paddr = accept(CLIENT, SOCK) ; close CLIENT) {
	my ($port, $iaddr) = sockaddr_in($paddr);
	my $name = gethostbyaddr($iaddr, AF_INET);
	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";
		next;
	}

#For relay: ex. ps@vasp
	if($ClientCommand =~ /^(.*)@(.*?)$/) {
		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 {
		if($ClientCommand eq '-reboot') {
			print CLIENT "Launch [$Perl $ProgramPath] and shutdown this server.\n";
			exec("$Perl $ProgramPath");
#			close SOCK;
#			close CLIENT;
#			exit;
		}

		my $now = localtime(time);
		print CLIENT "Local time: $now\n";
		my $localcmd = Deps::MakePath($BaseDir, ["remotecmd", $ClientCommand], 0);
		if(-f $localcmd) {
			print CLIENT "CMD: $ClientCommand [$localcmd]\n";
			my $result = `$localcmd`;
			print CLIENT $result;
		}
		else {
			print CLIENT "Invalid command: [$localcmd] [$ClientCommand]\n";
		}
	}
}
exit;

#==========================================
# Subroutines
#==========================================
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;
}