Annotation of loncom/lonc, revision 1.36

1.1       albertel    1: #!/usr/bin/perl
                      2: 
                      3: # The LearningOnline Network
                      4: # lonc - LON TCP-Client Domain-Socket-Server
                      5: # provides persistent TCP connections to the other servers in the network
                      6: # through multiplexed domain sockets
                      7: #
1.36    ! foxr        8: # $Id: lonc,v 1.35 2002/03/26 04:37:59 foxr Exp $
1.22      www         9: #
                     10: # Copyright Michigan State University Board of Trustees
                     11: #
                     12: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                     13: #
                     14: # LON-CAPA is free software; you can redistribute it and/or modify
                     15: # it under the terms of the GNU General Public License as published by
                     16: # the Free Software Foundation; either version 2 of the License, or
                     17: # (at your option) any later version.
                     18: #
                     19: # LON-CAPA is distributed in the hope that it will be useful,
                     20: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     21: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     22: # GNU General Public License for more details.
                     23: #
                     24: # You should have received a copy of the GNU General Public License
                     25: # along with LON-CAPA; if not, write to the Free Software
                     26: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     27: #
                     28: # /home/httpd/html/adm/gpl.txt
                     29: #
                     30: # http://www.lon-capa.org/
                     31: #
1.1       albertel   32: # PID in subdir logs/lonc.pid
                     33: # kill kills
                     34: # HUP restarts
                     35: # USR1 tries to open connections again
                     36: 
1.2       www        37: # 6/4/99,6/5,6/7,6/8,6/9,6/10,6/11,6/12,7/14,7/19,
1.5       www        38: # 10/8,10/9,10/15,11/18,12/22,
1.10      www        39: # 2/8,7/25 Gerd Kortemeyer
                     40: # 12/05 Scott Harrison
                     41: # 12/05 Gerd Kortemeyer
1.23      harris41   42: # YEAR=2001
1.14      www        43: # 01/10/01 Scott Harrison
1.21      www        44: # 03/14/01,03/15,06/12,11/26,11/27,11/28 Gerd Kortemeyer
1.23      harris41   45: # 12/20 Scott Harrison
1.26      www        46: # YEAR=2002
1.29      www        47: # 2/19/02,02/22/02,02/25/02 Gerd Kortemeyer
1.33      foxr       48: # 3/07/02 Ron Fox 
1.1       albertel   49: # based on nonforker from Perl Cookbook
                     50: # - server who multiplexes without forking
                     51: 
                     52: use POSIX;
                     53: use IO::Socket;
                     54: use IO::Select;
                     55: use IO::File;
                     56: use Socket;
                     57: use Fcntl;
                     58: use Tie::RefHash;
                     59: use Crypt::IDEA;
1.32      foxr       60: #use Net::Ping;
1.26      www        61: use LWP::UserAgent();
1.1       albertel   62: 
1.30      www        63: $status='';
                     64: $lastlog='';
                     65: $conserver='SHELL';
1.32      foxr       66: $DEBUG = 0;			# Set to 1 for annoyingly complete logs.
1.26      www        67: 
1.8       harris41   68: # -------------------------------- Set signal handlers to record abnormal exits
                     69: 
1.29      www        70: &status("Init exception handlers");
1.26      www        71: $SIG{QUIT}=\&catchexception;
1.8       harris41   72: $SIG{__DIE__}=\&catchexception;
                     73: 
1.1       albertel   74: # ------------------------------------ Read httpd access.conf and get variables
1.29      www        75: &status("Read access.conf");
1.11      harris41   76: open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf";
1.1       albertel   77: 
                     78: while ($configline=<CONFIG>) {
                     79:     if ($configline =~ /PerlSetVar/) {
                     80: 	my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);
1.4       www        81:         chomp($varvalue);
1.1       albertel   82:         $perlvar{$varname}=$varvalue;
                     83:     }
                     84: }
                     85: close(CONFIG);
1.7       www        86: 
1.13      harris41   87: # ----------------------------- Make sure this process is running from user=www
1.29      www        88: &status("Check user ID");
1.13      harris41   89: my $wwwid=getpwnam('www');
                     90: if ($wwwid!=$<) {
                     91:    $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
                     92:    $subj="LON: $perlvar{'lonHostID'} User ID mismatch";
1.14      www        93:    system("echo 'User ID mismatch.  lonc must be run as user www.' |\
1.13      harris41   94:  mailto $emailto -s '$subj' > /dev/null");
                     95:    exit 1;
                     96: }
                     97: 
1.7       www        98: # --------------------------------------------- Check if other instance running
                     99: 
                    100: my $pidfile="$perlvar{'lonDaemons'}/logs/lonc.pid";
                    101: 
                    102: if (-e $pidfile) {
                    103:    my $lfh=IO::File->new("$pidfile");
                    104:    my $pide=<$lfh>;
                    105:    chomp($pide);
1.11      harris41  106:    if (kill 0 => $pide) { die "already running"; }
1.7       www       107: }
1.1       albertel  108: 
                    109: # ------------------------------------------------------------- Read hosts file
                    110: 
1.11      harris41  111: open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file";
1.1       albertel  112: 
                    113: while ($configline=<CONFIG>) {
                    114:     my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
                    115:     chomp($ip);
1.28      www       116:     if ($ip) {
                    117:      $hostip{$id}=$ip;
                    118:      $hostname{$id}=$name;
                    119:     }
1.1       albertel  120: }
1.27      www       121: 
1.1       albertel  122: close(CONFIG);
                    123: 
                    124: # -------------------------------------------------------- Routines for forking
                    125: 
                    126: %children               = ();       # keys are current child process IDs,
                    127:                                     # values are hosts
                    128: %childpid               = ();       # the other way around
                    129: 
                    130: %childatt               = ();       # number of attempts to start server
                    131:                                     # for ID
                    132: 
1.30      www       133: $childmaxattempts=5;
1.3       www       134: 
1.1       albertel  135: # ---------------------------------------------------- Fork once and dissociate
1.29      www       136: &status("Fork and dissociate");
1.1       albertel  137: $fpid=fork;
                    138: exit if $fpid;
1.11      harris41  139: die "Couldn't fork: $!" unless defined ($fpid);
1.1       albertel  140: 
1.11      harris41  141: POSIX::setsid() or die "Can't start new session: $!";
1.1       albertel  142: 
1.30      www       143: $conserver='PARENT';
                    144: 
