--- loncom/Attic/lonc 2002/03/26 04:37:59 1.35 +++ loncom/Attic/lonc 2003/02/07 22:22:01 1.46 @@ -5,7 +5,7 @@ # provides persistent TCP connections to the other servers in the network # through multiplexed domain sockets # -# $Id: lonc,v 1.35 2002/03/26 04:37:59 foxr Exp $ +# $Id: lonc,v 1.46 2003/02/07 22:22:01 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -37,18 +37,18 @@ # 6/4/99,6/5,6/7,6/8,6/9,6/10,6/11,6/12,7/14,7/19, # 10/8,10/9,10/15,11/18,12/22, # 2/8,7/25 Gerd Kortemeyer -# 12/05 Scott Harrison # 12/05 Gerd Kortemeyer # YEAR=2001 -# 01/10/01 Scott Harrison # 03/14/01,03/15,06/12,11/26,11/27,11/28 Gerd Kortemeyer -# 12/20 Scott Harrison # YEAR=2002 # 2/19/02,02/22/02,02/25/02 Gerd Kortemeyer # 3/07/02 Ron Fox # based on nonforker from Perl Cookbook # - server who multiplexes without forking +use lib '/home/httpd/lib/perl/'; +use LONCAPA::Configuration; + use POSIX; use IO::Socket; use IO::Select; @@ -71,18 +71,11 @@ $DEBUG = 0; # Set to 1 for annoyingly $SIG{QUIT}=\&catchexception; $SIG{__DIE__}=\&catchexception; -# ------------------------------------ Read httpd access.conf and get variables -&status("Read access.conf"); -open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf"; - -while ($configline=) { - if ($configline =~ /PerlSetVar/) { - my ($dummy,$varname,$varvalue)=split(/\s+/,$configline); - chomp($varvalue); - $perlvar{$varname}=$varvalue; - } -} -close(CONFIG); +# ---------------------------------- Read loncapa_apache.conf and loncapa.conf +&status("Read loncapa.conf and loncapa_apache.conf"); +my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf'); +my %perlvar=%{$perlvarref}; +undef $perlvarref; # ----------------------------- Make sure this process is running from user=www &status("Check user ID"); @@ -175,7 +168,14 @@ $SIG{USR1} = \&USRMAN; # And maintain the population. while (1) { my $deadpid = wait; # Wait for the next child to die. - # See who died and start new one + # See who died and start new one + # or a signal (e.g. USR1 for restart). + # if a signal, the wait will fail + # This is ordinarily detected by + # checking for the existence of the + # pid index inthe children hash since + # the return value from a failed wait is -1 + # which is an impossible PID. &status("Woke up"); my $skipping=''; @@ -255,7 +255,7 @@ unlink($port); @allbuffered=grep /\.$conserver$/, readdir DIRHANDLE; closedir(DIRHANDLE); my $dfname; - foreach (@allbuffered) { + foreach (sort @allbuffered) { &status("Sending delayed: $_"); $dfname="$path/$_"; if($DEBUG) { &logthis('Sending '.$dfname); } @@ -315,120 +315,67 @@ 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 $conserver"); 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 { + # 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); + $client->sockopt(SO_KEEPALIVE, 1);# Enable monitoring of + # connection liveness. + } + HandleInput($infdset, \%servers, \%inbuffer, \%outbuffer, \%ready); + HandleOutput($outfdset, \%servers, \%outbuffer, \%inbuffer, + \%ready); # -------------------------------------------------------- Wow, connection lost - &logthis( - "CRITICAL: Closing connection"); - &status("Connection lost"); - $remotesock->shutdown(2); - &logthis("Attempting to open new connection"); - &openremote($conserver); - } - } - + } + + } } # ------------------------------------------------------- End of make_new_child @@ -446,8 +393,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 +409,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 +428,19 @@ sub HandleOutput my $buffers = shift; my $inbufs = shift; my $readys = shift; + my $sock; + + if($DEBUG) { + &logthis("HandleOutput entered\n"); + } - foreach $sock (keys %buffers) { + 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 +469,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 +478,7 @@ sub HandleOutput status("Connection lost"); $remotesock->shutdown(2); &logthis("Attempting to open a new connection"); - &openremot($conserver); + &openremote($conserver); } } @@ -553,14 +512,21 @@ sub HandleInput my $ibufs = shift; my $obufs = shift; my $ready = shift; + my $sock; - foreach $sock (keys %sockets) { + if($DEBUG) { + &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 +537,7 @@ sub HandleInput delete $ready->{$sock}; status("Idle"); - close $$socket; + close $socket; next; } # Append the read data to the input buffer. If the buffer @@ -592,6 +558,46 @@ sub HandleInput } } +# DoSelect: does a select with no timeout. On signal (errno == EINTR), +# the select is retried until there are items in the returned +# vectors. +# +# Parameters: +# \$readvec - Reference to a vector of file descriptors to +# check for readability. +# \$writevec - Reference to a vector of file descriptors to check for +# writability. +# On exit, the referents are modified with vectors indicating which +# file handles are readable/writable. +# +sub DoSelect { + my $readvec = shift; + my $writevec= shift; + my $outs; + my $ins; + + while (1) { + 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; + } + } +} + # handle($socket) deals with all pending requests for $client # sub handle { @@ -677,7 +683,6 @@ sub handle { } } # ---------------------------------------------------------- End make_new_child -} # nonblock($socket) puts socket into nonblocking mode sub nonblock { @@ -697,7 +702,7 @@ sub openremote { my $conserver=shift; -&status("Opening TCP"); +&status("Opening TCP $conserver"); my $st=120+int(rand(240)); # Sleep before opening: unless ( @@ -737,7 +742,7 @@ if ($answer ne 'ok') { } sleep 5; -&status("Ponging"); +&status("Ponging $conserver"); print $remotesock "pong\n"; $answer=<$remotesock>; chomp($answer); @@ -867,8 +872,25 @@ sub checkchildren { sub USRMAN { &logthis("USR1: Trying to establish connections again"); - %childatt=(); - &checkchildren(); + # + # It is really important not to just clear the childatt hash or we will + # lose all memory of the children. What we really want to do is this: + # For each index where childatt is >= $childmaxattempts + # Zero the associated counter and do a make_child for the host. + # Regardles, the childatt entry is zeroed: + my $host; + foreach $host (keys %childatt) { + if ($childatt{$host} >= $childmaxattempts) { + $childatt{$host} = 0; + &logthis("INFO: Restarting child for server: " + .$host."\n"); + make_new_child($host); + } + else { + $childatt{$host} = 0; + } + } + &checkchildren(); # See if any children are still dead... } # -------------------------------------------------- Non-critical communication @@ -1013,6 +1035,7 @@ sub status { my $now=time; my $local=localtime($now); $status=$local.': '.$what; + $0='lonc: '.$what.' '.$local; }