## my server
## 2010.03.05

#!/usr/bin/perl -w

use strict;
use IO::Socket;
use threads;
use threads::shared;
##use POSIX 'WNOHANG'; # for SIGNAL
use constant BUFSIZE => 1024;


our %clients:shared;
my( $addr, $port );


$addr = &get_ip(); # get IP from interface

## get port
print "enter port: ";
while( <STDIN> ) {
        chomp($_);
        $port = $_;
        if ( /[0-9]{4,5}/ && $_ > 1024 ) { last; }
        print "either wrong value or port is deny, enter new value: ";
}

my $server = IO::Socket::INET -> new( LocalAddr => $addr,
                                        LocalPort => $port,
                                        Listen => 255,
                                        Type => SOCK_STREAM,
                                        Proto => 'tcp',
                                        Reuse => 1 );
die "can't create, bind or listen: $!\n" unless $server ;
print "socket OK\n bind OK\n listen OK\n Server started at $addr:$port\n";
warn "Server ready. Waiting for connections... \n";

threads -> create( \&to_client ) || die "$! \n"; # STDIN

## start threads to treat querys
while( my $client = $server -> accept ) {
        my $client_ip = $client -> peerhost();
        my $client_port = $client -> peerport();

        $clients{ "$client_ip:$client_port" } = fileno( $client ); # add new socket to %client

        print "got a connection from: $client_ip:$client_port $client\n";
        $client -> autoflush;

        threads -> create( \&from_client, $client, $client_ip, $client_port ) || die "$! \n"; #STDOUT

}
exit 0;


## ******************************************************
## get local machine IP from interface
sub get_ip {
        my ($name, $aliases, $addrtype, $length, @addrs) = gethostbyname( 'localhost' );
        my ($name1, $aliases1, $addrtype1, $length1, @addrs1) = gethostbyname( $name );
        my $addr1 = inet_ntoa( $addrs1[0] );
        return $addr1;
}

## ******************************************************
## send message to client or see list of client
sub to_client {
        my ( $clnt_ip_port, $msg_t, $tmp );

        while( sysread(STDIN, $tmp, BUFSIZE) ) {
                chomp $tmp;
                if( $tmp eq "list" ) {
                        print "connect to this server:\n";
                        foreach my $z ( keys %clients ) { print "client: $z  $clients{$z}\n"; }
                }
                elsif ( $tmp =~ /\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}:\d{4,5}\s.*/ ) {
                        ( $clnt_ip_port, $msg_t ) = ( $tmp =~ /(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}:\d{4,5})\s(.*)/ );
                        if ( exists $clients{$clnt_ip_port} ) {
                                ## try to send message
                                my $client;
                                my $fileno = $clients{$clnt_ip_port};
                                open $client, "+<$fileno" || die "$!\n";
##print "syswrite $clients{$clnt_ip_port} {$msg_t} \n";
                                syswrite( $client, $msg_t ) || die ": $!\n";
                        } else { print "don't exist client or empty message!\n"; }
                } else { print "wrong value, check and see \"list\" of clients!\n"; }
        }
}


## ******************************************************
## recive message from client
sub from_client {
        my ( $sock, $clnt_ip, $clnt_port ) = @_;;
        my $msg_f;

        syswrite( STDOUT, "from $clnt_ip:$clnt_port: $msg_f" ) while sysread( $sock, $msg_f, BUFSIZE );
        print "client at $clnt_ip:$clnt_port closed connection \n";
        delete $clients{"$clnt_ip:$clnt_port"}; # delete socket from %client

        $sock -> close;
}



##</code><code>##

enter port: 1234
socket OK
 bind OK
 listen OK
 Server started at 127.0.0.1:1234
Server ready. Waiting for connections... 
got a connection from: 127.0.0.1:37725 IO::Socket::INET=GLOB(0x8d1ea38)
list
connect to this server:
client: 127.0.0.1:37725  5
127.0.0.1:37725 qwerty
Thread 1 terminated abnormally: : Bad file descriptor