1.1       albertel  145: # ------------------------------------------------------- Write our PID on disk
1.29      www       146: &status("Write PID");
1.1       albertel  147: $execdir=$perlvar{'lonDaemons'};
                    148: open (PIDSAVE,">$execdir/logs/lonc.pid");
                    149: print PIDSAVE "$$\n";
                    150: close(PIDSAVE);
1.5       www       151: &logthis("<font color=red>CRITICAL: ---------- Starting ----------</font>");
1.1       albertel  152: 
                    153: # ----------------------------- Ignore signals generated during initial startup
                    154: $SIG{HUP}=$SIG{USR1}='IGNORE';
                    155: # ------------------------------------------------------- Now we are on our own
                    156:     
                    157: # Fork off our children, one for every server
                    158: 
1.18      www       159: &status("Forking ...");
                    160: 
1.1       albertel  161: foreach $thisserver (keys %hostip) {
1.32      foxr      162:     #if (&online($hostname{$thisserver})) {
1.26      www       163:        make_new_child($thisserver);
1.32      foxr      164:     #}
1.1       albertel  165: }
                    166: 
                    167: &logthis("Done starting initial servers");
                    168: # ----------------------------------------------------- Install signal handlers
                    169: 
1.32      foxr      170: 
1.1       albertel  171: $SIG{INT}  = $SIG{TERM} = \&HUNTSMAN;
                    172: $SIG{HUP}  = \&HUPSMAN;
                    173: $SIG{USR1} = \&USRMAN;
                    174: 
                    175: # And maintain the population.
                    176: while (1) {
1.32      foxr      177:     my $deadpid = wait;		# Wait for the next child to die.
1.1       albertel  178:                                     # See who died and start new one
1.18      www       179:     &status("Woke up");
1.30      www       180:     my $skipping='';
1.32      foxr      181: 
                    182:     if(exists($children{$deadpid})) {
                    183: 
                    184: 	$thisserver = $children{$deadpid}; # Look name of dead guy's peer.
                    185: 
                    186: 	delete($children{$deadpid}); # Get rid of dead hash entry.
                    187: 
                    188: 	if($childatt{$thisserver} < $childmaxattempts) {
                    189: 	    $childatt{$thisserver}++;
                    190: 	    &logthis(
                    191: 	       "<font color=yellow>INFO: Trying to reconnect for $thisserver "
                    192:             ."($childatt{$thisserver} of $childmaxattempts attempts)</font>"); 
                    193: 	    make_new_child($thisserver);
                    194: 	
                    195: 	}
                    196: 	else {
                    197: 	    $skipping .= $thisserver.' ';
                    198: 	}
                    199: 	if($skipping) {
                    200: 	    &logthis("<font color=blue>WARNING: Skipped $skipping</font>");
                    201:   
                    202: 	}
1.30      www       203:     }
1.32      foxr      204: 
1.1       albertel  205: }
                    206: 
                    207: 
