Hi!
Below - the actual server code.
Here is the explanation and the problem.
I am writing a TCP multiplexing server which,
when user connects, forks and the sends ever
5 seconds a message to the client and also listen
to what client send to server and does something.
In order not to waste CPU time and have server do
something usufull (like calculating something) i tried
handling SIGIO, so, when data is available on incoming
connection i handle and when there is no data, server
does its own job. However, it figures, that when i added
fcntl(STDIN, F_SETFL, O_ASYNC|O_NONBLOCK);
sleep(5) stopped working right. It does not wait for 5 seconds
any longer, but actually for about 1/3 second and fully ignores
the sleep time a specify (you can run the server and connect to
it using telnet and see for yourself). I could not find any info
on sleep (SIGALRM) messing with SIGIO and O_ASYNC
mode. Any ideas what's going on and how to fix this?
Best regards,
Artem
# CODE!!!!!!
#!/usr/bin/perl
use strict;
use POSIX;
use Socket;
use Fcntl;
sub spawn;
my $server_port=9871;
my $server_protocol=getprotobyname('tcp');
socket(Server, PF_INET, SOCK_STREAM, $server_protocol) || die "Socket:
$!\n";
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l",1)) || die
"setsockopt: $!\n";
bind(Server, sockaddr_in($server_port,INADDR_ANY)) || die "Bind: $!\n";
listen(Server, SOMAXCONN) || die "Listed: $!\n";
warn "Server started on port $server_port!\n";
my $waitedpid = 0;
my $paddr;
sub REAPER {
$waitedpid=wait;
$SIG{CHLD}=\&REAPER;
warn "reaped $waitedpid" . ($? ? " with exit $?" : '')."\n";
}
my $buf;
sub INCOMING {
# see if anythinhg is waiting in the IN queue
my ($rin,$win,$ein);
$rin=$win=$ein='';
vec($rin,fileno(STDIN),1)=1;
$ein=$rin|$win;
my ($aa,$bb)=select($rin,$win,$ein,0);
if ($aa){
warn "Incoming data!\n";
# accumulate;
$buf=$buf.<STDIN>;
warn $buf."\n";
}
}
$SIG{CHLD}=\&REAPER;
for ($waitedpid=0;($paddr=accept(Client,Server)) || $waitedpid;
$waitedpid=0, close Client){
next if $waitedpid and not $paddr;
my ($port, $iaddr) = sockaddr_in($paddr);
warn "Connection from ip:".inet_ntoa($iaddr)." port: ".$port."\n";
spawn sub {
$|=1;
$buf='';
my $k=0;
# install read handler
warn "CHILD: Installing signal handlers\n";
$SIG{'IO'}=\&INCOMING;
warn "CHILD: Turning on async mode on STDIN\n";
fcntl(STDIN, F_SETFL, O_ASYNC|O_NONBLOCK);
fcntl(STDIN, F_SETOWN, $$);
warn "CHILD: looping...\n";
my $msg;
while(1){
$msg="Hello client! I am sever! - $k\n";
print $msg;
#send (Client,$msg,length($msg));
sleep(5);
$k++;
}
}
}
sub spawn {
my $coderef=shift;
my $pid;
if (!defined($pid=fork)){
return;
} elsif ($pid) {
warn "I am parent - $pid.\n";
return;
}
# child here
select(Client);
$|=1;
open (STDIN, "<&Client") || die "cannot dup client to stdin\n";
open (STDOUT, ">&Client") || die "cannot dup client to stdout\n";
#open (STDERR, ">&Client") || die "cannot dup cleint to stderr\n";
select(STDOUT);
$|=1;
exit &$coderef();
}
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
