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});
        }

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

Replies are listed 'Best First'.
•Re: A non-forking server model with issues closing sockets on users
by merlyn (Sage) on Mar 24, 2003 at 20:06 UTC
    close() can return an error (a "failed close") when buffered data cannot be flushed, or if the connection has already been closed by the other end in the case of a socket. What is the $! value, and have you correlated it with fclose(3)'s description of errors?

    -- Randal L. Schwartz, Perl hacker
    Be sure to read my standard disclaimer if this is a reply.

[reply]
      $! is set to 'Bad file descriptor'.
      This only further confuses me, I sure hope it tells you something...
      The loop is correct, what is returned should absolutely be a handle to a socket.

      Update
      I just added a 'print $_ "Something\n";' inside the first state checking loop, I don't know why I never thought of checking it before. I get this:
      Can't use string ("IO::Socket::INET=GLOB(0x83a8528)") as a symbol ref while "strict refs"
      Significant... But I'm unsure why its a string

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

[reply]
        I see that you're putting handles as keys in hashes. That won't work. Keys are always stringified, destroying the power of the handle object as an object. You'll need to do some redesign.

        -- Randal L. Schwartz, Perl hacker
        Be sure to read my standard disclaimer if this is a reply.

[reply]
        Most likely it has been closed by the peer already. (From a pure logic point of view, it is also possible that your file descriptor is a bad one anyway, due to other programming errors)

        Following piece of code demos this situation: 
        use strict;
use IO::Socket;
use threads;

$| = 1;

threads->create(\&server);
my $socket = IO::Socket::INET->new(Proto => "tcp", PeerAddr => "localh
+ost", PeerPort => 7001) || print "Socket creation error: $!\n";
sleep(5);
print "about to close socket on client side\n";
close($socket);
print "closed socket on client side\n";
print $!;

sub server {
    my $server = new IO::Socket::INET(Proto => "tcp", LocalPort => 700
+1, Listen => 5)
          || die "failed to establish socket\n";
    my $client = $server->accept;
    sleep(1);
    print "about to close socket on server side\n";
    close($client);
    print "closed socket on server side\n";
}

        [download]
[reply]
[d/l]

Back to Seekers of Perl Wisdom