1.32      foxr      208: 
1.1       albertel  209: sub make_new_child {
                    210:    
1.30      www       211:     $newserver=shift;
1.1       albertel  212:     my $pid;
                    213:     my $sigset;
1.30      www       214:     &logthis("Attempting to start child for server $newserver");
1.1       albertel  215:     # block signal for fork
                    216:     $sigset = POSIX::SigSet->new(SIGINT);
                    217:     sigprocmask(SIG_BLOCK, $sigset)
1.11      harris41  218:         or die "Can't block SIGINT for fork: $!\n";
1.1       albertel  219:     
1.11      harris41  220:     die "fork: $!" unless defined ($pid = fork);
1.1       albertel  221:     
                    222:     if ($pid) {
                    223:         # Parent records the child's birth and returns.
                    224:         sigprocmask(SIG_UNBLOCK, $sigset)
1.11      harris41  225:             or die "Can't unblock SIGINT for fork: $!\n";
1.30      www       226:         $children{$pid} = $newserver;
1.32      foxr      227:         $childpid{$newserver} = $pid;
1.1       albertel  228:         return;
                    229:     } else {
1.30      www       230:         $conserver=$newserver;
1.1       albertel  231:         # Child can *not* return from this subroutine.
                    232:         $SIG{INT} = 'DEFAULT';      # make SIGINT kill us as it did before
1.18      www       233:         $SIG{USR1}= \&logstatus;
                    234:    
1.1       albertel  235:         # unblock signals
                    236:         sigprocmask(SIG_UNBLOCK, $sigset)
1.11      harris41  237:             or die "Can't unblock SIGINT for fork: $!\n";
1.1       albertel  238: 
                    239: # ----------------------------- This is the modified main program of non-forker
                    240: 
                    241: $port = "$perlvar{'lonSockDir'}/$conserver";
                    242: 
                    243: unlink($port);
1.18      www       244: 
1.29      www       245: # -------------------------------------------------------------- Open other end
1.1       albertel  246: 
1.29      www       247: &openremote($conserver);
1.32      foxr      248: 	&logthis("<font color=green> Connection to $conserver open </font>");
1.3       www       249: # ----------------------------------------- We're online, send delayed messages
1.18      www       250:     &status("Checking for delayed messages");
1.32      foxr      251: 
1.4       www       252:     my @allbuffered;
1.3       www       253:     my $path="$perlvar{'lonSockDir'}/delayed";
1.4       www       254:     opendir(DIRHANDLE,$path);
                    255:     @allbuffered=grep /\.$conserver$/, readdir DIRHANDLE;
                    256:     closedir(DIRHANDLE);
1.3       www       257:     my $dfname;
1.23      harris41  258:     foreach (@allbuffered) {
1.30      www       259:         &status("Sending delayed: $_");
1.4       www       260:         $dfname="$path/$_";
1.32      foxr      261:         if($DEBUG) { &logthis('Sending '.$dfname); }
1.3       www       262:         my $wcmd;
                    263:         {
                    264:          my $dfh=IO::File->new($dfname);
1.4       www       265:          $cmd=<$dfh>;
1.3       www       266:         }
                    267:         chomp($cmd);
                    268:         my $bcmd=$cmd;
                    269:         if ($cmd =~ /^encrypt\:/) {
                    270: 	    my $rcmd=$cmd;
                    271:             $rcmd =~ s/^encrypt\://;
                    272:             chomp($rcmd);
                    273:             my $cmdlength=length($rcmd);
                    274:             $rcmd.="         ";
                    275:             my $encrequest='';
                    276:             for (my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {
                    277:                 $encrequest.=
                    278:                     unpack("H16",$cipher->encrypt(substr($rcmd,$encidx,8)));
                    279:             }
                    280:             $cmd="enc:$cmdlength:$encrequest\n";
                    281:         }
1.33      foxr      282: 	$answer = londtransaction($remotesock, $cmd, 60);
1.3       www       283: 	chomp($answer);
1.20      www       284: 
                    285:         if (($answer ne '') && ($@!~/timeout/)) {
1.3       www       286: 	    unlink("$dfname");
1.30      www       287:             &logthis("Delayed $cmd: >$answer<");
1.3       www       288:             &logperm("S:$conserver:$bcmd");
                    289:         }        
1.23      harris41  290:     }
1.32      foxr      291: 	if($DEBUG) { &logthis("<font color=green> Delayed transactions sent"); }
1.1       albertel  292: 
                    293: # ------------------------------------------------------- Listen to UNIX socket
1.30      www       294: &status("Opening socket");
1.1       albertel  295: unless (
                    296:   $server = IO::Socket::UNIX->new(Local  => $port,
                    297:                                   Type   => SOCK_STREAM,
                    298:                                   Listen => 10 )
1.5       www       299:    ) { 
                    300:        my $st=120+int(rand(240));
                    301:        &logthis(
                    302:          "<font color=blue>WARNING: ".
1.33      foxr      303:          "Can't make server socket ($st secs):  .. exiting</font>");
1.5       www       304:        sleep($st);
1.1       albertel  305:        exit; 
                    306:      };
1.32      foxr      307:    
1.1       albertel  308: # -----------------------------------------------------------------------------
                    309: 
1.5       www       310: &logthis("<font color=green>$conserver online</font>");
                    311: 
                    312: # -----------------------------------------------------------------------------
1.1       albertel  313: # begin with empty buffers
                    314: %inbuffer  = ();
                    315: %outbuffer = ();
                    316: %ready     = ();
1.35      foxr      317: %servers   = ();	# To be compatible with make filevector.  indexed by
                    318: 			# File descriptors, values are file descriptors.
                    319: 			# note that the accept socket is omitted.
1.1       albertel  320: 
                    321: tie %ready, 'Tie::RefHash';
                    322: 
                    323: nonblock($server);
                    324: $select = IO::Select->new($server);
                    325: 
                    326: # Main loop: check reads/accepts, check writes, check ready to process
                    327: while (1) {
                    328:     my $client;
                    329:     my $rv;
                    330:     my $data;
                    331: 
1.35      foxr      332:     my $infdset;		# bit vec of fd's to select on input.
                    333:     my $inreadyset;		# Bit vec of fd's ready for input.
                    334: 
                    335:     my $outfdset;		# Bit vec of fd's to select on output.
                    336:     my $outreadyset;		# bit vec of fds ready for output.
                    337: 
                    338: 
                    339:     $infdset = MakeFileVector(\%servers);
                    340:     $outfdset= MakeFileVector(\%outbuffer);
                    341: 
1.1       albertel  342:     # check for new information on the connections we have
                    343:     # anything to read or accept?
                    344: 
1.34      foxr      345:     foreach $client ($select->can_read(00.10)) {
1.1       albertel  346:         if ($client == $server) {
                    347:             # accept a new connection
1.18      www       348:             &status("Accept new connection: $conserver");
1.1       albertel  349:             $client = $server->accept();
                    350:             $select->add($client);
                    351:             nonblock($client);
                    352:         } else {
                    353:             # read data
                    354:             $data = '';
                    355:             $rv   = $client->recv($data, POSIX::BUFSIZ, 0);
                    356: 
                    357:             unless (defined($rv) && length $data) {
                    358:                 # This would be the end of file, so close the client
                    359:                 delete $inbuffer{$client};
                    360:                 delete $outbuffer{$client};
                    361:                 delete $ready{$client};
                    362: 
1.30      www       363:                 &status("Idle");
1.1       albertel  364:                 $select->remove($client);
                    365:                 close $client;
                    366:                 next;
                    367:             }
                    368: 
                    369:             $inbuffer{$client} .= $data;
                    370: 
1.32      foxr      371: 
1.1       albertel  372:             # test whether the data in the buffer or the data we
                    373:             # just read means there is a complete request waiting
                    374:             # to be fulfilled.  If there is, set $ready{$client}
                    375:             # to the requests waiting to be fulfilled.
                    376:             while ($inbuffer{$client} =~ s/(.*\n)//) {
                    377:                 push( @{$ready{$client}}, $1 );
                    378:             }
                    379:         }
                    380:     }
1.32      foxr      381:     
1.1       albertel  382:     # Any complete requests to process?
                    383:     foreach $client (keys %ready) {
1.25      albertel  384:         handle($client);
1.1       albertel  385:     }
1.32      foxr      386:  
1.1       albertel  387:     # Buffers to flush?
                    388:     foreach $client ($select->can_write(1)) {
                    389:         # Skip this client if we have nothing to say
                    390:         next unless exists $outbuffer{$client};
1.25      albertel  391: 
1.1       albertel  392:         $rv = $client->send($outbuffer{$client}, 0);
1.29      www       393: 
1.30      www       394:       unless ($outbuffer{$client} eq "con_lost\n") {
1.1       albertel  395:         unless (defined $rv) {
                    396:             # Whine, but move on.
1.15      www       397:             &logthis("I was told I could write, but I can't.\n");
1.1       albertel  398:             next;
                    399:         }
1.15      www       400:         $errno=$!;
1.1       albertel  401:         if (($rv == length $outbuffer{$client}) ||
1.15      www       402:             ($errno == POSIX::EWOULDBLOCK) || ($errno == 0)) {
1.1       albertel  403:             substr($outbuffer{$client}, 0, $rv) = '';
                    404:             delete $outbuffer{$client} unless length $outbuffer{$client};
                    405:         } else {
                    406:             # Couldn't write all the data, and it wasn't because
                    407:             # it would have blocked.  Shutdown and move on.
1.15      www       408: 
                    409: 	    &logthis("Dropping data with ".$errno.": ".
                    410:                      length($outbuffer{$client}).", $rv");
                    411: 
1.1       albertel  412:             delete $inbuffer{$client};
                    413:             delete $outbuffer{$client};
                    414:             delete $ready{$client};
                    415: 
                    416:             $select->remove($client);
                    417:             close($client);
                    418:             next;
                    419:         }
1.29      www       420:       } else {
                    421: # -------------------------------------------------------- Wow, connection lost
                    422:          &logthis(
1.30      www       423:      "<font color=red>CRITICAL: Closing connection</font>");
                    424: 	 &status("Connection lost");
1.29      www       425:          $remotesock->shutdown(2);
                    426:          &logthis("Attempting to open new connection");
                    427:          &openremote($conserver);          
                    428:       }
1.1       albertel  429:     }
1.29      www       430:    
1.1       albertel  431: }
                    432: }
1.25      albertel  433: 
1.1       albertel  434: # ------------------------------------------------------- End of make_new_child
                    435: 
1.35      foxr      436: 
                    437: #
                    438: #  Make a vector of file descriptors to wait for in a select.
                    439: #  parameters:
                    440: #     \%fdhash  -reference to a hash which has IO::Socket's as indices.  
                    441: #                We only care about the indices, not the values.
                    442: #  A select vector is created from all indices of the hash.
                    443: 
                    444: sub MakeFileVector
                    445: {
                    446:     my $fdhash = shift;
                    447:     my $selvar = "";
                    448: 
                    449:     foreach $socket (keys %fdhash) {
                    450: 	vec($selvar, ($fdhash->{$socket})->fileno, 1) = 1;
                    451:     }
                    452:     return $selvar;
                    453: }
                    454: 
                    455: 
                    456: #
                    457: #  HandleOutput:
                    458: #    Processes output on a buffered set of file descriptors which are
                    459: #    ready to be read.
                    460: #  Parameters:
                    461: #    $selvector - Vector of writable file descriptors which are writable.
                    462: #    \%sockets  - Vector of socket references indexed by socket.
                    463: #    \%buffers  - Reference to a hash containing output buffers.
                    464: #                 Hashes are indexed by sockets.  The file descriptors of some
                    465: #                 of those sockets will be present in $selvector.
                    466: #                 For each one of those, we will attempt to write the output
                    467: #                 buffer to the socket.  Note that we will assume that
                    468: #                 the sockets are being run in non blocking mode.
                    469: #   \%inbufs    - Reference to hash containing input buffers.
                    470: #   \%readys    - Reference to hash containing flags for items with complete
                    471: #                 requests.
                    472: #
                    473: sub HandleOutput
                    474: {
                    475:     my $selvector = shift;
                    476:     my $sockets   = shift;
                    477:     my $buffers   = shift;
                    478:     my $inbufs    = shift;
                    479:     my $readys    = shift;
                    480: 
                    481:     foreach $sock (keys %buffers) {
                    482: 	my $socket = $sockets->{$sock};
                    483: 	if(vec($selvector, $$socket->fileno, 1)) { # $socket is writable.
                    484: 	    my $rv = $$socket->send($buffers->{$sock}, 0);
                    485: 	    $errno = $!;
                    486: 	    unless ($buffers->{$sock} eq "con_lost\n") {
                    487: 		unless (defined $rv) { # Write failed... could be EINTR
                    488: 		    unless ($errno == POSIX::EINTR) {
                    489: 			&logthis("Write failed on writable socket");
                    490: 		    }		# EINTR is not an error .. just retry.
                    491: 		    next;
                    492: 		}
                    493: 		if( ($rv == length $buffers->{$sock})    ||
                    494: 		    ($errno == POSIX::EWOULDBLOCK)       ||
                    495: 		    ($errno == POSIX::EAGAIN)            || # same as above.
                    496: 		    ($errno == POSIX::EINTR)             || # signal during IO
                    497: 		    ($errno == 0)) {
                    498: 		    substr($buffers->{$sock}, 0, $rv)=""; # delete written part
                    499: 		    delete $buffers->{$sock} unless length $buffers->{$sock};
                    500: 		} else {
                    501: 		    # For some reason the write failed with an error code
                    502: 		    # we didn't look for.  Shutdown the socket.
                    503: 		    &logthis("Unable to write data with ".$errno.": ".
                    504: 			     "Dropping data: ".length($buffers->{$sock}).
                    505: 			     ", $rv");
                    506: 		    #
                    507: 		    # kill off the buffers in the hash:
                    508: 
                    509: 		    delete $buffers->{$sock};
                    510: 		    delete $inbufs->{$sock};
                    511: 		    delete $readys->{$sock};
                    512: 
                    513: 		    close($$socket); # Close the client socket.
                    514: 		    next;
                    515: 		}
                    516: 	    } else {		# Kludgy way to mark lond connection lost.
                    517: 		&logthis(
                    518: 		 "<font color=red>CRITICAL lond connection lost</font>");
                    519: 		status("Connection lost");
                    520: 		$remotesock->shutdown(2);
                    521: 		&logthis("Attempting to open a new connection");
                    522: 		&openremot($conserver);
                    523: 	    }
                    524: 		   
                    525: 	}
                    526:     }
                    527: 
                    528: }
                    529: #
                    530: #   HandleInput - Deals with input on client sockets.
                    531: #                 Each socket has an associated input buffer.
                    532: #                 For each readable socket, the currently available
                    533: #                 data is appended to this buffer.
                    534: #                 If necessary, the buffer is created.
                    535: #                 On various failures, we may shutdown the client.
                    536: #  Parameters:
                    537: #     $selvec   - Vector of readable sockets.
                    538: #     \%sockets - Refers to the  Hash of sockets indexed by sockets.  
                    539: #                 Each of these may or may not have it's fd bit set 
                    540: #                 in the $selvec.
                    541: #     \%ibufs   - Refers to the hash of input buffers indexed by socket.
                    542: #     \%obufs   - Hash of output buffers indexed by socket. 
                    543: #     \%ready   - Hash of ready flags indicating the existence of a completed
                    544: #                 Request.
                    545: sub HandleInput 
                    546: {
                    547: 
                    548:     # Marshall the parameters.   Note that the hashes are actually
                    549:     # references not values.
                    550: 
                    551:     my $selvec  = shift;
                    552:     my $sockets = shift;
                    553:     my $ibufs   = shift;
                    554:     my $obufs   = shift;
                    555:     my $ready   = shift;
                    556: 
                    557:     foreach $sock (keys %sockets) {
                    558: 	my $socket = $sockets->{$sock};
                    559: 	if(vec($selvec, $$socket->fileno, 1)) { # Socket which is readable.
                    560: 
                    561: 	    #  Attempt to read the data and do error management.
                    562: 	    my $data = '';
                    563: 	    my $rv = $$socket->recv($data, POSIX::BUFSIZ, 0);
                    564: 	    unless (defined($rv) && length $data) {
                    565: 
                    566: 		# Read an end of file.. this is a disconnect from the peer.
                    567: 
                    568: 		delete $sockets->{$sock};
                    569: 		delete $ibufs->{$sock};
                    570: 		delete $obufs->{$sock};
                    571: 		delete $ready->{$sock};
                    572: 
                    573: 		status("Idle");
                    574: 		close $$socket;
                    575: 		next;
                    576: 	    }
                    577: 	    #  Append the read data to the input buffer. If the buffer
                    578: 	    # now contains a \n the request is complete and we can 
                    579: 	    # mark this in the $ready hash (one request for each \n.)
                    580: 
                    581: 	    $ibufs->{$sock} .= $data;
                    582: 	    while($ibufs->{$sock} =~ s/(.*\n)//) {
                    583: 		push(@{$ready->{$sock}}, $1);
                    584: 	    }
                    585: 	    
                    586: 	}
                    587:     }
                    588:     #  Now handle any requests which are ready:
                    589: 
                    590:     foreach $client (keys %ready) {
                    591: 	handle($client);
1.36    ! foxr      592:     }
        !           593: }
        !           594: 
        !           595: # DoSelect:  does a select with no timeout.  On signal (errno == EINTR), 
        !           596: #            the select is retried until there are items in the returned
        !           597: #            vectors.  
        !           598: #
        !           599: # Parameters:
        !           600: #   \$readvec   - Reference to a vector of file descriptors to 
        !           601: #                 check for readability.
        !           602: #   \$writevec  - Reference to a vector of file descriptors to check for
        !           603: #                 writability.
        !           604: #  On exit, the referents are modified with vectors indicating which 
        !           605: #  file handles are readable/writable.
        !           606: #
        !           607: sub DoSelect {
        !           608:     my $readvec = shift;
        !           609:     my $writevec= shift;
        !           610:     my $outs;
        !           611:     my $ins;
        !           612: 
        !           613:     while (1) {
        !           614: 	my $nfds = select($outs = $$writevec, $ins = $$readvec, undef, undef);
        !           615: 	if($nfound) {
        !           616: 	    $$readvec  = $ins;
        !           617: 	    $$writevec = $outs;
        !           618: 	    return;
        !           619: 	} else {
        !           620: 	    die "Select failed" unless $! == EINTR;
        !           621: 	}
1.35      foxr      622:     }
                    623: }
                    624: 
1.1       albertel  625: # handle($socket) deals with all pending requests for $client
1.35      foxr      626: #
1.1       albertel  627: sub handle {
                    628:     # requests are in $ready{$client}
                    629:     # send output to $outbuffer{$client}
                    630:     my $client = shift;
                    631:     my $request;
                    632:     foreach $request (@{$ready{$client}}) {
                    633: # ============================================================= Process request
                    634:         # $request is the text of the request
                    635:         # put text of reply into $outbuffer{$client}
1.29      www       636: # ------------------------------------------------------------ Is this the end?
1.33      foxr      637: 	chomp($request);
1.32      foxr      638: 	if($DEBUG) {
                    639:      &logthis("<font color=green> Request $request processing starts</font>");
                    640:         }
1.29      www       641:         if ($request eq "close_connection_exit\n") {
1.30      www       642: 	    &status("Request close connection");
1.29      www       643:            &logthis(
1.32      foxr      644:      "<font color=red>CRITICAL: Request Close Connection ... exiting</font>");
1.29      www       645:            $remotesock->shutdown(2);
                    646:            $server->close();
                    647:            exit;
                    648:         }
1.1       albertel  649: # -----------------------------------------------------------------------------
                    650:         if ($request =~ /^encrypt\:/) {
                    651: 	    my $cmd=$request;
                    652:             $cmd =~ s/^encrypt\://;
                    653:             chomp($cmd);
                    654:             my $cmdlength=length($cmd);
                    655:             $cmd.="         ";
                    656:             my $encrequest='';
                    657:             for (my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {
                    658:                 $encrequest.=
                    659:                     unpack("H16",$cipher->encrypt(substr($cmd,$encidx,8)));
                    660:             }
1.33      foxr      661:             $request="enc:$cmdlength:$encrequest";
1.1       albertel  662:         }
1.19      www       663: # --------------------------------------------------------------- Main exchange
1.33      foxr      664: 	$answer = londtransaction($remotesock, $request, 300);
                    665: 
                    666: 	if($DEBUG) { 
                    667: 	    &logthis("<font color=green> Request data exchange complete");
                    668: 	}
                    669: 	if ($@=~/timeout/) { 
                    670: 	    $answer='';
                    671: 	    &logthis(
                    672: 		     "<font color=red>CRITICAL: Timeout: $request</font>");
                    673: 	}  
1.19      www       674: 
                    675: 
1.1       albertel  676:         if ($answer) {
                    677: 	   if ($answer =~ /^enc/) {
                    678:                my ($cmd,$cmdlength,$encinput)=split(/:/,$answer);
                    679:                chomp($encinput);
                    680: 	       $answer='';
                    681:                for (my $encidx=0;$encidx<length($encinput);$encidx+=16) {
                    682:                   $answer.=$cipher->decrypt(
                    683:                    pack("H16",substr($encinput,$encidx,16))
                    684:                   );
                    685: 	       }
                    686: 	      $answer=substr($answer,0,$cmdlength);
                    687: 	      $answer.="\n";
                    688: 	   }
1.33      foxr      689: 	   if($DEBUG) {
                    690: 	       &logthis("sending $answer to client\n");
                    691: 	   }
1.1       albertel  692:            $outbuffer{$client} .= $answer;
                    693:         } else {
                    694:            $outbuffer{$client} .= "con_lost\n";
                    695:         }
                    696: 
1.30      www       697:      &status("Completed: $request");
1.32      foxr      698: 	if($DEBUG) {
                    699: 	    &logthis("<font color=green> Request processing complete</font>");
                    700: 	}
1.1       albertel  701: # ===================================================== Done processing request
                    702:     }
                    703:     delete $ready{$client};
                    704: # -------------------------------------------------------------- End non-forker
1.32      foxr      705:     if($DEBUG) {
                    706: 	&logthis("<font color=green> requests for child handled</font>");
                    707:     }
1.1       albertel  708: }
                    709: # ---------------------------------------------------------- End make_new_child
1.25      albertel  710: }
1.1       albertel  711: 
                    712: # nonblock($socket) puts socket into nonblocking mode
                    713: sub nonblock {
                    714:     my $socket = shift;
                    715:     my $flags;
                    716: 
                    717:     
                    718:     $flags = fcntl($socket, F_GETFL, 0)
1.11      harris41  719:             or die "Can't get flags for socket: $!\n";
1.1       albertel  720:     fcntl($socket, F_SETFL, $flags | O_NONBLOCK)
1.11      harris41  721:             or die "Can't make socket nonblocking: $!\n";
1.29      www       722: }
                    723: 
                    724: 
                    725: sub openremote {
                    726: # ---------------------------------------------------- Client to network server
                    727: 
                    728:     my $conserver=shift;
                    729: 
1.30      www       730: &status("Opening TCP");
1.32      foxr      731:     my $st=120+int(rand(240)); # Sleep before opening:
1.29      www       732: 
                    733: unless (
                    734:   $remotesock = IO::Socket::INET->new(PeerAddr => $hostip{$conserver},
                    735:                                       PeerPort => $perlvar{'londPort'},
                    736:                                       Proto    => "tcp",
                    737:                                       Type     => SOCK_STREAM)
                    738:    ) { 
1.32      foxr      739: 
1.29      www       740:        &logthis(
1.33      foxr      741: "<font color=blue>WARNING: Couldn't connect to $conserver ($st secs): </font>");
1.29      www       742:        sleep($st);
                    743:        exit; 
                    744:      };
                    745: # ----------------------------------------------------------------- Init dialog
                    746: 
1.32      foxr      747: &logthis("<font color=green>INFO Connected to $conserver, initing </font>");
1.29      www       748: &status("Init dialogue: $conserver");
                    749: 
1.33      foxr      750:     $answer = londtransaction($remotesock, "init", 60);
                    751:     chomp($answer);
                    752:     $answer = londtransaction($remotesock, $answer, 60);
                    753:     chomp($answer);
1.29      www       754:  
                    755:      if ($@=~/timeout/) {
1.32      foxr      756: 	 &logthis("Timed out during init.. exiting");
1.29      www       757:          exit;
                    758:      }
                    759: 
                    760: if ($answer ne 'ok') {
1.30      www       761:        &logthis("Init reply: >$answer<");
1.29      www       762:        my $st=120+int(rand(240));
                    763:        &logthis(
1.30      www       764: "<font color=blue>WARNING: Init failed ($st secs)</font>");
1.29      www       765:        sleep($st);
                    766:        exit; 
                    767: }
                    768: 
                    769: sleep 5;
1.30      www       770: &status("Ponging");
1.29      www       771: print $remotesock "pong\n";
                    772: $answer=<$remotesock>;
                    773: chomp($answer);
1.30      www       774: if ($answer!~/^$conserver/) {
                    775:    &logthis("Pong reply: >$answer<");
1.29      www       776: }
                    777: # ----------------------------------------------------------- Initialize cipher
                    778: 
1.30      www       779: &status("Initialize cipher");
1.29      www       780: print $remotesock "ekey\n";
                    781: my $buildkey=<$remotesock>;
                    782: my $key=$conserver.$perlvar{'lonHostID'};
                    783: $key=~tr/a-z/A-Z/;
                    784: $key=~tr/G-P/0-9/;
                    785: $key=~tr/Q-Z/0-9/;
                    786: $key=$key.$buildkey.$key.$buildkey.$key.$buildkey;
                    787: $key=substr($key,0,32);
                    788: my $cipherkey=pack("H32",$key);
                    789: if ($cipher=new IDEA $cipherkey) {
1.30      www       790:    &logthis("Secure connection initialized");
1.29      www       791: } else {
                    792:    my $st=120+int(rand(240));
                    793:    &logthis(
                    794:      "<font color=blue>WARNING: ".
1.30      www       795:      "Could not establish secure connection ($st secs)!</font>");
1.29      www       796:    sleep($st);
                    797:    exit;
                    798: }
1.32      foxr      799:     &logthis("<font color=green> Remote open success </font>");
1.8       harris41  800: }
1.30      www       801: 
                    802: 
                    803: 
                    804: # grabs exception and records it to log before exiting
                    805: sub catchexception {
                    806:     my ($signal)=@_;
                    807:     $SIG{QUIT}='DEFAULT';
                    808:     $SIG{__DIE__}='DEFAULT';
                    809:     chomp($signal);
                    810:     &logthis("<font color=red>CRITICAL: "
                    811:      ."ABNORMAL EXIT. Child $$ for server [$wasserver] died through "
1.33      foxr      812:      ."\"$signal\" with parameter </font>");
                    813:     die("Signal abend");
1.30      www       814: }
                    815: 
                    816: # -------------------------------------- Routines to see if other box available
                    817: 
1.32      foxr      818: #sub online {
                    819: #    my $host=shift;
                    820: #    &status("Pinging ".$host);
                    821: #    my $p=Net::Ping->new("tcp",20);
                    822: #    my $online=$p->ping("$host");
                    823: #    $p->close();
                    824: #    undef ($p);
                    825: #    return $online;
                    826: #}
1.30      www       827: 
                    828: sub connected {
                    829:     my ($local,$remote)=@_;
                    830:     &status("Checking connection $local to $remote");
                    831:     $local=~s/\W//g;
                    832:     $remote=~s/\W//g;
                    833: 
                    834:     unless ($hostname{$local}) { return 'local_unknown'; }
                    835:     unless ($hostname{$remote}) { return 'remote_unknown'; }
                    836: 
1.32      foxr      837:     #unless (&online($hostname{$local})) { return 'local_offline'; }
1.30      www       838: 
                    839:     my $ua=new LWP::UserAgent;
                    840:     
                    841:     my $request=new HTTP::Request('GET',
                    842:       "http://".$hostname{$local}.'/cgi-bin/ping.pl?'.$remote);
                    843: 
                    844:     my $response=$ua->request($request);
                    845: 
                    846:     unless ($response->is_success) { return 'local_error'; }
                    847: 
                    848:     my $reply=$response->content;
                    849:     $reply=(split("\n",$reply))[0];
                    850:     $reply=~s/\W//g;
                    851:     if ($reply ne $remote) { return $reply; }
                    852:     return 'ok';
                    853: }
                    854: 
                    855: 
                    856: 
                    857: sub hangup {
                    858:     foreach (keys %children) {
                    859:         $wasserver=$children{$_};
                    860:         &status("Closing $wasserver");
                    861:         &logthis('Closing '.$wasserver.': '.&subreply('exit',$wasserver));
                    862:         &status("Kill PID $_ for $wasserver");
                    863: 	kill ('INT',$_);
                    864:     }
                    865: }
                    866: 
                    867: sub HUNTSMAN {                      # signal handler for SIGINT
                    868:     local($SIG{CHLD}) = 'IGNORE';   # we're going to kill our children
                    869:     &hangup();
                    870:     my $execdir=$perlvar{'lonDaemons'};
                    871:     unlink("$execdir/logs/lonc.pid");
                    872:     &logthis("<font color=red>CRITICAL: Shutting down</font>");
                    873:     exit;                           # clean up with dignity
                    874: }
                    875: 
                    876: sub HUPSMAN {                      # signal handler for SIGHUP
                    877:     local($SIG{CHLD}) = 'IGNORE';  # we're going to kill our children
                    878:     &hangup();
                    879:     &logthis("<font color=red>CRITICAL: Restarting</font>");
                    880:     unlink("$execdir/logs/lonc.pid");
                    881:     my $execdir=$perlvar{'lonDaemons'};
                    882:     exec("$execdir/lonc");         # here we go again
                    883: }
                    884: 
                    885: sub checkchildren {
                    886:     &initnewstatus();
                    887:     &logstatus();
                    888:     &logthis('Going to check on the children');
                    889:     foreach (sort keys %children) {
                    890: 	sleep 1;
                    891:         unless (kill 'USR1' => $_) {
                    892: 	    &logthis ('<font color=red>CRITICAL: Child '.$_.' is dead</font>');
                    893:             &logstatus($$.' is dead');
                    894:         } 
                    895:     }
                    896: }
                    897: 
                    898: sub USRMAN {
                    899:     &logthis("USR1: Trying to establish connections again");
                    900:     %childatt=();
                    901:     &checkchildren();
                    902: }
                    903: 
                    904: # -------------------------------------------------- Non-critical communication
                    905: sub subreply { 
                    906:  my ($cmd,$server)=@_;
                    907:  my $answer='';
                    908:  if ($server ne $perlvar{'lonHostID'}) { 
                    909:     my $peerfile="$perlvar{'lonSockDir'}/$server";
                    910:     my $sclient=IO::Socket::UNIX->new(Peer    =>"$peerfile",
                    911:                                       Type    => SOCK_STREAM,
                    912:                                       Timeout => 10)
                    913:        or return "con_lost";
                    914: 
                    915: 
1.33      foxr      916:     $answer = londtransaction($sclient, $cmd, 10);
                    917: 
1.30      www       918:     if ((!$answer) || ($@=~/timeout/)) { $answer="con_lost"; }
                    919:     $SIG{ALRM}='DEFAULT';
                    920:     $SIG{__DIE__}=\&catchexception;
                    921:  } else { $answer='self_reply'; }
                    922:  return $answer;
                    923: }
                    924: 
                    925: # --------------------------------------------------------------------- Logging
                    926: 
                    927: sub logthis {
                    928:     my $message=shift;
                    929:     my $execdir=$perlvar{'lonDaemons'};
                    930:     my $fh=IO::File->new(">>$execdir/logs/lonc.log");
                    931:     my $now=time;
                    932:     my $local=localtime($now);
                    933:     $lastlog=$local.': '.$message;
                    934:     print $fh "$local ($$) [$conserver] [$status]: $message\n";
                    935: }
                    936: 
1.33      foxr      937: #--------------------------------------  londtransaction:
                    938: #  
                    939: #  Performs a transaction with lond with timeout support.
                    940: #    result = londtransaction(socket,request,timeout)
                    941: #
                    942: sub londtransaction {
                    943:     my ($socket, $request, $tmo) = @_;
                    944: 
                    945:     if($DEBUG) {
                    946: 	&logthis("londtransaction request: $request");
                    947:     }
                    948: 
                    949:     # Set the signal handlers: ALRM for timeout and disble the others.
                    950: 
                    951:     $SIG{ALRM} = sub { die "timeout" };
                    952:     $SIG{__DIE__} = 'DEFAULT';
                    953:     
                    954:     # Disable all but alarm so that only that can interupt the
                    955:     # send /receive.
                    956:     #
                    957:     my $sigset = POSIX::SigSet->new(QUIT, USR1, HUP, INT, TERM);
                    958:     my $priorsigs = POSIX::SigSet->new;
                    959:     unless (defined sigprocmask(SIG_BLOCK, $sigset, $priorsigs)) {
                    960: 	&logthis("<font color=red> CRITICAL -- londtransaction ".
                    961: 		"failed to block signals </font>");
                    962: 	die "could not block signals in londtransaction";
                    963:     }
                    964:     $answer = '';
                    965:     #
                    966:     #  Send request to lond.
                    967:     #
                    968:     eval { 
                    969: 	alarm($tmo);
                    970: 	print $socket "$request\n";
                    971: 	alarm(0);
                    972:     };
                    973:     #  If request didn't timeout, try for the response.
                    974:     #
                    975: 
                    976:     if ($@!~/timeout/) {
                    977: 	eval {
                    978: 	    alarm($tmo);
                    979: 	    $answer = <$socket>;
                    980: 	    if($DEBUG) {
                    981: 		&logthis("Received $answer in londtransaction");
                    982: 	    }
                    983: 	    alarm(0);
                    984: 	};
                    985:     } else {
                    986: 	if($DEBUG) {
                    987: 	    &logthis("Timeout on send in londtransaction");
                    988: 	}
                    989:     }
                    990:     if( ($@ =~ /timeout/)  && ($DEBUG)) {
                    991: 	&logthis("Timeout on receive in londtransaction");
                    992:     }
                    993:     #
                    994:     # Restore the initial sigmask set.
                    995:     #
                    996:     unless (defined sigprocmask(SIG_UNBLOCK, $priorsigs)) {
                    997: 	&logthis("<font color=red> CRITICAL -- londtransaction ".
                    998: 		"failed to re-enable signal processing. </font>");
                    999: 	die "londtransaction failed to re-enable signals";
                   1000:     }
                   1001:     #
                   1002:     # go back to the prior handler set.
                   1003:     #
                   1004:     $SIG{ALRM} = 'DEFAULT';
                   1005:     $SIG{__DIE__} = \&cathcexception;
                   1006: 
                   1007:     #    chomp $answer;
                   1008:     if ($DEBUG) {
                   1009: 	&logthis("Returning $answer in londtransaction");
                   1010:     }
                   1011:     return $answer;
                   1012: 
                   1013: }
1.30      www      1014: 
                   1015: sub logperm {
                   1016:     my $message=shift;
                   1017:     my $execdir=$perlvar{'lonDaemons'};
                   1018:     my $now=time;
                   1019:     my $local=localtime($now);
                   1020:     my $fh=IO::File->new(">>$execdir/logs/lonnet.perm.log");
                   1021:     print $fh "$now:$message:$local\n";
                   1022: }
                   1023: # ------------------------------------------------------------------ Log status
                   1024: 
                   1025: sub logstatus {
                   1026:     my $docdir=$perlvar{'lonDocRoot'};
                   1027:     my $fh=IO::File->new(">>$docdir/lon-status/loncstatus.txt");
                   1028:     print $fh $$."\t".$conserver."\t".$status."\t".$lastlog."\n";
                   1029: }
                   1030: 
                   1031: sub initnewstatus {
                   1032:     my $docdir=$perlvar{'lonDocRoot'};
                   1033:     my $fh=IO::File->new(">$docdir/lon-status/loncstatus.txt");
                   1034:     my $now=time;
                   1035:     my $local=localtime($now);
                   1036:     print $fh "LONC status $local - parent $$\n\n";
                   1037: }
                   1038: 
                   1039: # -------------------------------------------------------------- Status setting
                   1040: 
                   1041: sub status {
                   1042:     my $what=shift;
                   1043:     my $now=time;
                   1044:     my $local=localtime($now);
                   1045:     $status=$local.': '.$what;
                   1046: }
                   1047: 
                   1048: 
1.1       albertel 1049: 
1.23      harris41 1050: # ----------------------------------- POD (plain old documentation, CPAN style)
                   1051: 
                   1052: =head1 NAME
                   1053: 
                   1054: lonc - LON TCP-MySQL-Server Daemon for handling database requests.
                   1055: 
                   1056: =head1 SYNOPSIS
                   1057: 
1.31      harris41 1058: Usage: B<lonc>
                   1059: 
1.23      harris41 1060: Should only be run as user=www.  This is a command-line script which
1.31      harris41 1061: is invoked by B<loncron>.  There is no expectation that a typical user
                   1062: will manually start B<lonc> from the command-line.  (In other words,
                   1063: DO NOT START B<lonc> YOURSELF.)
1.23      harris41 1064: 
                   1065: =head1 DESCRIPTION
                   1066: 
                   1067: Provides persistent TCP connections to the other servers in the network
                   1068: through multiplexed domain sockets
                   1069: 
1.31      harris41 1070: B<lonc> forks off children processes that correspond to the other servers
                   1071: in the network.  Management of these processes can be done at the
                   1072: parent process level or the child process level.
                   1073: 
1.33      foxr     1074:   After forking off the children, B<lonc> the B<parent> 
                   1075: executes a main loop which simply waits for processes to exit.
                   1076: As a process exits, a new process managing a link to the same
                   1077: peer as the exiting process is created.  
                   1078: 
1.31      harris41 1079: B<logs/lonc.log> is the location of log messages.
                   1080: 
                   1081: The process management is now explained in terms of linux shell commands,
                   1082: subroutines internal to this code, and signal assignments:
                   1083: 
                   1084: =over 4
                   1085: 
                   1086: =item *
                   1087: 
                   1088: PID is stored in B<logs/lonc.pid>
                   1089: 
                   1090: This is the process id number of the parent B<lonc> process.
                   1091: 
                   1092: =item *
                   1093: 
                   1094: SIGTERM and SIGINT
                   1095: 
                   1096: Parent signal assignment:
                   1097:  $SIG{INT}  = $SIG{TERM} = \&HUNTSMAN;
                   1098: 
                   1099: Child signal assignment:
                   1100:  $SIG{INT}  = 'DEFAULT'; (and SIGTERM is DEFAULT also)
                   1101: (The child dies and a SIGALRM is sent to parent, awaking parent from slumber
                   1102:  to restart a new child.)
                   1103: 
                   1104: Command-line invocations:
                   1105:  B<kill> B<-s> SIGTERM I<PID>
                   1106:  B<kill> B<-s> SIGINT I<PID>
                   1107: 
                   1108: Subroutine B<HUNTSMAN>:
                   1109:  This is only invoked for the B<lonc> parent I<PID>.
                   1110: This kills all the children, and then the parent.
                   1111: The B<lonc.pid> file is cleared.
                   1112: 
                   1113: =item *
                   1114: 
                   1115: SIGHUP
                   1116: 
                   1117: Current bug:
                   1118:  This signal can only be processed the first time
                   1119: on the parent process.  Subsequent SIGHUP signals
                   1120: have no effect.
                   1121: 
                   1122: Parent signal assignment:
                   1123:  $SIG{HUP}  = \&HUPSMAN;
                   1124: 
                   1125: Child signal assignment:
                   1126:  none (nothing happens)
                   1127: 
                   1128: Command-line invocations:
                   1129:  B<kill> B<-s> SIGHUP I<PID>
                   1130: 
                   1131: Subroutine B<HUPSMAN>:
                   1132:  This is only invoked for the B<lonc> parent I<PID>,
                   1133: This kills all the children, and then the parent.
                   1134: The B<lonc.pid> file is cleared.
                   1135: 
                   1136: =item *
                   1137: 
                   1138: SIGUSR1
                   1139: 
                   1140: Parent signal assignment:
                   1141:  $SIG{USR1} = \&USRMAN;
                   1142: 
                   1143: Child signal assignment:
                   1144:  $SIG{USR1}= \&logstatus;
                   1145: 
                   1146: Command-line invocations:
                   1147:  B<kill> B<-s> SIGUSR1 I<PID>
                   1148: 
                   1149: Subroutine B<USRMAN>:
                   1150:  When invoked for the B<lonc> parent I<PID>,
                   1151: SIGUSR1 is sent to all the children, and the status of
                   1152: each connection is logged.
                   1153: 
1.23      harris41 1154: 
1.31      harris41 1155: =back
1.23      harris41 1156: 
                   1157: =head1 PREREQUISITES
                   1158: 
                   1159: POSIX
                   1160: IO::Socket
                   1161: IO::Select
                   1162: IO::File
                   1163: Socket
                   1164: Fcntl
                   1165: Tie::RefHash
                   1166: Crypt::IDEA
                   1167: 
                   1168: =head1 COREQUISITES
                   1169: 
                   1170: =head1 OSNAMES
                   1171: 
                   1172: linux
                   1173: 
                   1174: =head1 SCRIPT CATEGORIES
                   1175: 
                   1176: Server/Process
                   1177: 
                   1178: =cut

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>