#!/usr/bin/env perl

use G;
use G::DB::SDB;
use sigtrap;
use Socket;
use Net::IP;
use Sys::Load qw( getload uptime );
use Sys::Hostname;

# use strict;
use vars qw( $server_name $server_ip $sdb_path $htaccess_path $stderr_path );

# default status of server information
#  load_max: 2
#  cpu_num : 2
#  priority: 10

# get hostname, ip adress
# then save the server information to the database
# %server_lists contains server ips
# information of server are in the hash %server_ip 
# keys of %server_lists: $server_ip 
# keys of %server_ip: load_max, 
#                     cpu_num, 
#                     load_now, 
#                     priority, 
#                     pid, 
#                     server_name,
#                     GLANG_SDB_INFINITY
#                     GLANG_HTACCESS

############################################################################
#
# You may set the environmental variable GLANG_HTACCESS & GLANG_SDB_INFINITY
#  or specify them in this script
# Specify $stderr_path in this scrip for debugging
#
############################################################################

$stderr_path = "/tmp/" unless( lstat $stderr_path );

$htaccess_path = '';
$htaccess_path = $ENV{GLANG_HTACCESS} if( $ENV{GLANG_HTACCESS} );

$sdb_path = _sdb_path();
if ( $ENV{GLANG_SDB_INFINITY} ){
    $sdb_path = $ENV{GLANG_SDB_INFINITY};
    $sdb_path . "/" if( substr( $sdb_path, -1, 1) ne "/" );
}
else{
    system( "mkdir -p /tmp/.glang/" );
    system( "chmod 777 /tmp/.glang/" );
}

$server_name = hostname;

$server_ip = inet_aton( $server_name );
( $server_ip ) or die( "Error: Failed to get hostname. Please try again! $!" );
$server_ip = inet_ntoa( $server_ip );

open (E,">> " . $stderr_path . $server_ip . ".error" );
*STDERR = *E;

_set_sdb_path( $sdb_path ) || die( "Can't set the SDB path: $!" );

my %server_lists = %{sdb_load("server_lists")};

$server_lists{$server_ip} = 1;
sdb_save(\%server_lists, "server_lists");

my %my_server_info = %{sdb_load( $server_ip )};
$my_server_info{"load_max"} = 2;
$my_server_info{"cpu_num"} = 2;
$my_server_info{"priority"} = 10;
$my_server_info{"pid"} = $$;
$my_server_info{"server_name"} = $server_name;
$my_server_info{"GLANG_HTACCESS"} = $htaccess_path;
$my_server_info{"GLANG_SDB_INFINITY"} = $sdb_path;

sdb_save(\%my_server_info, $server_ip);

# for child process, set SIGCHLD HANDLE
$SIG{CHLD} = \&sigchld;
# for finishing program, set SIGINT HANDLE
$SIG{INT} = \&sigint;
#}

