CodeDogg

#! /usr/bin/perl -w

use strict;

use Socket;

use constant SIMPLE_TCP_PORT => 4001;

use constant MAX_RECV_LEN => 65536;

my $local_port = shift || SIMPLE_TCP_PORT;

my $trans_serv = getprotobyname( 'tcp' );

my $local_addr = sockaddr_in( $local_port, INADDR_ANY );

socket( TCP_SOCK, PF_INET, SOCK_STREAM, $trans_serv )

or die "tcp_s1: socket creation failed: $! ";

setsockopt( TCP_SOCK, SOL_SOCKET, SO_REUSEADDR, 1 )

or warn "tcp_s1: could not set socket option: $! ";

bind( TCP_SOCK, $local_addr )

or die "tcp_s1: bind to address failed: $! ";

listen( TCP_SOCK, SOMAXCONN )

or die "tcp_s1: listen couldn't: $! ";

warn "Server starting up on port: $local_port. ";

my $from_who;

while ( $from_who = accept( CLIENT_SOCK, TCP_SOCK ) )

{

my $data;

$from_who = recv CLIENT_SOCK, $data, MAX_RECV_LEN, 0 ;

if ( $from_who )

{

my ( $the_port, $the_ip ) = sockaddr_in( $from_who );

my $remote_name = gethostbyaddr( $the_ip, AF_INET );

warn "Received from $remote_name: ", length( $data ),

' -> ', substr( $data, 0, 39 ), " ";

}

else

{

warn "tcp_s1: problem with recv:slkdj $! ";

next;

}

sleep( 3 );

warn "Sending back to client ... ";

send( CLIENT_SOCK, $data, 0 )

or warn "tcp_s1: problem with send: $! ";

}

continue {

close CLIENT_SOCK

or warn "tcp_s1: close failed: $! ";

}

close TCP_SOCK;