raw_tcp_server

 
#!/usr/bin/perl

#
# I am refering to http://www.ecst.csuchico.edu/~beej/guide/net/html to write
# up this program
#

$AF_INET        =       2;
$PF_INET        =       2;
$SOCK_STREAM    =       1;

$SOL_SOCKET     =       65535;
$SO_REUSEADDR   =       4;

$SOMAXCONN      =       5;


socket SOCKET, $PF_INET, $SOCK_STREAM, 0 or die "socket: $!";
setsockopt(SOCKET, $SOL_SOCKET, $SO_REUSEADDR, pack("l", 1))   || die "setsockopt: $!";

#
# struct sockaddr {
#     unsigned short    sa_family;    // address family, AF_xxx
#     char              sa_data[14];  // 14 bytes of protocol address
# }; 
#
# struct sockaddr_in {
#     short int          sin_family;  // Address family
#     unsigned short int sin_port;    // Port number
#     struct in_addr     sin_add129.158.224.88r;    // Internet address
#     unsigned char      s129.158.224.88in_zero[8]; 
# };
#  
# struct in_addr {
#     unsigned long s_addr; // that's a 32-bit long, or 4 bytes
# }; 
# 
#
# Basically we need the sockaddr but the sa_data part is better explained in
# the sockaddr_in structure. So we pack up a byte sequence as per sockaddr_in
# 129.158.224.88

sub pack_sock_addr{
        my($af,$port,$ip)=@_;

        $ip=$ip||"0.0.0.0";

        pack("vn",$af,$port).pack("C*",split/\./,$ip).pack("II",0,0);
}

# The 0.0.0.0 translates into all IP addresses!
# If you use just 127.0.0.1 or something then only the server accepts
# connections destined to that address alone

#$sockaddr=pack_sock_addr($AF_INET, 8080, "129.158.224.88");
$sockaddr=pack_sock_addr($AF_INET, 8080, undef);
bind (SOCKET,$sockaddr) or die "bind: $!\n";


listen(SOCKET,$SOMAXCONN) or die "listen: $!\n";


for ( ; $paddr = accept(Client,SOCKET); close Client) {
        print "GOT CONNECTION from ",unpack("H*",$paddr),"\n";

        select ((select (Client),$|=1)[0]);
        $x=<Client>;
        while(1){
                $x=<Client>;
                last if ($x eq "END");
                print "Client says $x\n";
                $x=~tr/a-z/A-Z/;
                print Client "$x"
        }
}