#!/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: $!";
}