comment on

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});
        }
[download]

My thanks,
JP
-- Alexander Widdlemouse undid his bellybutton and his bum dropped off --

In reply to A non-forking server model with issues closing sockets on users by JPaul

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


"be consistent"
	PerlMonks