MAIN:
{
    print "Server: $server_name ($server_ip)\n";
    my $listen_number = 10;
    my $port = 18817; #receiving port
    &options if defined( @ARGV );

    my $protonum;
    #get protocol number
    $protonum = getprotobyname("tcp") || &exit_program( "ERROR: getprotobyname(): $!" );
    
    # make socket
    socket ( SH, AF_INET, SOCK_STREAM, $protonum) || &exit_program( "ERROR: socket(): $!" );
    
    #socket option
    setsockopt( SH, SOL_SOCKET, SO_REUSEADDR, pack("l", 1 ) ) || &exit_program("ERROR: setsockopt(): $!" );
    
    #bind address to the socket
    bind ( SH, sockaddr_in( $port, INADDR_ANY ) ) || &exit_program( "ERROR: bind(): $!" );
    
    #prepare for the connection
    listen( SH, $listen_number ) || &exit_program( "ERROR: listen(): $!" ) ;
    
    #start connection
    my ( $client_addr, $pid, $portnum, $client_ip, $client_name );
    while(1){
	while( $client_addr = accept( CH, SH ) ){
	    #get information from conneting spot
	    ( $portnum, $client_ip ) = Socket::sockaddr_in( $client_addr );
	    $client_name = gethostbyaddr( $client_ip, AF_INET );
	    $client_ip = Socket::inet_ntoa( $client_ip );
	    
            # check the accession
	    unless ( scalar &check_access( $htaccess_path, $client_ip, $client_name ) ){
		printf "DENY %s :\n\t%s (%s) %s\n", scalar localtime(), $client_name, $client_ip;
		select( ( select(CH), $|=1 )[0] ) ;
		print CH "Error: You can't connect $server_name ($server_ip) from $client_name ($client_ip)\n";
		next;
	    }
	    
	    print CH "connection OK\n";
	    
	    my $pid = fork;
	    if ( $pid ){ # parent
		print "ACCEPT[$pid] "
		    , scalar localtime(), " :\t"
		    , $client_name, "(" 
		    , $client_ip, ")"
		    , ":$portnum\n";
		$CHILD{$pid} = time;
	    }
	    elsif( defined $pid ){ # child "pid = 0
		my $pid_child = $$;
		*STDOUT = *STDERR;
		open( STDIN, '<&CH' ) || die( "ERROR: open(STDIN, '<&CH'): $!" );
		open( STDERR, '>&CH' ) || die( "ERROR: open(STDERR, '>&CH' ): $!" );
		select( ( select(STDIN), $|=1 )[0] ) ;
#		select( ( select(STDOUT), $|=1 )[0] ) ;
		select( ( select(STDERR), $|=1 )[0] ) ;
		local $subroutine;
		my ( @returned, @array, $env_pwd, $localtime );
		my $flag = 0;
		while(1){
		    while(<STDIN>){
			if (/^client: ENDLINE/){
			    $flag++;
			    last;
			}
			# job acception
			elsif( /^client: STARTLINE/ ){			    
			    while(<STDIN>){
				if ( /^client: array data/ ){
				    while(<STDIN>){
					last if ( /^client: array data finished/ );
					chomp;
					@array = split( ':::' , $_ );
				    }
				}
				elsif( /^client: subroutine data/ ){
				    while(<STDIN>){
					chomp;
					last if ( /^client: subroutine data finished/ );
					$subroutine .= $_;
				    }
				}
				elsif( /^client: pwd data/ ){
				    while(<STDIN>){
					last if ( /^client: pwd data finished/ );
					chomp;
					$env_pwd = $_;
					chdir( $_ );
				    }
				}				    
				elsif( /^client: localtime/ ){
				    while(<STDIN>){
					last if (/^client: localtime data finished/ );
					chomp;
					$localtime = $_;
				    }
				    last;
				}
			    }
			}
			# update server's load data
			elsif( /^client: update server load information/ ){
			    &load_update();
			    print STDERR "server: ENDLINE\n";
			    exit 0;
			}
			# system function from a client
			elsif( /^client: command / ){
			    my $com = $_;
			    $com =~ s/client: command //g;
			    system( $com );
#			    eval( 'system("' . $com . '");' );
#			    print STDERR $@ if( $@ );
			    print STDERR "server: ENDLINE\n";
			    exit 0;
			}
		    }
		    last if( $flag );
		}
		print STDERR"\n";
#############################################################################
#		open( HOGE, sprintf( "> /home/haya/g-language/test/tmp/before_eval_%s_%d.txt", $server_ip, $$ ) );
#		foreach my $tmp (@array){
#		    print HOGE $tmp, "\n";
#		}
#		close HOGE;
#############################################################################
		$subroutine =~ s/backSN/\\n/g;
		$subroutine =~ s/S_ENV_PWD/$env_pwd/;
		$subroutine =~ s/S_LOCALTIME/$localtime/;
		$subroutine =~ s/S_SERVER_IP/$server_ip/;
		
#		my $hoge_counter;
#		while( $hoge_counter < 50 ){
#		    unshift( @array, "hoge" );
#		    $hoge_counter++;
#		}
		
		@returned = eval( $subroutine );
		print STDERR $@ if( $@ );
#############################################################################
#		open( HOGE, sprintf( "> /home/haya/g-language/test/tmp/after_eval_%s_%d.txt", $server_ip, $$ ) );
#		foreach my $tmp (@array){
#		    print HOGE $tmp, "\n";
#		}
#		close HOGE;
#############################################################################		    
		print STDERR "server: going to send data...\n";
		my $data = join(":::", @returned ); 
		$data =~ s/\\n/backSN/g;
		print STDERR $data, "\n";
		print STDERR "server: ENDLINE\n";
		
		exit 0;
	    }
	}
    }
    &exit_program( "ERROR: accept(): $!" );
}


sub exit_program{
    my $error = shift;
    print STDERR $error, "\n";;
    kill INT => $$;
}   

sub sigint{
    $SIG{INT} = \&sigint;
    my %server_lists = %{sdb_load("server_lists")};
    delete $server_lists{$server_ip};	
    sdb_save(\%server_lists, "server_lists");
    exit 0;
}

sub sigchld(){
    my $pid = wait;
    $SIG{CHLD} = \&sigchld;
    print "CLOSED[$pid] "
	, scalar localtime(), ' :  '
	, time - $CHILD{$pid} #print connection time
        , " sec.\n"  if( $pid > 0 );
    delete $CHILD{$pid};
}

sub options {
    # change server information of the database
    my $line = join( " ", @ARGV );
    my %my_server_info = %{sdb_load("$server_ip")};
    my $error = 0;
    if ( $line =~ /-l (\d+\.*\d*)/ ){
	$error = 1 if $1 <= 0;
	$my_server_info{"load_max"} = $1;
    }
    if ( $line =~ /-c (\d+)/ ){
	$error = 1 if $1 <= 0;
       	$my_server_info{"cpu_num"} = $1;
    }
    if ( $line =~ /-p (\d+)/ ){
	$error = 1 if ( $1 <= 0 || $1 > 10 );
	$my_server_info{"priority"} = $1;
    }
    if ($error ){
	print STDERR "ERROR: option error\n";
	kill INT => $$;
    }
    sdb_save( \%my_server_info, "$server_ip" );
}

sub load_update{ # update server's load information on the database
    #  should _set_sdb_path() before using this;
    my %my_server_info = %{sdb_load("$server_ip")};
    $my_server_info{"load_now"} = ( getload() )[0];
    sdb_save(\%my_server_info, "$server_ip");
}

sub check_access{ #return 1 if the connection is acceptable
    my ( $htaccess_file, $client_ip, $client_name ) = @_;
    open( FILE, $htaccess_file ) or &exit_program("Can't open file: $htaccess_file: $!\n");
    my $accept = 0;
    while(<FILE>){
	next if (/^\#/);
	if (/^deny\s+from\s+all/){
	    while(<FILE>){
		next if (/^\#/);		
		if (/^allow\s+from\s+(.+)\n/){
		    my $addr = $1;
		    $addr =~ s/ //g;
		    $accept = 1 if ( scalar &match_ip( $addr, $client_ip, $client_name ) );
		}
	    }
	}
	elsif (/^allow\s+from\s+all/){
	    $accept = 1;
	    while(<FILE>){
		next if (/^\#/);
		if (/^deny\s+from\s+(.+)\n/){
		    my $addr = $1;
		    $addr =~ s/ //g;
		    $accept = 0 if ( scalar &match_ip( $addr, $client_ip, $client_name ) );
		}
	    }
	}
    }
    close FILE;
    return $accept;
}


sub match_ip{ #return 1 if $addr matches $client_ip
    my ( $addr, $client_ip, $client_name ) = @_;
    $addr =~ s/\s+//g;
    if ($addr =~ /^\.\w/){
	return 1 if ( $client_name =~ /$addr$/ );
    }
    elsif( $addr =~ /^(\d+\.\d+\.\d+\.\d+)\/(\d+)/ ){
	my $add_num = 2 ** $2 - 1;
	my $ip = new Net::IP( $1."+".$add_num ) or &exit_program ( "Net::IP::Error(): $!" );
	my $ip2 = new Net::IP ( $client_ip ) or &exit_program( "Net::IP::Error(): $!" );
	
	return 1 if ( $ip->overlaps($ip2) == $IP_B_IN_A_OVERLAP or
		      $ip->overlaps($ip2) == $IP_IDENTICAL );
    }
    else{
	my $ip = new Net::IP( $addr ) or &exit_program( "Net::IP::Error(): $!" );
	my $ip2 = new Net::IP( $client_ip ) or &exit_program ( "Net::IP::Error():$!" );
	return 1 if ( $ip->overlaps($ip2) == $IP_B_IN_A_OVERLAP or
		      $ip->overlaps($ip2) == $IP_IDENTICAL or
		      $addr eq $client_name );
    }
}

