Ok, I based this code on an example I found somewhere, and it seems to work pretty well. The script is supposed to do this:
This works well. The problem is that if the client kills his (or her) telnet session abruptly, the proxy children don't ever die, they just go into a 'busy wait' state where they consume 100% of the processor, and the TCP connections show CLOSE_WAIT. I'm at a loss to explain this, and have no idea how to fix it. I'm sure it has something to do with the use of a while (recv) to read data, but I don't know what the alternatives are, or how to prevent them. A simple ALRM won't work because I can't set an artificial limit on the length of sessions.
I'd really appreciate any help you can offer. Thanks.
#!/usr/bin/perl --
# telnet_proxy_daemon
# (C) 2002 Netreo Inc, All rights reserved
my $VERSION = "0.0.2 - 14 Oct 2002";
setpriority 0, 0, +10;
#use strict; # require declarations
use DBI;
use Getopt::Long; # for option processing
use Net::hostent; # by-name interface for host info
use IO::Socket; # for creating server and client sockets
use POSIX ":sys_wait_h"; # for reaping our dead children
# Install signal handlers
local $SIG{HUP} = 'IGNORE';
local $SIG{QUIT} = \&GotSignal;
local $SIG{INT} = \&GotSignal;
local $SIG{TERM} = \&GotSignal;
my (
%Children, # hash of outstanding child processes
$REMOTE, # whom we connect to on the outside
$LOCAL, # where we listen to on the inside
$proxy_server, # the socket we accept() from
$ME, # basename of this program
);
($ME = $0) =~ s,.*/,,; # retain just basename of script name
my %state_table = ( 0 => 'Disconnect',
1 => 'Connect',
2 => 'Login_OK',
3 => 'Telnet_OK',
4 => 'AUTH_FAIL',
5 => 'Telnet_fail',
6 => 'Max Conns Reachd',
);
my $current_sess = 0;
check_args(); # processing switches
print "[[ Telnet Proxy Daemon version $VERSION - Starting ]]\n" if
+ $debug;
my $dbh = DBI->connect ( "DBI:mysql:xxx:localhost", "xxx", "xxx",
+{RaiseError =>0, AutoCommit =>1} ) || die "Database failure! $!\n";
my $dbh_log = DBI->connect ( "DBI:mysql:xxx:localhost", "xxx", "xx
+x", {RaiseError =>0, AutoCommit =>1} ) || die "Database failure! $!\n
+";
print "[Connected to database...]\n" if $debug;
start_proxy(); # launch our own server
service_clients(); # wait for incoming
die "FATAL ERROR! $!"; # you can't get here from there
# process command line switches using the extended
# version of the getopts library.
sub check_args {
GetOptions(
"local=s" => \$LOCAL,
"debug" => \$debug,
"maxconns:i" => \$max_sess,
) or die <<EOUSAGE;
usage: $0 [ --local=ip ] [ --maxconns=# ] [ --debug ]
EOUSAGE
$max_sess ||= 10;
}
# begin our server
sub start_proxy {
my @proxy_server_config = (
Proto => 'tcp',
Reuse => 1,
Listen => SOMAXCONN,
LocalPort => 2323,
);
push @proxy_server_config, LocalAddr => $LOCAL if $LOCAL;
$proxy_server = IO::Socket::INET->new(@proxy_server_config)
or die "can't create proxy server: $@";
print "[Proxy server initialized (max conns: $max_sess)]\n" if $de
+bug;
}
sub service_clients {
my (
$local_client, # someone internal wanting out
$lc_info, # local client's name/port informa
+tion
$remote_server, # the socket for escaping out
@rs_config, # temp array for remote socket opt
+ions
$rs_info, # remote server's name/port inform
+ation
$kidpid, # spawned child for each connectio
+n
);
$SIG{CHLD} = \&REAPER; # harvest the moribund
accepting();
# an accepted connection here means someone inside wants out
while ($local_client = $proxy_server->accept()) {
$current_sess ++;
print $local_client "PRESS ENTER> ";
my $foo = <$local_client>;
undef $foo;
if ($current_sess > $max_sess)
{ printf "[Denied connection from $lc_info: Maximum sessions
+ exceeded]\n" if $debug;
print $local_client "\n\nMaximum sessions exceeded.\n\n";
close $local_client;
$current_sess --;
log_info(6,'',$lc_info,'');
next;
}
$lc_info = peerinfo($local_client);
set_state("servicing local $lc_info");
printf "[Connect from $lc_info]\n" if $debug;
log_info(1,'',$lc_info,''); # Record connection attempt
# Authenticate the local client and then ask him where he want
+s to go
print $local_client "login> ";
my $un = <$local_client>;
my ($user) = $un =~ /^(\w+)\r?\n?$/;
print $local_client "passwd> ";
my $pw = <$local_client>;
my ($pass) = $pw =~ /^(\w+)\r?\n?$/;
my ($dbpw) = $dbh->selectrow_array("SELECT password from users
+ where username = '$user'");
printf "[Got login from $user.]\n" if $debug;
unless (defined $dbpw and $pass eq $dbpw) { log_info(4,$user,$
+lc_info,''); printf "[Login failure for $user ($pass/$dbpw)]\n" if $d
+ebug; print $local_client "Invalid.\n"; close $local_client; $current
+_sess --; next; }
# log_info(2,$user,$lc_info,''); # Record good login
print $local_client "telnet>> ";
my $rem = <$local_client>;
my ($REMOTE) = $rem =~ /^([\d\.]+)\r?\n?$/;
unless ($REMOTE
&& $REMOTE =~ /^[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0
+-9]{1,3}$/
&& !grep { $_ < 0 || $_ > 255 } split(/\./, $REMOTE) )
+
{ print $local_client "Invalid address.\n"; close $local_cl
+ient; $current_sess --; next;}
@rs_config = (
Proto => 'tcp',
PeerAddr => $REMOTE,
PeerPort => 23,
);
print "[$user asked for connection to $REMOTE..." if $debug;
set_state("connecting to $REMOTE"); # see belo
+w
unless ($remote_server = IO::Socket::INET->new(@rs_config))
{ # The connection attempt failed
log_info(5,$user,$lc_info,"$REMOTE:23"); # Log telnet fail
+ure
my ($err) = $@ =~ /IO::Socket::INET: (.*)$/;
print "remote server: $@\n";
print $local_client "Connection error: $err\n";
close $local_client;
$current_sess --;
next;
}
print "done]\n" if $debug;
$rs_info = peerinfo($remote_server);
log_info(3,$user,$lc_info,$rs_info); # Log telnet success
set_state("connected to $rs_info");
$kidpid = fork();
die "Cannot fork" unless defined $kidpid;
if ($kidpid) {
$Children{$kidpid} = time(); # remember his sta
+rt time
close $remote_server; # no use to master
close $local_client; # likewise
next; # go get another c
+lient
}
# at this point, we are the forked child process dedicated
# to the incoming client. but we want a twin to make i/o
# easier.
close $proxy_server; # no use to slave
$kidpid = fork();
die "Cannot fork" unless defined $kidpid;
# now each twin sits around and ferries bytes of data.
# see how simple the algorithm is when you can have
# multiple threads of control?
# this is the fork's parent, the master's child
if ($kidpid) {
set_state("$rs_info --> $lc_info");
select($local_client); $| = 1;
while (recv ($remote_server,$e,1,0)) { print $e; };
+
log_info(0,$user,$lc_info,$rs_info); # Log disconnect
+
kill('TERM', $kidpid); # kill my twin cause we're don
+e
}
# this is the fork's child, the master's grandchild
else {
set_state("$rs_info <-- $lc_info");
select($remote_server); $| = 1;
while (recv ($local_client,$e,1,0)) { print $e; };
print STDOUT "Exiting: $lc_info -> $rs_info\n" if $debug;
kill('TERM', getppid()); # kill my twin cause we're don
+e
}
exit; # whoever's still alive bites
+it
} continue {
accepting();
}
}
# helper function to produce a nice string in the form HOST:PORT
sub peerinfo {
my $sock = shift;
#my $hostinfo = gethostbyaddr($sock->peeraddr);
return sprintf("%s:%s",
$sock->peerhost,
$sock->peerport);
}
# reset our $0, which on some systems make "ps" report
# something interesting: the string we set $0 to!
sub set_state { $0 = "$ME [@_]" }
# helper function to call set_state
sub accepting {
set_state("accepting proxy connections");
}
# somebody just died. keep harvesting the dead until
# we run out of them. check how long they ran.
sub REAPER {
my $child;
my $start;
while (($child = waitpid(-1,WNOHANG)) > 0) {
if ($start = $Children{$child}) {
my $runtime = time() - $start;
printf "Child $child ran %dm%ss\n",
$runtime / 60, $runtime % 60 if $debug;
+
delete $Children{$child};
$current_sess --;
} else {
print "Connection closed.\n";
$current_sess --;
}
}
# If I had to choose between System V and 4.2, I'd resign. --Peter
+ Honeyman
$SIG{CHLD} = \&REAPER;
};
sub GotSignal
{
my $sig = shift;
print STDERR "Caught a $sig signal, exiting cleanly...\n" if $debu
+g;
$dbh->disconnect() if defined $dbh;
$dbh_log->disconnect() if defined $dbh_log;
sleep 1;
exit(0);
}
sub log_info ($$$$)
{
my $type = shift;
my $type_descr = $state_table{$type};
my $user = shift;
my $lcinfo = shift;
my ($s_ip,$s_po) = $lcinfo =~ /^([\d\.]+):(\d+)$/;
my $rsinfo = shift;
my ($d_ip,$d_po) = $rsinfo =~ /^([\d\.]+):(\d+)$/;
my $timenow = time();
print STDERR "> LOG $timenow: $type ($type_descr)\t$user\tS $s_ip
+: $s_po | D $d_ip : $d_po\n" if $debug;
$dbh_log->do("INSERT into telnet_proxy_log (user, type, type_desc,
+ source_ip, source_port, dest_ip, dest_port, timestamp) values (?,?,?
+,?,?,?,?,?)",
undef,$user,$type,$type_descr,$s_ip,$s_po,$d_ip,$d_po,
+$timenow);
return(0);
}
"Non sequitur. Your facts are un-coordinated." - Nomad