--- loncom/Attic/lonc 2002/03/27 04:07:02 1.36 +++ loncom/Attic/lonc 2002/04/04 21:55:55 1.37 @@ -5,7 +5,7 @@ # provides persistent TCP connections to the other servers in the network # through multiplexed domain sockets # -# $Id: lonc,v 1.36 2002/03/27 04:07:02 foxr Exp $ +# $Id: lonc,v 1.37 2002/04/04 21:55:55 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -315,120 +315,65 @@ unless ( %outbuffer = (); %ready = (); %servers = (); # To be compatible with make filevector. indexed by - # File descriptors, values are file descriptors. + # File ids, values are sockets. # note that the accept socket is omitted. tie %ready, 'Tie::RefHash'; -nonblock($server); -$select = IO::Select->new($server); +# nonblock($server); +# $select = IO::Select->new($server); # Main loop: check reads/accepts, check writes, check ready to process + +status("Main loop"); while (1) { my $client; my $rv; my $data; my $infdset; # bit vec of fd's to select on input. - my $inreadyset; # Bit vec of fd's ready for input. my $outfdset; # Bit vec of fd's to select on output. - my $outreadyset; # bit vec of fds ready for output. $infdset = MakeFileVector(\%servers); $outfdset= MakeFileVector(\%outbuffer); - - # check for new information on the connections we have - # anything to read or accept? - - foreach $client ($select->can_read(00.10)) { - if ($client == $server) { - # accept a new connection - &status("Accept new connection: $conserver"); - $client = $server->accept(); - $select->add($client); - nonblock($client); - } else { - # read data - $data = ''; - $rv = $client->recv($data, POSIX::BUFSIZ, 0); - - unless (defined($rv) && length $data) { - # This would be the end of file, so close the client - delete $inbuffer{$client}; - delete $outbuffer{$client}; - delete $ready{$client}; - - &status("Idle"); - $select->remove($client); - close $client; - next; - } - - $inbuffer{$client} .= $data; - - - # test whether the data in the buffer or the data we - # just read means there is a complete request waiting - # to be fulfilled. If there is, set $ready{$client} - # to the requests waiting to be fulfilled. - while ($inbuffer{$client} =~ s/(.*\n)//) { - push( @{$ready{$client}}, $1 ); - } - } + vec($infdset, $server->fileno, 1) = 1; + if($DEBUG) { + &logthis("Adding ".$server->fileno. + " to input select vector (listner)". + unpack("b*",$infdset)."\n"); } - - # Any complete requests to process? - foreach $client (keys %ready) { - handle($client); + DoSelect(\$infdset, \$outfdset); # Wait for input. + if($DEBUG) { + &logthis("Doselect completed!"); + &logthis("ins = ".unpack("b*",$infdset)."\n"); + &logthis("outs= ".unpack("b*",$outfdset)."\n"); + } - - # 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 ($outbuffer{$client} eq "con_lost\n") { - unless (defined $rv) { - # Whine, but move on. - &logthis("I was told I could write, but I can't.\n"); - next; - } - $errno=$!; - if (($rv == length $outbuffer{$client}) || - ($errno == POSIX::EWOULDBLOCK) || ($errno == 0)) { - substr($outbuffer{$client}, 0, $rv) = ''; - delete $outbuffer{$client} unless length $outbuffer{$client}; - } else { - # Couldn't write all the data, and it wasn't because - # it would have blocked. Shutdown and move on. - - &logthis("Dropping data with ".$errno.": ". - length($outbuffer{$client}).", $rv"); - delete $inbuffer{$client}; - delete $outbuffer{$client}; - delete $ready{$client}; - - $select->remove($client); - close($client); - next; - } - } else { -# -------------------------------------------------------- Wow, connection lost - &logthis( - "CRITICAL: Closing connection"); - &status("Connection lost"); - $remotesock->shutdown(2); - &logthis("Attempting to open new connection"); - &openremote($conserver); - } + # Checkfor new connections: + if (vec($infdset, $server->fileno, 1)) { + if($DEBUG) { + &logthis("New connection established"); + } + # accept a new connection + &status("Accept new connection: $conserver"); + $client = $server->accept(); + if($DEBUG) { + &logthis("New client fd = ".$client->fileno."\n"); + } + $servers{$client->fileno} = $client; + nonblock($client); } - + HandleInput($infdset, \%servers, \%inbuffer, \%outbuffer, \%ready); + HandleOutput($outfdset, \%servers, \%outbuffer, \%inbuffer, + \%ready); +# -------------------------------------------------------- Wow, connection lost + } + + } } # ------------------------------------------------------- End of make_new_child @@ -446,8 +391,12 @@ sub MakeFileVector my $fdhash = shift; my $selvar = ""; - foreach $socket (keys %fdhash) { - vec($selvar, ($fdhash->{$socket})->fileno, 1) = 1; + foreach $socket (keys %$fdhash) { + if($DEBUG) { + &logthis("Adding ".$socket. + "to select vector. (client)\n"); + } + vec($selvar, $socket, 1) = 1; } return $selvar; } @@ -458,7 +407,7 @@ sub MakeFileVector # Processes output on a buffered set of file descriptors which are # ready to be read. # Parameters: -# $selvector - Vector of writable file descriptors which are writable. +# $selvector - Vector of file descriptors which are writable. # \%sockets - Vector of socket references indexed by socket. # \%buffers - Reference to a hash containing output buffers. # Hashes are indexed by sockets. The file descriptors of some @@ -477,11 +426,19 @@ sub HandleOutput my $buffers = shift; my $inbufs = shift; my $readys = shift; + my $sock; - foreach $sock (keys %buffers) { + if($DEBUG) { + &logthis("HandleOutput entered\n"); + } + + foreach $sock (keys %$sockets) { my $socket = $sockets->{$sock}; - if(vec($selvector, $$socket->fileno, 1)) { # $socket is writable. - my $rv = $$socket->send($buffers->{$sock}, 0); + if(vec($selvector, $sock, 1)) { # $socket is writable. + if($DEBUG) { + &logthis("Sending $buffers->{$sock} \n"); + } + my $rv = $socket->send($buffers->{$sock}, 0); $errno = $!; unless ($buffers->{$sock} eq "con_lost\n") { unless (defined $rv) { # Write failed... could be EINTR @@ -510,7 +467,7 @@ sub HandleOutput delete $inbufs->{$sock}; delete $readys->{$sock}; - close($$socket); # Close the client socket. + close($socket); # Close the client socket. next; } } else { # Kludgy way to mark lond connection lost. @@ -519,7 +476,7 @@ sub HandleOutput status("Connection lost"); $remotesock->shutdown(2); &logthis("Attempting to open a new connection"); - &openremot($conserver); + &openremote($conserver); } } @@ -553,14 +510,19 @@ sub HandleInput my $ibufs = shift; my $obufs = shift; my $ready = shift; + my $sock; - foreach $sock (keys %sockets) { + &logthis("Entered HandleInput\n"); + foreach $sock (keys %$sockets) { my $socket = $sockets->{$sock}; - if(vec($selvec, $$socket->fileno, 1)) { # Socket which is readable. + if(vec($selvec, $sock, 1)) { # Socket which is readable. # Attempt to read the data and do error management. my $data = ''; - my $rv = $$socket->recv($data, POSIX::BUFSIZ, 0); + my $rv = $socket->recv($data, POSIX::BUFSIZ, 0); + if($DEBUG) { + &logthis("Received $data from socket"); + } unless (defined($rv) && length $data) { # Read an end of file.. this is a disconnect from the peer. @@ -571,7 +533,7 @@ sub HandleInput delete $ready->{$sock}; status("Idle"); - close $$socket; + close $socket; next; } # Append the read data to the input buffer. If the buffer @@ -611,12 +573,22 @@ sub DoSelect { my $ins; while (1) { - my $nfds = select($outs = $$writevec, $ins = $$readvec, undef, undef); - if($nfound) { + my $nfds = select( $ins = $$readvec, $outs = $$writevec, undef, undef); + if($nfds) { + if($DEBUG) { + &logthis("select exited with ".$nfds." fds\n"); + &logthis("ins = ".unpack("b*",$ins). + " readvec = ".unpack("b*",$$readvec)."\n"); + &logthis("outs = ".unpack("b*",$outs). + " writevec = ".unpack("b*",$$writevec)."\n"); + } $$readvec = $ins; $$writevec = $outs; return; } else { + if($DEBUG) { + &logthis("Select exited with no bits set in mask\n"); + } die "Select failed" unless $! == EINTR; } } @@ -707,7 +679,6 @@ sub handle { } } # ---------------------------------------------------------- End make_new_child -} # nonblock($socket) puts socket into nonblocking mode sub nonblock {