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);
}
[download]