http://qs1969.pair.com?node_id=245517

JPaul has asked for the wisdom of the Perl Monks concerning the following question:

Greetings folks;
I've been busy working on a simple chat system that takes connections from telnet, a personal project. One problem that I'm unable to understand is that in certain places in the code I am unable to close a clients socket. The close() fails, and a fileno() gives me initialised errors.
This... confuses me.

In the below code I store details about the user in a hash (%c), using the socket handle as the key to the hash. Each user has a STATE, which tells me whether they're logging in, logged in, or should be disconnected.
The disconnect state in this case is -1, and in the code there are two checks for this -1 STATE. The first doesn't work, the disconnectclient() routine complains about being unable to close the socket. The second, however, works fine.
Can someone please explain to me what I'm missing?

This is only a very small portion of the code, and I've simplified it greatly, so there will certainly be things "missing" - I'm hoping I haven't left out anything important. The code should look famaliar to most, its only a slightly modified version of the Perl Cookbook's non-forking server (chap 17.13).

while (1) { my $client; my $rv; my $data; ######### Reap dead clients - This does not work as expected foreach (keys %c) { if ($c{$_}->{STATE} == -1) { &disconnectclient($_); } } # check for new information on the connections we have # anything to read or accept? foreach $client ($select->can_read(1)) { if ($client == $server) { # accept a new connection $client = $server->accept(); $select->add($client); &Sockets::nonblock($client); &Users::newclient($client); $c{$client}->{STATE} = 1; print "[Accept from $c{$client}->{HOST}:$c{$cl +ient}->{PORT}]\n"; # Init $inbuffer{$client} = ""; $outbuffer{$client} = ""; delete $ready{$client}; &Sockets::write($client, "login: "); } else { # read data $data = ''; $rv = $client->recv($data, POSIX::BUFSIZ, 0) +; unless (defined($rv) && length $data) { # This would be the end of file, so cl +ose the client delete $inbuffer{$client}; + delete $outbuffer{$client}; delete $ready{$client}; $select->remove($client); close $client; delete($c{$client}); next; } $inbuffer{$client} .= $data; while ($inbuffer{$client} =~ s/(.*\n)//) { push( @{$ready{$client}}, $1 ); + } } } # Any complete requests to process? foreach $client (keys %ready) { my $request; foreach (@{$ready{$client}}) { $request .= $_; } delete $ready{$client}; # Ignore data that doesn't fall between 0x20 and 0x7E + # (Non characters, control characters, etc) $request =~ s/[\x00-\x1F\x7F-\xFF]//g; ################ This check of the -1 state does work if ($c{$client}->{STATE} == -1) { &disconnectclient($client); } elsif ($c{$client}->{STATE} == 3) { # Client has logged in. Give to interpreter &C_Interpret($client, $request); } else { # Client is in the process of logging in &login($client, $request); } } # Buffers to flush? foreach $client ($select->can_write(1)) { # Skip this client if we have nothing to say next unless exists $outbuffer{$client}; $rv = $client->send($outbuffer{$client}, 0); unless (defined $rv) { # Whine, but move on. warn "I was told I could write, but I can't.\n"; next; } if ($rv == length $outbuffer{$client} || $! == POSIX::EWOULDBLOCK) { substr($outbuffer{$client}, 0, $rv) = ''; delete $outbuffer{$client} unless length $outbuffer{$c +lient}; } else { # Couldn't write all the data, and it wasn't because # it would have blocked. Shutdown and move on. delete $inbuffer{$client}; delete $outbuffer{$client}; delete $ready{$client}; $select->remove($client); close($client); delete($c{$client}); next; } } } # Drop a client connection sub disconnectclient { my ($client) = @_; delete $inbuffer{$client}; delete $outbuffer{$client}; delete $ready{$client}; $select->remove($client); if (!close($client)) { my $f = fileno($client); print STDERR "Balk! Couldn't disconnect client, $f\n"; } delete($c{$client}); }
My thanks,
JP
-- Alexander Widdlemouse undid his bellybutton and his bum dropped off --