Annotation of loncom/loncnew, revision 1.10
1.1 foxr 1: #!/usr/bin/perl
1.2 albertel 2: # The LearningOnline Network with CAPA
3: # lonc maintains the connections to remote computers
4: #
1.10 ! foxr 5: # $Id: loncnew,v 1.9 2003/06/13 02:38:43 foxr Exp $
1.2 albertel 6: #
7: # Copyright Michigan State University Board of Trustees
8: #
9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
10: #
11: # LON-CAPA is free software; you can redistribute it and/or modify
12: # it under the terms of the GNU General Public License as published by
13: # the Free Software Foundation; either version 2 of the License, or
14: # (at your option) any later version.
15: #
16: # LON-CAPA is distributed in the hope that it will be useful,
17: # but WITHOUT ANY WARRANTY; without even the implied warranty of
18: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19: # GNU General Public License for more details.
20: #
21: # You should have received a copy of the GNU General Public License
22: # along with LON-CAPA; if not, write to the Free Software
23: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
24: #
25: # /home/httpd/html/adm/gpl.txt
26: #
27: # http://www.lon-capa.org/
28: #
1.1 foxr 29: #
30: # new lonc handles n requestors spread out bver m connections to londs.
31: # This module is based on the Event class.
32: # Development iterations:
33: # - Setup basic event loop. (done)
34: # - Add timer dispatch. (done)
35: # - Add ability to accept lonc UNIX domain sockets. (done)
36: # - Add ability to create/negotiate lond connections (done).
1.7 foxr 37: # - Add general logic for dispatching requests and timeouts. (done).
38: # - Add support for the lonc/lond requests. (done).
1.1 foxr 39: # - Add logging/status monitoring.
40: # - Add Signal handling - HUP restarts. USR1 status report.
1.7 foxr 41: # - Add Configuration file I/O (done).
1.1 foxr 42: # - Add management/status request interface.
1.8 foxr 43: # - Add deferred request capability. (done)
1.9 foxr 44: # - Detect transmission timeouts.
1.7 foxr 45: #
46:
47: # Change log:
1.8 foxr 48: # $Log: loncnew,v $
1.10 ! foxr 49: # Revision 1.9 2003/06/13 02:38:43 foxr
! 50: # Add logging in 'expected format'
! 51: #
1.9 foxr 52: # Revision 1.8 2003/06/11 02:04:35 foxr
53: # Support delayed transactions... this is done uniformly by encapsulating
54: # transactions in an object ... a LondTransaction that is implemented by
55: # LondTransaction.pm
56: #
1.8 foxr 57: # Revision 1.7 2003/06/03 01:59:39 foxr
58: # complete coding to support deferred transactions.
59: #
1.7 foxr 60: #
1.1 foxr 61:
62: use lib "/home/httpd/lib/perl/";
63: use lib "/home/foxr/newloncapa/types";
64: use Event qw(:DEFAULT );
65: use POSIX qw(:signal_h);
66: use IO::Socket;
67: use IO::Socket::INET;
68: use IO::Socket::UNIX;
1.9 foxr 69: use IO::File;
1.6 foxr 70: use IO::Handle;
1.1 foxr 71: use Socket;
72: use Crypt::IDEA;
73: use LONCAPA::Queue;
74: use LONCAPA::Stack;
75: use LONCAPA::LondConnection;
1.7 foxr 76: use LONCAPA::LondTransaction;
1.1 foxr 77: use LONCAPA::Configuration;
78: use LONCAPA::HashIterator;
79:
80:
81: #
82: # Disable all signals we might receive from outside for now.
83: #
84: $SIG{QUIT} = IGNORE;
85: $SIG{HUP} = IGNORE;
86: $SIG{USR1} = IGNORE;
87: $SIG{INT} = IGNORE;
88: $SIG{CHLD} = IGNORE;
89: $SIG{__DIE__} = IGNORE;
90:
91:
92: # Read the httpd configuration file to get perl variables
93: # normally set in apache modules:
94:
95: my $perlvarref = LONCAPA::Configuration::read_conf('loncapa.conf');
96: my %perlvar = %{$perlvarref};
97:
98: #
99: # parent and shared variables.
100:
101: my %ChildHash; # by pid -> host.
102:
103:
1.9 foxr 104: my $MaxConnectionCount = 10; # Will get from config later.
1.1 foxr 105: my $ClientConnection = 0; # Uniquifier for client events.
106:
1.9 foxr 107: my $DebugLevel = 0;
1.1 foxr 108: my $IdleTimeout= 3600; # Wait an hour before pruning connections.
109:
110: #
111: # The variables below are only used by the child processes.
112: #
113: my $RemoteHost; # Name of host child is talking to.
114: my $UnixSocketDir= "/home/httpd/sockets";
115: my $IdleConnections = Stack->new(); # Set of idle connections
116: my %ActiveConnections; # Connections to the remote lond.
1.7 foxr 117: my %ActiveTransactions; # LondTransactions in flight.
1.1 foxr 118: my %ActiveClients; # Serial numbers of active clients by socket.
119: my $WorkQueue = Queue->new(); # Queue of pending transactions.
120: my $ConnectionCount = 0;
1.4 foxr 121: my $IdleSeconds = 0; # Number of seconds idle.
1.9 foxr 122: my $Status = ""; # Current status string.
1.10 ! foxr 123: my $ConnectionRetries=5; # Number of connection retries allowed.
! 124: my $ConnectionRetriesLeft=5; # Number of connection retries remaining.
1.1 foxr 125:
126: #
1.9 foxr 127: # The hash below gives the HTML format for log messages
128: # given a severity.
129: #
130: my %LogFormats;
131:
132: $LogFormats{"CRITICAL"} = "<font color=red>CRITICAL: %s</font>";
133: $LogFormats{"SUCCESS"} = "<font color=green>SUCCESS: %s</font>";
134: $LogFormats{"INFO"} = "<font color=yellow>INFO: %s</font>";
135: $LogFormats{"WARNING"} = "<font color=blue>WARNING: %s</font>";
136: $LogFormats{"DEFAULT"} = " %s ";
137:
1.10 ! foxr 138:
! 139:
! 140: =pod
! 141:
! 142: =head2 LogPerm
! 143:
! 144: Makes an entry into the permanent log file.
! 145:
! 146: =cut
! 147: sub LogPerm {
! 148: my $message=shift;
! 149: my $execdir=$perlvar{'lonDaemons'};
! 150: my $now=time;
! 151: my $local=localtime($now);
! 152: my $fh=IO::File->new(">>$execdir/logs/lonnet.perm.log");
! 153: print $fh "$now:$message:$local\n";
! 154: }
1.9 foxr 155:
156: =pod
157:
158: =head2 Log
159:
160: Logs a message to the log file.
161: Parameters:
162:
163: =item severity
164:
165: One of CRITICAL, WARNING, INFO, SUCCESS used to select the
166: format string used to format the message. if the severity is
167: not a defined severity the Default format string is used.
168:
169: =item message
170:
171: The base message. In addtion to the format string, the message
172: will be appended to a string containing the name of our remote
173: host and the time will be formatted into the message.
174:
175: =cut
176:
177: sub Log {
178: my $severity = shift;
179: my $message = shift;
180:
181: if(!$LogFormats{$severity}) {
182: $severity = "DEFAULT";
183: }
184:
185: my $format = $LogFormats{$severity};
186:
187: # Put the window dressing in in front of the message format:
188:
189: my $now = time;
190: my $local = localtime($now);
191: my $finalformat = "$local ($$) [$RemoteHost] [$Status] ";
192: my $finalformat = $finalformat.$format."\n";
193:
194: # open the file and put the result.
195:
196: my $execdir = $perlvar{'lonDaemons'};
197: my $fh = IO::File->new(">>$execdir/logs/lonc.log");
198: my $msg = sprintf($finalformat, $message);
199: print $fh $msg;
200:
1.10 ! foxr 201:
1.9 foxr 202: }
1.6 foxr 203:
1.3 albertel 204:
1.1 foxr 205: =pod
1.3 albertel 206:
207: =head2 GetPeerName
208:
209: Returns the name of the host that a socket object is connected to.
210:
1.1 foxr 211: =cut
212:
213: sub GetPeername {
214: my $connection = shift;
215: my $AdrFamily = shift;
216: my $peer = $connection->peername();
217: my $peerport;
218: my $peerip;
219: if($AdrFamily == AF_INET) {
220: ($peerport, $peerip) = sockaddr_in($peer);
221: my $peername = gethostbyaddr($iaddr, $AdrFamily);
222: return $peername;
223: } elsif ($AdrFamily == AF_UNIX) {
224: my $peerfile;
225: ($peerfile) = sockaddr_un($peer);
226: return $peerfile;
227: }
228: }
229: #----------------------------- Timer management ------------------------
230: =pod
1.3 albertel 231:
1.1 foxr 232: =head2 Debug
1.3 albertel 233:
234: Invoked to issue a debug message.
235:
1.1 foxr 236: =cut
1.3 albertel 237:
1.1 foxr 238: sub Debug {
239: my $level = shift;
240: my $message = shift;
241: if ($level <= $DebugLevel) {
242: print $message." host = ".$RemoteHost."\n";
243: }
244: }
245:
246: sub SocketDump {
247: my $level = shift;
248: my $socket= shift;
249: if($level <= $DebugLevel) {
250: $socket->Dump();
251: }
252: }
1.3 albertel 253:
1.1 foxr 254: =pod
1.3 albertel 255:
1.5 foxr 256: =head2 ShowStatus
257:
258: Place some text as our pid status.
1.10 ! foxr 259: and as what we return in a SIGUSR1
1.5 foxr 260:
261: =cut
262: sub ShowStatus {
1.10 ! foxr 263: my $state = shift;
! 264: my $now = time;
! 265: my $local = localtime($now);
! 266: $Status = $local.": ".$state;
! 267: $0='lonc: '.$state.' '.$local;
1.5 foxr 268: }
269:
270: =pod
271:
1.1 foxr 272: =head2 Tick
1.3 albertel 273:
274: Invoked each timer tick.
275:
1.1 foxr 276: =cut
277:
1.5 foxr 278:
1.1 foxr 279: sub Tick {
280: my $client;
1.5 foxr 281: ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount);
1.1 foxr 282: Debug(6, "Tick");
283: Debug(6, " Current connection count: ".$ConnectionCount);
284: foreach $client (keys %ActiveClients) {
285: Debug(7, " Have client: with id: ".$ActiveClients{$client});
286: }
1.4 foxr 287: # Is it time to prune connection count:
288:
289:
290: if($IdleConnections->Count() &&
291: ($WorkQueue->Count() == 0)) { # Idle connections and nothing to do?
292: $IdleSeconds++;
293: if($IdleSeconds > $IdleTimeout) { # Prune a connection...
294: $Socket = $IdleConnections->pop();
1.6 foxr 295: KillSocket($Socket);
1.4 foxr 296: }
297: } else {
298: $IdleSeconds = 0; # Reset idle count if not idle.
299: }
1.5 foxr 300:
301: # Do we have work in the queue, but no connections to service them?
302: # If so, try to make some new connections to get things going again.
303: #
304:
305: my $Requests = $WorkQueue->Count();
1.10 ! foxr 306: if (($ConnectionCount == 0) && ($Requests > 0)) {
! 307: if ($ConnectionRetriesLeft > 0) {
! 308: my $Connections = ($Requests <= $MaxConnectionCount) ?
! 309: $Requests : $MaxConnectionCount;
! 310: Debug(1,"Work but no connections, start ".$Connections." of them");
! 311: for ($i =0; $i < $Connections; $i++) {
! 312: MakeLondConnection();
! 313: }
! 314: } else {
! 315: Debug(1,"Work in queue, but gave up on connections..flushing\n");
! 316: EmptyQueue(); # Connections can't be established.
1.5 foxr 317: }
318:
319: }
1.1 foxr 320: }
321:
322: =pod
1.3 albertel 323:
1.1 foxr 324: =head2 SetupTimer
325:
1.3 albertel 326: Sets up a 1 per sec recurring timer event. The event handler is used to:
1.1 foxr 327:
1.3 albertel 328: =item
329:
330: Trigger timeouts on communications along active sockets.
331:
332: =item
333:
334: Trigger disconnections of idle sockets.
1.1 foxr 335:
336: =cut
337:
338: sub SetupTimer {
339: Debug(6, "SetupTimer");
340: Event->timer(interval => 1, debug => 1, cb => \&Tick );
341: }
1.3 albertel 342:
1.1 foxr 343: =pod
1.3 albertel 344:
1.1 foxr 345: =head2 ServerToIdle
1.3 albertel 346:
347: This function is called when a connection to the server is
348: ready for more work.
349:
350: If there is work in the Work queue the top element is dequeued
1.1 foxr 351: and the connection will start to work on it. If the work queue is
352: empty, the connection is pushed on the idle connection stack where
353: it will either get another work unit, or alternatively, if it sits there
354: long enough, it will be shut down and released.
355:
1.3 albertel 356: =cut
1.1 foxr 357:
358: sub ServerToIdle {
359: my $Socket = shift; # Get the socket.
1.7 foxr 360: delete($ActiveTransactions{$Socket}); # Server has no transaction
1.1 foxr 361:
362: &Debug(6, "Server to idle");
363:
364: # If there's work to do, start the transaction:
365:
1.7 foxr 366: $reqdata = $WorkQueue->dequeue(); # This is a LondTransaction
1.1 foxr 367: unless($reqdata eq undef) {
1.7 foxr 368: Debug(9, "Queue gave request data: ".$reqdata->getRequest());
369: &StartRequest($Socket, $reqdata);
1.8 foxr 370:
1.1 foxr 371: } else {
372:
373: # There's no work waiting, so push the server to idle list.
374: &Debug(8, "No new work requests, server connection going idle");
375: $IdleConnections->push($Socket);
376: }
377: }
1.3 albertel 378:
1.1 foxr 379: =pod
1.3 albertel 380:
1.1 foxr 381: =head2 ClientWritable
1.3 albertel 382:
383: Event callback for when a client socket is writable.
384:
385: This callback is established when a transaction reponse is
386: avaiable from lond. The response is forwarded to the unix socket
387: as it becomes writable in this sub.
388:
1.1 foxr 389: Parameters:
390:
1.3 albertel 391: =item Event
392:
393: The event that has been triggered. Event->w->data is
394: the data and Event->w->fd is the socket to write.
1.1 foxr 395:
396: =cut
1.3 albertel 397:
1.1 foxr 398: sub ClientWritable {
399: my $Event = shift;
400: my $Watcher = $Event->w;
401: my $Data = $Watcher->data;
402: my $Socket = $Watcher->fd;
403:
404: # Try to send the data:
405:
406: &Debug(6, "ClientWritable writing".$Data);
407: &Debug(9, "Socket is: ".$Socket);
408:
1.6 foxr 409: if($Socket->connected) {
410: my $result = $Socket->send($Data, 0);
411:
412: # $result undefined: the write failed.
413: # otherwise $result is the number of bytes written.
414: # Remove that preceding string from the data.
415: # If the resulting data is empty, destroy the watcher
416: # and set up a read event handler to accept the next
417: # request.
418:
419: &Debug(9,"Send result is ".$result." Defined: ".defined($result));
420: if(defined($result)) {
421: &Debug(9, "send result was defined");
422: if($result == length($Data)) { # Entire string sent.
423: &Debug(9, "ClientWritable data all written");
424: $Watcher->cancel();
425: #
426: # Set up to read next request from socket:
427:
428: my $descr = sprintf("Connection to lonc client %d",
429: $ActiveClients{$Socket});
430: Event->io(cb => \&ClientRequest,
431: poll => 'r',
432: desc => $descr,
433: data => "",
434: fd => $Socket);
435:
436: } else { # Partial string sent.
437: $Watcher->data(substr($Data, $result));
438: }
439:
440: } else { # Error of some sort...
441:
442: # Some errnos are possible:
443: my $errno = $!;
444: if($errno == POSIX::EWOULDBLOCK ||
445: $errno == POSIX::EAGAIN ||
446: $errno == POSIX::EINTR) {
447: # No action taken?
448: } else { # Unanticipated errno.
449: &Debug(5,"ClientWritable error or peer shutdown".$RemoteHost);
450: $Watcher->cancel; # Stop the watcher.
451: $Socket->shutdown(2); # Kill connection
452: $Socket->close(); # Close the socket.
453: }
1.1 foxr 454:
455: }
1.6 foxr 456: } else {
457: $Watcher->cancel(); # A delayed request...just cancel.
1.1 foxr 458: }
459: }
460:
461: =pod
1.3 albertel 462:
1.1 foxr 463: =head2 CompleteTransaction
1.3 albertel 464:
465: Called when the reply data has been received for a lond
1.1 foxr 466: transaction. The reply data must now be sent to the
467: ultimate client on the other end of the Unix socket. This is
468: done by setting up a writable event for the socket with the
469: data the reply data.
1.3 albertel 470:
1.1 foxr 471: Parameters:
1.3 albertel 472:
473: =item Socket
474:
475: Socket on which the lond transaction occured. This is a
476: LondConnection. The data received is in the TransactionReply member.
477:
1.7 foxr 478: =item Transaction
1.3 albertel 479:
1.7 foxr 480: The transaction that is being completed.
1.1 foxr 481:
482: =cut
1.3 albertel 483:
1.1 foxr 484: sub CompleteTransaction {
485: &Debug(6,"Complete transaction");
486: my $Socket = shift;
1.7 foxr 487: my $Transaction = shift;
1.1 foxr 488:
1.7 foxr 489: if (!$Transaction->isDeferred()) { # Normal transaction
490: my $data = $Socket->GetReply(); # Data to send.
491: StartClientReply($Transaction, $data);
492: } else { # Delete deferred transaction file.
1.9 foxr 493: Log("SUCCESS", "A delayed transaction was completed");
1.10 ! foxr 494: LogPerm("S:$Client:".$Transaction->getRequest());
1.7 foxr 495: unlink $Transaction->getFile();
496: }
1.6 foxr 497: }
498: =pod
499: =head1 StartClientReply
500:
501: Initiates a reply to a client where the reply data is a parameter.
502:
1.7 foxr 503: =head2 parameters:
504:
505: =item Transaction
506:
507: The transaction for which we are responding to the client.
508:
509: =item data
510:
511: The data to send to apached client.
512:
1.6 foxr 513: =cut
514: sub StartClientReply {
1.7 foxr 515: my $Transaction = shift;
1.6 foxr 516: my $data = shift;
1.1 foxr 517:
1.7 foxr 518: my $Client = $Transaction->getClient();
519:
1.1 foxr 520: &Debug(8," Reply was: ".$data);
521: my $Serial = $ActiveClients{$Client};
522: my $desc = sprintf("Connection to lonc client %d",
1.6 foxr 523:
1.1 foxr 524: $Serial);
525: Event->io(fd => $Client,
526: poll => "w",
527: desc => $desc,
528: cb => \&ClientWritable,
529: data => $data);
530: }
1.4 foxr 531: =pod
532: =head2 FailTransaction
533:
534: Finishes a transaction with failure because the associated lond socket
1.7 foxr 535: disconnected. There are two possibilities:
536: - The transaction is deferred: in which case we just quietly
537: delete the transaction since there is no client connection.
538: - The transaction is 'live' in which case we initiate the sending
539: of "con_lost" to the client.
540:
541: Deleting the transaction means killing it from the
542: %ActiveTransactions hash.
1.4 foxr 543:
544: Parameters:
545:
546: =item client
547:
1.7 foxr 548: The LondTransaction we are failing.
549:
1.4 foxr 550: =cut
551:
552: sub FailTransaction {
1.7 foxr 553: my $transaction = shift;
1.10 ! foxr 554: Debug(1, "Failing transaction: ".$transaction->getRequest());
! 555: if (!$transaction->isDeferred()) { # If the transaction is deferred we'll get to it.
1.7 foxr 556: my $client = $transcation->getClient();
1.10 ! foxr 557: Debug(1," Replying con_lost to ".$transaction->getRequest());
! 558: StartClientReply($client, "con_lost\n");
1.7 foxr 559: }
1.4 foxr 560:
561: }
562:
563: =pod
1.6 foxr 564: =head1 EmptyQueue
1.7 foxr 565:
1.6 foxr 566: Fails all items in the work queue with con_lost.
1.7 foxr 567: Note that each item in the work queue is a transaction.
568:
1.6 foxr 569: =cut
570: sub EmptyQueue {
571: while($WorkQueue->Count()) {
1.10 ! foxr 572: my $request = $WorkQueue->dequeue(); # This is a transaction
1.7 foxr 573: FailTransaction($request);
1.6 foxr 574: }
575: }
576:
577: =pod
1.4 foxr 578:
1.9 foxr 579: =head2 CloseAllLondConnections
580:
581: Close all connections open on lond prior to exit e.g.
582:
583: =cut
584: sub CloseAllLondConnections {
585: foreach $Socket (keys %ActiveConnections) {
586: KillSocket($Socket);
587: }
588: }
589: =cut
590:
591: =pod
592:
1.4 foxr 593: =head2 KillSocket
594:
595: Destroys a socket. This function can be called either when a socket
596: has died of 'natural' causes or because a socket needs to be pruned due to
597: idleness. If the socket has died naturally, if there are no longer any
598: live connections a new connection is created (in case there are transactions
599: in the queue). If the socket has been pruned, it is never re-created.
600:
601: Parameters:
1.1 foxr 602:
1.4 foxr 603: =item Socket
604:
605: The socket to kill off.
606:
607: =item Restart
608:
609: nonzero if we are allowed to create a new connection.
610:
611:
612: =cut
613: sub KillSocket {
614: my $Socket = shift;
615:
1.9 foxr 616: $Socket->Shutdown();
617:
1.7 foxr 618: # If the socket came from the active connection set,
619: # delete its transaction... note that FailTransaction should
620: # already have been called!!!
621: # otherwise it came from the idle set.
622: #
1.4 foxr 623:
624: if(exists($ActiveTransactions{$Socket})) {
625: delete ($ActiveTransactions{$Socket});
626: }
627: if(exists($ActiveConnections{$Socket})) {
628: delete($ActiveConnections{$Socket});
629: }
630: $ConnectionCount--;
1.6 foxr 631:
632: # If the connection count has gone to zero and there is work in the
633: # work queue, the work all gets failed with con_lost.
634: #
635: if($ConnectionCount == 0) {
636: EmptyQueue;
1.4 foxr 637: }
638: }
1.1 foxr 639:
640: =pod
1.3 albertel 641:
1.1 foxr 642: =head2 LondReadable
1.3 albertel 643:
1.1 foxr 644: This function is called whenever a lond connection
645: is readable. The action is state dependent:
646:
1.3 albertel 647: =head3 State=Initialized
648:
649: We''re waiting for the challenge, this is a no-op until the
1.1 foxr 650: state changes.
1.3 albertel 651:
1.1 foxr 652: =head3 State=Challenged
1.3 albertel 653:
654: The challenge has arrived we need to transition to Writable.
1.1 foxr 655: The connection must echo the challenge back.
1.3 albertel 656:
1.1 foxr 657: =head3 State=ChallengeReplied
1.3 albertel 658:
659: The challenge has been replied to. The we are receiveing the
1.1 foxr 660: 'ok' from the partner.
1.3 albertel 661:
1.1 foxr 662: =head3 State=RequestingKey
1.3 albertel 663:
664: The ok has been received and we need to send the request for
1.1 foxr 665: an encryption key. Transition to writable for that.
1.3 albertel 666:
1.1 foxr 667: =head3 State=ReceivingKey
1.3 albertel 668:
669: The the key has been requested, now we are reading the new key.
670:
1.1 foxr 671: =head3 State=Idle
1.3 albertel 672:
673: The encryption key has been negotiated or we have finished
1.1 foxr 674: reading data from the a transaction. If the callback data has
675: a client as well as the socket iformation, then we are
676: doing a transaction and the data received is relayed to the client
677: before the socket is put on the idle list.
1.3 albertel 678:
1.1 foxr 679: =head3 State=SendingRequest
1.3 albertel 680:
681: I do not think this state can be received here, but if it is,
1.1 foxr 682: the appropriate thing to do is to transition to writable, and send
683: the request.
1.3 albertel 684:
1.1 foxr 685: =head3 State=ReceivingReply
1.3 albertel 686:
687: We finished sending the request to the server and now transition
1.1 foxr 688: to readable to receive the reply.
689:
690: The parameter to this function are:
1.3 albertel 691:
1.1 foxr 692: The event. Implicit in this is the watcher and its data. The data
693: contains at least the lond connection object and, if a
694: transaction is in progress, the socket attached to the local client.
695:
1.3 albertel 696: =cut
1.1 foxr 697:
698: sub LondReadable {
1.8 foxr 699:
1.1 foxr 700: my $Event = shift;
701: my $Watcher = $Event->w;
702: my $Socket = $Watcher->data;
703: my $client = undef;
704:
1.8 foxr 705: &Debug(6,"LondReadable called state = ".$State);
706:
1.1 foxr 707:
708: my $State = $Socket->GetState(); # All action depends on the state.
709:
710: SocketDump(6, $Socket);
711:
712: if($Socket->Readable() != 0) {
1.4 foxr 713: # bad return from socket read. Currently this means that
714: # The socket has become disconnected. We fail the transaction.
715:
716: if(exists($ActiveTransactions{$Socket})) {
717: Debug(3,"Lond connection lost failing transaction");
718: FailTransaction($ActiveTransactions{$Socket});
719: }
720: $Watcher->cancel();
1.6 foxr 721: KillSocket($Socket);
1.4 foxr 722: return;
1.1 foxr 723: }
724: SocketDump(6,$Socket);
725:
726: $State = $Socket->GetState(); # Update in case of transition.
727: &Debug(6, "After read, state is ".$State);
728:
729: if($State eq "Initialized") {
730:
731:
732: } elsif ($State eq "ChallengeReceived") {
733: # The challenge must be echoed back; The state machine
734: # in the connection takes care of setting that up. Just
735: # need to transition to writable:
736:
1.8 foxr 737: $Watcher->cb(\&LondWritable);
1.1 foxr 738: $Watcher->poll("w");
739:
740: } elsif ($State eq "ChallengeReplied") {
741:
742:
743: } elsif ($State eq "RequestingKey") {
744: # The ok was received. Now we need to request the key
745: # That requires us to be writable:
746:
1.8 foxr 747: $Watcher->cb(\&LondWritable);
1.1 foxr 748: $Watcher->poll("w");
749:
750: } elsif ($State eq "ReceivingKey") {
751:
752: } elsif ($State eq "Idle") {
753: # If necessary, complete a transaction and then go into the
754: # idle queue.
1.8 foxr 755: $Watcher->cancel();
1.1 foxr 756: if(exists($ActiveTransactions{$Socket})) {
757: Debug(8,"Completing transaction!!");
758: CompleteTransaction($Socket,
759: $ActiveTransactions{$Socket});
1.9 foxr 760: } else {
761: Log("SUCCESS", "Connection ".$ConnectionCount." to "
762: .$RemoteHost." now ready for action");
1.1 foxr 763: }
764: ServerToIdle($Socket); # Next work unit or idle.
1.6 foxr 765:
1.1 foxr 766: } elsif ($State eq "SendingRequest") {
767: # We need to be writable for this and probably don't belong
768: # here inthe first place.
769:
770: Deubg(6, "SendingRequest state encountered in readable");
771: $Watcher->poll("w");
772: $Watcher->cb(\&LondWritable);
773:
774: } elsif ($State eq "ReceivingReply") {
775:
776:
777: } else {
778: # Invalid state.
779: Debug(4, "Invalid state in LondReadable");
780: }
781: }
1.3 albertel 782:
1.1 foxr 783: =pod
1.3 albertel 784:
1.1 foxr 785: =head2 LondWritable
1.3 albertel 786:
1.1 foxr 787: This function is called whenever a lond connection
788: becomes writable while there is a writeable monitoring
789: event. The action taken is very state dependent:
1.3 albertel 790:
1.1 foxr 791: =head3 State = Connected
1.3 albertel 792:
793: The connection is in the process of sending the 'init' hailing to the
794: lond on the remote end. The connection object''s Writable member is
795: called. On error, ConnectionError is called to destroy the connection
796: and remove it from the ActiveConnections hash
797:
1.1 foxr 798: =head3 Initialized
1.3 albertel 799:
800: 'init' has been sent, writability monitoring is removed and
801: readability monitoring is started with LondReadable as the callback.
802:
1.1 foxr 803: =head3 ChallengeReceived
1.3 albertel 804:
805: The connection has received the who are you challenge from the remote
806: system, and is in the process of sending the challenge
807: response. Writable is called.
808:
1.1 foxr 809: =head3 ChallengeReplied
1.3 albertel 810:
811: The connection has replied to the initial challenge The we switch to
812: monitoring readability looking for the server to reply with 'ok'.
813:
1.1 foxr 814: =head3 RequestingKey
1.3 albertel 815:
816: The connection is in the process of requesting its encryption key.
817: Writable is called.
818:
1.1 foxr 819: =head3 ReceivingKey
1.3 albertel 820:
821: The connection has sent the request for a key. Switch to readability
822: monitoring to accept the key
823:
1.1 foxr 824: =head3 SendingRequest
1.3 albertel 825:
826: The connection is in the process of sending a request to the server.
827: This request is part of a client transaction. All the states until
828: now represent the client setup protocol. Writable is called.
829:
1.1 foxr 830: =head3 ReceivingReply
831:
1.3 albertel 832: The connection has sent a request. Now it must receive a reply.
833: Readability monitoring is requested.
834:
835: This function is an event handler and therefore receives as
1.1 foxr 836: a parameter the event that has fired. The data for the watcher
837: of this event is a reference to a list of one or two elements,
838: depending on state. The first (and possibly only) element is the
839: socket. The second (present only if a request is in progress)
840: is the socket on which to return a reply to the caller.
841:
842: =cut
1.3 albertel 843:
1.1 foxr 844: sub LondWritable {
845: my $Event = shift;
846: my $Watcher = $Event->w;
1.8 foxr 847: my $Socket = $Watcher->data;
848: my $State = $Socket->GetState();
1.1 foxr 849:
1.8 foxr 850: Debug(6,"LondWritable State = ".$State."\n");
1.1 foxr 851:
1.8 foxr 852:
1.1 foxr 853: # Figure out what to do depending on the state of the socket:
854:
855:
856:
857:
858: SocketDump(6,$Socket);
859:
860: if ($State eq "Connected") {
861:
862: if ($Socket->Writable() != 0) {
863: # The write resulted in an error.
1.4 foxr 864: # We'll treat this as if the socket got disconnected:
1.9 foxr 865: Log("WARNING", "Connection to ".$RemoteHost.
866: " has been disconnected");
1.4 foxr 867: $Watcher->cancel();
1.6 foxr 868: KillSocket($Socket);
1.4 foxr 869: return;
1.1 foxr 870: }
1.4 foxr 871: # "init" is being sent...
872:
1.1 foxr 873:
874: } elsif ($State eq "Initialized") {
875:
876: # Now that init was sent, we switch
877: # to watching for readability:
878:
1.8 foxr 879: $Watcher->cb(\&LondReadable);
1.1 foxr 880: $Watcher->poll("r");
881:
882: } elsif ($State eq "ChallengeReceived") {
883: # We received the challenge, now we
884: # are echoing it back. This is a no-op,
885: # we're waiting for the state to change
886:
887: if($Socket->Writable() != 0) {
1.5 foxr 888:
889: $Watcher->cancel();
1.6 foxr 890: KillSocket($Socket);
1.5 foxr 891: return;
1.1 foxr 892: }
893:
894: } elsif ($State eq "ChallengeReplied") {
895: # The echo was sent back, so we switch
896: # to watching readability.
897:
1.8 foxr 898: $Watcher->cb(\&LondReadable);
1.1 foxr 899: $Watcher->poll("r");
900:
901: } elsif ($State eq "RequestingKey") {
902: # At this time we're requesting the key.
903: # again, this is essentially a no-op.
904: # we'll write the next chunk until the
905: # state changes.
906:
907: if($Socket->Writable() != 0) {
908: # Write resulted in an error.
1.5 foxr 909:
910: $Watcher->cancel();
1.6 foxr 911: KillSocket($Socket);
1.5 foxr 912: return;
913:
1.1 foxr 914: }
915: } elsif ($State eq "ReceivingKey") {
916: # Now we need to wait for the key
917: # to come back from the peer:
918:
1.8 foxr 919: $Watcher->cb(\&LondReadable);
1.1 foxr 920: $Watcher->poll("r");
921:
922: } elsif ($State eq "SendingRequest") {
923: # At this time we are sending a request to the
924: # peer... write the next chunk:
925:
926: if($Socket->Writable() != 0) {
927:
1.5 foxr 928: if(exists($ActiveTransactions{$Socket})) {
929: Debug(3, "Lond connection lost, failing transactions");
930: FailTransaction($ActiveTransactions{$Socket});
931: }
932: $Watcher->cancel();
1.6 foxr 933: KillSocket($Socket);
1.5 foxr 934: return;
935:
1.1 foxr 936: }
937:
938: } elsif ($State eq "ReceivingReply") {
939: # The send has completed. Wait for the
940: # data to come in for a reply.
941: Debug(8,"Writable sent request/receiving reply");
1.8 foxr 942: $Watcher->cb(\&LondReadable);
1.1 foxr 943: $Watcher->poll("r");
944:
945: } else {
946: # Control only passes here on an error:
947: # the socket state does not match any
948: # of the known states... so an error
949: # must be logged.
950:
951: &Debug(4, "Invalid socket state ".$State."\n");
952: }
953:
954: }
1.6 foxr 955: =pod
956:
957: =cut
958: sub QueueDelayed {
1.8 foxr 959: Debug(3,"QueueDelayed called");
960:
1.6 foxr 961: my $path = "$perlvar{'lonSockDir'}/delayed";
1.8 foxr 962:
963: Debug(4, "Delayed path: ".$path);
1.6 foxr 964: opendir(DIRHANDLE, $path);
1.8 foxr 965:
1.6 foxr 966: @alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE;
1.8 foxr 967: Debug(4, "Got ".$alldelayed." delayed files");
1.6 foxr 968: closedir(DIRHANDLE);
969: my $dfname;
1.8 foxr 970: my $reqfile;
971: foreach $dfname (sort @alldelayed) {
972: $reqfile = "$path/$dfname";
973: Debug(4, "queueing ".$reqfile);
1.6 foxr 974: my $Handle = IO::File->new($reqfile);
975: my $cmd = <$Handle>;
1.8 foxr 976: chomp $cmd; # There may or may not be a newline...
977: $cmd = $cmd."\ny"; # now for sure there's exactly one newline.
1.7 foxr 978: my $Transaction = LondTransaction->new($cmd);
979: $Transaction->SetDeferred($reqfile);
980: QueueTransaction($Transaction);
1.6 foxr 981: }
982:
983: }
1.1 foxr 984:
985: =pod
1.3 albertel 986:
1.1 foxr 987: =head2 MakeLondConnection
1.3 albertel 988:
989: Create a new lond connection object, and start it towards its initial
990: idleness. Once idle, it becomes elligible to receive transactions
991: from the work queue. If the work queue is not empty when the
992: connection is completed and becomes idle, it will dequeue an entry and
993: start off on it.
994:
1.1 foxr 995: =cut
1.3 albertel 996:
1.1 foxr 997: sub MakeLondConnection {
998: Debug(4,"MakeLondConnection to ".GetServerHost()." on port "
999: .GetServerPort());
1000:
1001: my $Connection = LondConnection->new(&GetServerHost(),
1002: &GetServerPort());
1003:
1004: if($Connection == undef) { # Needs to be more robust later.
1.9 foxr 1005: Log("CRITICAL","Failed to make a connection with lond.");
1.10 ! foxr 1006: $ConnectionRetriesLeft--;
! 1007: return 0; # Failure.
1.5 foxr 1008: } else {
1.10 ! foxr 1009: $ConnectionRetriesLeft = $ConnectionRetries; # success resets the count
1.5 foxr 1010: # The connection needs to have writability
1011: # monitored in order to send the init sequence
1012: # that starts the whole authentication/key
1013: # exchange underway.
1014: #
1015: my $Socket = $Connection->GetSocket();
1016: if($Socket == undef) {
1017: die "did not get a socket from the connection";
1018: } else {
1019: &Debug(9,"MakeLondConnection got socket: ".$Socket);
1020: }
1.1 foxr 1021:
1.5 foxr 1022:
1023: $event = Event->io(fd => $Socket,
1024: poll => 'w',
1025: cb => \&LondWritable,
1.8 foxr 1026: data => $Connection,
1.5 foxr 1027: desc => 'Connection to lond server');
1028: $ActiveConnections{$Connection} = $event;
1029:
1030: $ConnectionCount++;
1.8 foxr 1031: Debug(4, "Connection count = ".$ConnectionCount);
1.6 foxr 1032: if($ConnectionCount == 1) { # First Connection:
1033: QueueDelayed;
1034: }
1.9 foxr 1035: Log("SUCESS", "Created connection ".$ConnectionCount
1036: ." to host ".GetServerHost());
1.10 ! foxr 1037: return 1; # Return success.
1.1 foxr 1038: }
1039:
1040: }
1.3 albertel 1041:
1.1 foxr 1042: =pod
1.3 albertel 1043:
1.1 foxr 1044: =head2 StartRequest
1.3 albertel 1045:
1046: Starts a lond request going on a specified lond connection.
1047: parameters are:
1048:
1049: =item $Lond
1050:
1051: Connection to the lond that will send the transaction and receive the
1052: reply.
1053:
1054: =item $Client
1055:
1056: Connection to the client that is making this request We got the
1057: request from this socket, and when the request has been relayed to
1058: lond and we get a reply back from lond it will get sent to this
1059: socket.
1060:
1061: =item $Request
1062:
1063: The text of the request to send.
1064:
1.1 foxr 1065: =cut
1066:
1067: sub StartRequest {
1068: my $Lond = shift;
1.7 foxr 1069: my $Request = shift; # This is a LondTransaction.
1.1 foxr 1070:
1.7 foxr 1071: Debug(6, "StartRequest: ".$Request->getRequest());
1.1 foxr 1072:
1073: my $Socket = $Lond->GetSocket();
1074:
1.7 foxr 1075: $Request->Activate($Lond);
1076: $ActiveTransactions{$Lond} = $Request;
1.1 foxr 1077:
1.7 foxr 1078: $Lond->InitiateTransaction($Request->getRequest());
1.8 foxr 1079: $event = Event->io(fd => $Socket,
1.1 foxr 1080: poll => "w",
1081: cb => \&LondWritable,
1082: data => $Lond,
1083: desc => "lond transaction connection");
1084: $ActiveConnections{$Lond} = $event;
1085: Debug(8," Start Request made watcher data with ".$event->data."\n");
1086: }
1087:
1088: =pod
1.3 albertel 1089:
1.1 foxr 1090: =head2 QueueTransaction
1.3 albertel 1091:
1092: If there is an idle lond connection, it is put to work doing this
1093: transaction. Otherwise, the transaction is placed in the work queue.
1094: If placed in the work queue and the maximum number of connections has
1095: not yet been created, a new connection will be started. Our goal is
1096: to eventually have a sufficient number of connections that the work
1097: queue will typically be empty. parameters are:
1098:
1099: =item Socket
1100:
1101: open on the lonc client.
1102:
1103: =item Request
1104:
1105: data to send to the lond.
1.1 foxr 1106:
1107: =cut
1.3 albertel 1108:
1.1 foxr 1109: sub QueueTransaction {
1110:
1.7 foxr 1111: my $requestData = shift; # This is a LondTransaction.
1112: my $cmd = $requestData->getRequest();
1113:
1114: Debug(6,"QueueTransaction: ".$cmd);
1.1 foxr 1115:
1116: my $LondSocket = $IdleConnections->pop();
1117: if(!defined $LondSocket) { # Need to queue request.
1118: Debug(8,"Must queue...");
1119: $WorkQueue->enqueue($requestData);
1120: if($ConnectionCount < $MaxConnectionCount) {
1121: Debug(4,"Starting additional lond connection");
1122: MakeLondConnection();
1123: }
1124: } else { # Can start the request:
1125: Debug(8,"Can start...");
1.7 foxr 1126: StartRequest($LondSocket, $requestData);
1.1 foxr 1127: }
1128: }
1129:
1130: #-------------------------- Lonc UNIX socket handling ---------------------
1.3 albertel 1131:
1.1 foxr 1132: =pod
1.3 albertel 1133:
1.1 foxr 1134: =head2 ClientRequest
1.3 albertel 1135: Callback that is called when data can be read from the UNIX domain
1136: socket connecting us with an apache server process.
1.1 foxr 1137:
1138: =cut
1139:
1140: sub ClientRequest {
1141: Debug(6, "ClientRequest");
1142: my $event = shift;
1143: my $watcher = $event->w;
1144: my $socket = $watcher->fd;
1145: my $data = $watcher->data;
1146: my $thisread;
1147:
1148: Debug(9, " Watcher named: ".$watcher->desc);
1149:
1150: my $rv = $socket->recv($thisread, POSIX::BUFSIZ, 0);
1151: Debug(8, "rcv: data length = ".length($thisread)
1152: ." read =".$thisread);
1153: unless (defined $rv && length($thisread)) {
1154: # Likely eof on socket.
1155: Debug(5,"Client Socket closed on lonc for ".$RemoteHost);
1156: close($socket);
1157: $watcher->cancel();
1158: delete($ActiveClients{$socket});
1.10 ! foxr 1159: return;
1.1 foxr 1160: }
1161: Debug(8,"Data: ".$data." this read: ".$thisread);
1162: $data = $data.$thisread; # Append new data.
1163: $watcher->data($data);
1164: if($data =~ /(.*\n)/) { # Request entirely read.
1.10 ! foxr 1165: if($data eq "close_connection_exit\n") {
1.9 foxr 1166: Log("CRITICAL",
1167: "Request Close Connection ... exiting");
1168: CloseAllLondConnections();
1169: exit;
1170: }
1.1 foxr 1171: Debug(8, "Complete transaction received: ".$data);
1.8 foxr 1172: my $Transaction = LondTransaction->new($data);
1.7 foxr 1173: $Transaction->SetClient($socket);
1174: QueueTransaction($Transaction);
1.1 foxr 1175: $watcher->cancel(); # Done looking for input data.
1176: }
1177:
1178: }
1179:
1180:
1181: =pod
1.3 albertel 1182:
1.1 foxr 1183: =head2 NewClient
1.3 albertel 1184:
1185: Callback that is called when a connection is received on the unix
1186: socket for a new client of lonc. The callback is parameterized by the
1187: event.. which is a-priori assumed to be an io event, and therefore has
1188: an fd member that is the Listener socket. We Accept the connection
1189: and register a new event on the readability of that socket:
1190:
1.1 foxr 1191: =cut
1.3 albertel 1192:
1.1 foxr 1193: sub NewClient {
1194: Debug(6, "NewClient");
1195: my $event = shift; # Get the event parameters.
1196: my $watcher = $event->w;
1197: my $socket = $watcher->fd; # Get the event' socket.
1198: my $connection = $socket->accept(); # Accept the client connection.
1199: Debug(8,"Connection request accepted from "
1200: .GetPeername($connection, AF_UNIX));
1201:
1202:
1203: my $description = sprintf("Connection to lonc client %d",
1204: $ClientConnection);
1205: Debug(9, "Creating event named: ".$description);
1206: Event->io(cb => \&ClientRequest,
1207: poll => 'r',
1208: desc => $description,
1209: data => "",
1210: fd => $connection);
1211: $ActiveClients{$connection} = $ClientConnection;
1212: $ClientConnection++;
1213: }
1.3 albertel 1214:
1215: =pod
1216:
1217: =head2 GetLoncSocketPath
1218:
1219: Returns the name of the UNIX socket on which to listen for client
1220: connections.
1.1 foxr 1221:
1222: =cut
1.3 albertel 1223:
1.1 foxr 1224: sub GetLoncSocketPath {
1225: return $UnixSocketDir."/".GetServerHost();
1226: }
1227:
1.3 albertel 1228: =pod
1229:
1230: =head2 GetServerHost
1231:
1232: Returns the host whose lond we talk with.
1233:
1.1 foxr 1234: =cut
1.3 albertel 1235:
1.7 foxr 1236: sub GetServerHost {
1.1 foxr 1237: return $RemoteHost; # Setup by the fork.
1238: }
1.3 albertel 1239:
1240: =pod
1241:
1242: =head2 GetServerPort
1243:
1244: Returns the lond port number.
1245:
1.1 foxr 1246: =cut
1.3 albertel 1247:
1.7 foxr 1248: sub GetServerPort {
1.1 foxr 1249: return $perlvar{londPort};
1250: }
1.3 albertel 1251:
1252: =pod
1253:
1254: =head2 SetupLoncListener
1255:
1256: Setup a lonc listener event. The event is called when the socket
1257: becomes readable.. that corresponds to the receipt of a new
1258: connection. The event handler established will accept the connection
1259: (creating a communcations channel), that int turn will establish
1260: another event handler to subess requests.
1.1 foxr 1261:
1262: =cut
1.3 albertel 1263:
1.1 foxr 1264: sub SetupLoncListener {
1265:
1266: my $socket;
1267: my $SocketName = GetLoncSocketPath();
1268: unlink($SocketName);
1.7 foxr 1269: unless ($socket =IO::Socket::UNIX->new(Local => $SocketName,
1.1 foxr 1270: Listen => 10,
1271: Type => SOCK_STREAM)) {
1272: die "Failed to create a lonc listner socket";
1273: }
1274: Event->io(cb => \&NewClient,
1275: poll => 'r',
1276: desc => 'Lonc listener Unix Socket',
1277: fd => $socket);
1278: }
1279:
1280: =pod
1.3 albertel 1281:
1.10 ! foxr 1282: =head2 SignalledToDeath
! 1283:
! 1284: Called in response to a signal that causes a chid process to die.
! 1285:
! 1286: =cut
! 1287:
! 1288: =pod
! 1289:
! 1290: sub SignalledToDeath {
! 1291: my ($signal) = @_;
! 1292: chomp($signal);
! 1293: Log("CRITICAL", "Abnormal exit. Child $$ for $RemoteHost "
! 1294: ."died through "."\"$signal\"");
! 1295: LogPerm("F:lonc: $$ on $RemoteHost signalled to death: "
! 1296: ."\"$signal\"");
! 1297: die("Signal abnormal end");
! 1298:
! 1299: }
1.1 foxr 1300: =head2 ChildProcess
1301:
1302: This sub implements a child process for a single lonc daemon.
1303:
1304: =cut
1305:
1306: sub ChildProcess {
1307:
1308:
1309: # For now turn off signals.
1310:
1.10 ! foxr 1311: $SIG{QUIT} = \&SignalledToDeath;
1.1 foxr 1312: $SIG{HUP} = IGNORE;
1313: $SIG{USR1} = IGNORE;
1314: $SIG{INT} = IGNORE;
1315: $SIG{CHLD} = IGNORE;
1.10 ! foxr 1316: $SIG{__DIE__} = \&SignalledToDeath;
1.1 foxr 1317:
1318: SetupTimer();
1319:
1320: SetupLoncListener();
1321:
1322: $Event::Debuglevel = $DebugLevel;
1323:
1324: Debug(9, "Making initial lond connection for ".$RemoteHost);
1325:
1326: # Setup the initial server connection:
1327:
1.10 ! foxr 1328: # &MakeLondConnection(); // let first work requirest do it.
! 1329:
1.5 foxr 1330:
1.1 foxr 1331: Debug(9,"Entering event loop");
1332: my $ret = Event::loop(); # Start the main event loop.
1333:
1334:
1335: die "Main event loop exited!!!";
1336: }
1337:
1338: # Create a new child for host passed in:
1339:
1340: sub CreateChild {
1341: my $host = shift;
1342: $RemoteHost = $host;
1.9 foxr 1343: Log("CRITICAL", "Forking server for ".$host);
1.1 foxr 1344: $pid = fork;
1345: if($pid) { # Parent
1346: $ChildHash{$pid} = $RemoteHost;
1347: } else { # child.
1.5 foxr 1348: ShowStatus("Connected to ".$RemoteHost);
1.1 foxr 1349: ChildProcess;
1350: }
1351:
1352: }
1353: #
1354: # Parent process logic pass 1:
1355: # For each entry in the hosts table, we will
1356: # fork off an instance of ChildProcess to service the transactions
1357: # to that host. Each pid will be entered in a global hash
1358: # with the value of the key, the host.
1359: # The parent will then enter a loop to wait for process exits.
1360: # Each exit gets logged and the child gets restarted.
1361: #
1362:
1.5 foxr 1363: #
1364: # Fork and start in new session so hang-up isn't going to
1365: # happen without intent.
1366: #
1367:
1368:
1.6 foxr 1369:
1370:
1.8 foxr 1371:
1.6 foxr 1372:
1373: ShowStatus("Forming new session");
1374: my $childpid = fork;
1375: if ($childpid != 0) {
1376: sleep 4; # Give child a chacne to break to
1377: exit 0; # a new sesion.
1378: }
1.8 foxr 1379: #
1380: # Write my pid into the pid file so I can be located
1381: #
1382:
1383: ShowStatus("Parent writing pid file:");
1384: $execdir = $perlvar{'lonDaemons'};
1385: open (PIDSAVE, ">$execdir/logs/lonc.pid");
1386: print PIDSAVE "$$\n";
1387: close(PIDSAVE);
1.6 foxr 1388:
1389: if (POSIX::setsid() < 0) {
1390: print "Could not create new session\n";
1391: exit -1;
1392: }
1.5 foxr 1393:
1394: ShowStatus("Forking node servers");
1395:
1.9 foxr 1396: Log("CRITICAL", "--------------- Starting children ---------------");
1397:
1.1 foxr 1398: my $HostIterator = LondConnection::GetHostIterator;
1399: while (! $HostIterator->end()) {
1400:
1401: $hostentryref = $HostIterator->get();
1402: CreateChild($hostentryref->[0]);
1403: $HostIterator->next();
1404: }
1405:
1406: # Maintain the population:
1.5 foxr 1407:
1408: ShowStatus("Parent keeping the flock");
1.1 foxr 1409:
1.10 ! foxr 1410: #
! 1411: # Set up parent signals:
! 1412: #
! 1413: $SIG{INT} = &KillThemAll;
! 1414: $SIG{TERM} = &KillThemAll;
! 1415:
1.1 foxr 1416: while(1) {
1417: $deadchild = wait();
1418: if(exists $ChildHash{$deadchild}) { # need to restart.
1419: $deadhost = $ChildHash{$deadchild};
1420: delete($ChildHash{$deadchild});
1.9 foxr 1421: Log("WARNING","Lost child pid= ".$deadchild.
1.1 foxr 1422: "Connected to host ".$deadhost);
1.9 foxr 1423: Log("INFO", "Restarting child procesing ".$deadhost);
1.1 foxr 1424: CreateChild($deadhost);
1425: }
1.10 ! foxr 1426: }
! 1427: sub KillThemAll {
1.1 foxr 1428: }
1429:
1430: =head1 Theory
1.3 albertel 1431:
1432: The event class is used to build this as a single process with an
1433: event driven model. The following events are handled:
1.1 foxr 1434:
1435: =item UNIX Socket connection Received
1436:
1437: =item Request data arrives on UNIX data transfer socket.
1438:
1439: =item lond connection becomes writable.
1440:
1441: =item timer fires at 1 second intervals.
1442:
1443: All sockets are run in non-blocking mode. Timeouts managed by the timer
1444: handler prevents hung connections.
1445:
1446: Key data structures:
1447:
1.3 albertel 1448: =item RequestQueue
1449:
1450: A queue of requests received from UNIX sockets that are
1451: waiting for a chance to be forwarded on a lond connection socket.
1452:
1453: =item ActiveConnections
1454:
1455: A hash of lond connections that have transactions in process that are
1456: available to be timed out.
1457:
1458: =item ActiveTransactions
1459:
1460: A hash indexed by lond connections that contain the client reply
1461: socket for each connection that has an active transaction on it.
1462:
1463: =item IdleConnections
1464:
1465: A hash of lond connections that have no work to do. These connections
1466: can be closed if they are idle for a long enough time.
1.1 foxr 1467:
1468: =cut
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to loncnew CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom