#!/usr/bin/perl

#   Copyright (c) Peter Kirk <pwkDOTlinuxfanATgmxDOTde>, 2003
#
#   This program is free software;  you can redistribute it and/or modify
#   it under the terms of the GNU General Public License version 2 as 
#   published by the Free Software Foundation.
#  
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY;  without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See
#   the GNU General Public License for more details.
#  
#   You should have received a copy of the GNU General Public License
#   along with this program;  if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

use IO::Socket;
use IO::Select;
use IO::File;
use Socket;

sub POE::Kernel::ASSERT_DEFAULT () { 1 }
use POE qw(Component::Server::TCP);
use POSIX 'setsid';
use warnings;
use strict;
use diagnostics;
use POSIX ":sys_wait_h";
use lib "modules";
use Tcpquery;

use Data::Dumper;

use constant PROMPTED_FOR_USER_AND_PASS => 1;
use constant PROMPTED_FOR_SERVER_AND_PORT => 2; 
use constant READY_FOR_COMMANDS => 3;
use constant GETTING_SERVERANSWER => 4;

my $DEBUG = 1;
my $DAEMONIZE = 0;
my $DIRTY_IPCHANGE_HACK = 0;
my $PASSWORD = ""; #dont change these here, change them in the config file
my $USERNAME = "";
my $PORT;
my $SERVER_TIMEOUT = 50;

my %connection_database = (); #contains the sockets hash{servername}{port} = [ [socket1, used_by], [ socket2, used_by] ]
my %connection_used = (); # servername and port and connection nr in a array indexed by ID
my %connection_state = (); #strings for each id describing the state of the connection
my $ip = "";

my $config_socket = IO::File->new(qq(etc/tcpquery.conf));
if (!$config_socket)
{
	print warn "couldnt open \"tcpquery.conf\" : $! \n";
	exit(1);
}
while(<$config_socket>)
{
	$PASSWORD = $1 if(/^pass\s*=\s*(\S+)\s*$/);
	$USERNAME = $1 if(/^loginname\s*=\s*(\S+)\s*$/);
	$PORT = $1 if(/^localredirectport\s*=\s*(\d+)\s*$/);
}
die "error parsing config file...\n" unless($PASSWORD && $USERNAME && $PORT);

if($DIRTY_IPCHANGE_HACK && `/sbin/ifconfig ppp0 | grep inet` =~ /inet addr:(\d{1,3}.\d{1,3}.\d{1,3}.\d{1,3})\s/)
{
	$ip = $1;
	print "We have detected connections to be bound to $ip\n" if $DEBUG;
}
if($DAEMONIZE)
{
	daemonize();
}

POE::Component::Server::TCP->new (
	Alias => "wittyperlserver",
	Port => $PORT,
	Address  => 'localhost',
	ClientInput => \&child_input,
	ClientConnected => \&child_connect,
	ClientDisconnected => \&child_disconnect,
	ClientError => \&child_error,
	InlineStates =>
	{
		handle_serveranswer => \&handle_serveranswer,
		timeout_on_serveranswer => \&timeout_on_serveranswer
	} );


print "[tcpquery-redirection-server accepting clients]\n" if $DEBUG;
$poe_kernel->run();
exit 0;

sub child_connect
{
	my ( $kernel, $session, $heap, $input ) = @_[ KERNEL, SESSION, HEAP, ARG0 ];
	my $id = $session->ID();
	$heap->{client}->put("Welcome to the tcpquery-redirection-server");
	print "$id>printed welcome\n" if $DEBUG;
	$connection_state{$id} = PROMPTED_FOR_USER_AND_PASS;
	$heap->{client}->put("Username Password (seperated by space)");
	print "$id>prompted for username and password\n" if $DEBUG;
	return;
}

sub child_input
{
	my ( $kernel, $session, $heap, $input ) = @_[ KERNEL, SESSION, HEAP, ARG0 ];
	my $id = $session->ID();
	
	if($connection_state{$id} == PROMPTED_FOR_USER_AND_PASS)
	{
		unless($input =~ /^$USERNAME\s+$PASSWORD\s*$/)
		{
			print "$id>Wrong username/password\n" if $DEBUG;
			$heap->{client}->put("Wrong username/password");
			$kernel->yield('shutdown');	
			return 0;
		}
		$heap->{client}->put("Server:Port");
		print "$id>prompted for server and port\n" if $DEBUG;
		$connection_state{$id} = PROMPTED_FOR_SERVER_AND_PORT;
	}
	elsif($connection_state{$id} == PROMPTED_FOR_SERVER_AND_PORT)
	{
		my $server = "";
		my $port = 0;
		my $socket = 0;
		unless($input =~ /^(\S+):(\d+)$/)
		{
			print "$id>Bad server:port syntax\n" if $DEBUG;
			$heap->{client}->put("Bad server/port syntax");
			$kernel->yield('shutdown');
			return 0;
		}
		else
		{
			$heap->{client}->put("OK, logged in successfuly");
			print "$id>OK, the user logged in...\n" if $DEBUG;
			($server, $port) = ($1, $2);
			if(need_server_socket($server, $port, $id) =~ /^(Error.*)$/)
			{
				print "$id>We got a problem getting a socket: $1\n";
				$heap->{client}->put($1);
				$kernel->yield('shutdown');
				return 0;
			}
			$connection_state{$id} = READY_FOR_COMMANDS;
		}
	}
	elsif($connection_state{$id} == READY_FOR_COMMANDS)
	{
		my $client_command = $input;
		my $sock = ${$connection_used{$id}[3]};
		print "$id>$client_command\n" if $DEBUG;
		if($client_command =~ /^quit\s*/)
		{
			$kernel->yield('shutdown');
			return 0;
		}
		elsif($client_command =~ /^sel\s+(\d+)\s*$/ || $client_command =~ /^server\s+([\w\.]+)\s*/ || !$sock)
		{
			my $placeholder = $1 unless(!$sock);
			my ($server, $port) = ($connection_used{$id}[0], $connection_used{$id}[1]);
			print "We are switching from $server:$port to \n" if $DEBUG;
			$server = $placeholder if($client_command =~ /^server/);
			$port = $placeholder if($client_command =~ /^sel/);
			$port = 0 if($client_command =~ /^server/);
			print "$server:$port\n" if $DEBUG;
			if(need_server_socket($server, $port, $id, "old=clean") =~ /^(Error.*)$/)
			{
				print "$id>We got a problem getting a socket: $1\n";
				$heap->{client}->put($1);
				$kernel->yield('shutdown');
				return 0;
			}
			$sock = ${$connection_used{$id}[3]};
			delete $heap->{wheel} if(exists($heap->{wheel}));
			$heap->{client}->put("OK");
		}
		elsif($sock)
		{
			unless(exists($heap->{wheel}))
			{
				$heap->{wheel}  = POE::Wheel::ReadWrite->new(
					Handle => $sock,
					InputEvent   => 'handle_serveranswer',
					ErrorEvent   => 'timeout_on_serveranswer' );
			}
			$heap->{wheel}->put($client_command);
			$connection_state{$id} = GETTING_SERVERANSWER;
			$heap->{'client_command'} = $client_command;
			$heap->{'is_retry'} = 0;
			$kernel->alarm('timeout_on_serveranswer', time() + $SERVER_TIMEOUT);
		}
		else
		{
			die "Die annother day for meeeeee\n";
		}
	}
	elsif($connection_state{$id} == GETTING_SERVERANSWER)
	{
		$heap->{client}->put("We are currently occupied answering a request...");
	}
	else
	{
		die "We should not have come here...\n";
	}
}

sub handle_serveranswer
{
	my ( $kernel, $session, $heap, $server_answer, $wheel_id ) = @_[ KERNEL, SESSION, HEAP, ARG0, ARG1 ];
	my $id = $session->ID();
	$kernel->alarm('timeout_on_serveranswer');
	$heap->{is_retry} = 0;
	
	print "$id<$server_answer\n" if $DEBUG;
	$heap->{client}->put($server_answer);
	if($server_answer =~ /^OK\s*$/)
	{
		$connection_state{$id} = READY_FOR_COMMANDS;
	}
	elsif($server_answer =~ /^error/i)
	{
		$connection_state{$id} = READY_FOR_COMMANDS;
	}
	else
	{
		$kernel->alarm('timeout_on_serveranswer', time() + $SERVER_TIMEOUT);
	}

}

sub timeout_on_serveranswer
{
	my ( $kernel, $session, $heap ) = @_[ KERNEL, SESSION, HEAP ];
	my $id = $session->ID();
	$kernel->alarm('timeout_on_serveranswer');
	if($heap->{'is_retry'} >= 2)
	{
		print "$id>No good connection even after relogins...aborting.\n";
		$heap->{client}->put("Error during reconnect/login");
		$kernel->yield('shutdown');
	}
	else
	{
		print "$id>Server timed out...reconnecting\n" if $DEBUG;
		if(!defined $connection_used{$id})
		{
			die "$id>it seems that connection_used does not contain id?";
		}
		my ($server, $port) = ($connection_used{$id}[0], $connection_used{$id}[1]);
		if(need_server_socket($server, $port, $id) =~ /^(Error.*)$/)
		{
			print "$id>We got a problem getting a socket: $1\n";
			$heap->{client}->put($1);
			$kernel->yield('shutdown');
		}
		else
		{
			delete $heap->{wheel};
			my $sock = ${$connection_used{$id}[3]};
			$heap->{wheel}  = POE::Wheel::ReadWrite->new(
				Handle => $sock,
				InputEvent   => 'handle_serveranswer',
				ErrorEvent   => 'timeout_on_serveranswer' );
			$heap->{client}->put("Error during reconnect/login") unless $sock;
			$heap->{wheel}->put($heap->{'client_command'});
			$heap->{'is_retry'}++;
			$kernel->alarm('timeout_on_serveranswer', time() + $SERVER_TIMEOUT);
		}
	}
}


sub child_disconnect
{
	my ( $session, $heap, $input ) = @_[ SESSION, HEAP, ARG0 ];
	my $id = $session->ID();
	print "$id>Closing connection\n" if $DEBUG;
	delete $connection_state{$id};
	if(exists($connection_used{$id}))
	{
		my ($servername, $port, $connection_nr) = @{$connection_used{$id}};
		delete $connection_used{$id};
		$connection_database{$servername}{$port}[$connection_nr][1] = 0;
		print "$id>Marked connection to $servername:$port#$connection_nr as unused\n" if $DEBUG;
	}
	else
	{
		print "No connection to mark unused\n" if $DEBUG;
	}
	if(exists($heap->{wheel}))
	{
		delete $heap->{wheel};
	}
}

sub child_error
{
	my ( $kernel, $session, $heap, $input ) = @_[ KERNEL, SESSION, HEAP, ARG0 ];
	my $id = $session->ID();
	$kernel->alarm('timeout_on_serveranswer');
	print "Error in connection with ID ", $id, "\n" if $DEBUG;
	delete $connection_state{$id};
	if(exists($connection_used{$id}))
	{
		my ($servername, $port, $connection_nr) = @{$connection_used{$id}};
		delete $connection_used{$id};
		$connection_database{$servername}{$port}[$connection_nr][1] = -1;
		print "$id>Marked connection to $servername:$port#$connection_nr as dirty\n" if $DEBUG;
	}
	else
	{
		print "No connection to mark dirty\n" if $DEBUG;
	}
	if(exists($heap->{wheel}))
	{
		delete $heap->{wheel};
	}
	return;
}

sub shutdown 
{
    my ( $kernel, $session, $heap ) = @_[ KERNEL, SESSION, HEAP ];
	my $id = $session->ID();
	print "$id> Shutting down connection...\n";
    # delete all wheels.
    delete $heap->{wheel};
    # clear your alias
    $kernel->alias_remove( $heap->{alias} );
    # clear all alarms you might have set
    $kernel->alarm_remove_all();
    # get rid of external ref count
    $kernel->refcount_decrement( $session, 'my ref name' );
    # propagate the message to children
    $kernel->post( $heap->{child_session}, 'shutdown' );
    return;
}


sub need_server_socket
{#the forth parameter describes if the old connection is still clean
	if(@_ < 3 || @_ > 4)
	{
		die "Wrong parameter count for need_server_socket ... we want 3 or 4 parameters (servername, port used ID and [bool clean_old])\n"
	}
	if((!defined $_[0]) || $_[0] !~ /^[\w\.]+$/)
	{
		return "Error, bad format of servername\n";
	}
	elsif((!defined $_[1]) || $_[1] !~ /^\d+$/)
	{
		return "Error, bad format of port\n";
	}
	elsif((!defined $_[2]) || $_[2] !~ /^\d+$/)
	{
		return "Error, bad format of used_ID\n";
	}
	my $servername = $_[0];
	my $port = $_[1];
	my $used_ID = $_[2];
	my $return_sock = 0;
	my $connection_nr = -1;
	
	if($ip)
	{
		if(`/sbin/ifconfig ppp0 | grep inet` =~ /inet addr:(\d{1,3}.\d{1,3}.\d{1,3}.\d{1,3})\s/)
		{
			unless($ip eq $1)
			{
				print "IP changed ? From $ip to $1" if $DEBUG;
				%connection_database = ();
				$ip = $1;
			}
		}
	}
	if($port == 0) #We should find out the default port and use that
	{
		if(my $configsock = IO::File->new("etc/tcpquery.conf.".$servername))
		{
			while(<$configsock>)
			{
				$port = $1 if(/^server-port\s*=\s*(\d+)\s*$/);
			}
			unless($port > 0)
			{
				return "Error in server config file...could not find default port\n";
			}
		}
		else #no such config file for server
		{
			return "Error, server unknown (no configfile for it!\n";
		}
	}
	if(exists($connection_used{$used_ID}))
	{
		my $oldserver = $connection_used{$used_ID}[0];
		my $oldport = $connection_used{$used_ID}[1];
		my $oldconnr = $connection_used{$used_ID}[2];
		if(@_ == 3) #dirty old connection
		{
			$connection_database{$oldserver}{$oldport}[$oldconnr][1] = -1;
		}
		elsif(@_ == 4) #clean old connection
		{
			$connection_database{$oldserver}{$oldport}[$oldconnr][1] = 0;
		}
	}
	if(exists($connection_database{$servername}))
	{
		if(exists($connection_database{$servername}{$port}))
		{
			foreach my $connection ( @{$connection_database{$servername}{$port} } ) #Searching for a connection to use
			{
				$connection_nr++;
				if($connection->[1] == 0) #found a unused connection
				{
					$connection->[1] = 1;
					$return_sock = $connection->[0];
					my $sel = new IO::Select($return_sock);
					if($sel->can_read(0))
					{
						print "$used_ID>Discovered unclean connection from $servername:$port - deleting\n" if $DEBUG;
						$connection->[1] = -1; #mark unclean
						$return_sock = 0;
					}
					last if $return_sock;
				}
			}
		}
	}
	# We need to make a new connection
	if($return_sock == 0)
	{
		if(my $configsock = IO::File->new("etc/tcpquery.conf.".$servername))
		{
			$return_sock = Tcpquery::server_login($servername, $port);
			unless($return_sock)
			{
				return "Error, couldnt open connection to remote TS Server\n";
			}
			unless(exists($connection_database{$servername}))
			{
				$connection_database{$servername} = {};
			}
			unless(exists($connection_database{$servername}{$port}))
			{
				$connection_database{$servername}{$port} = ();
			}
			push @{$connection_database{$servername}{$port}}, [ $return_sock, 1 ];
			$connection_nr = $#{$connection_database{$servername}{$port}};
			print "$used_ID>Opened a new connection to $servername:$port\n" if $DEBUG;
		}
		else #no such config file for server
		{
			return "Error, server unknown (no configfile for it!\n";
		}
	}
	$connection_used{$used_ID} = [ $servername, $port, $connection_nr, \$return_sock ];
	return 0;
}

sub session_started
{

}

sub daemonize 
{
	open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
	open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!";
	defined(my $pid = fork) or die "Can't fork: $!";
	exit if $pid;
	setsid or die "Can't start a new session: $!";
    open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
}