Annotation of loncom/loncnew, revision 1.5
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.5 ! foxr 5: # $Id: loncnew,v 1.4 2003/04/24 10:56:55 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).
37: # - Add general logic for dispatching requests and timeouts.
38: # - Add support for the lonc/lond requests.
39: # - Add logging/status monitoring.
40: # - Add Signal handling - HUP restarts. USR1 status report.
41: # - Add Configuration file I/O
42: # - Add Pending request processing on startup.
43: # - Add management/status request interface.
44:
45: use lib "/home/httpd/lib/perl/";
46: use lib "/home/foxr/newloncapa/types";
47: use Event qw(:DEFAULT );
48: use POSIX qw(:signal_h);
49: use IO::Socket;
50: use IO::Socket::INET;
51: use IO::Socket::UNIX;
52: use Socket;
53: use Crypt::IDEA;
54: use LONCAPA::Queue;
55: use LONCAPA::Stack;
56: use LONCAPA::LondConnection;
57: use LONCAPA::Configuration;
58: use LONCAPA::HashIterator;
59:
60: print "Loncnew starting\n";
61:
62: #
63: # Disable all signals we might receive from outside for now.
64: #
65: $SIG{QUIT} = IGNORE;
66: $SIG{HUP} = IGNORE;
67: $SIG{USR1} = IGNORE;
68: $SIG{INT} = IGNORE;
69: $SIG{CHLD} = IGNORE;
70: $SIG{__DIE__} = IGNORE;
71:
72:
73: # Read the httpd configuration file to get perl variables
74: # normally set in apache modules:
75:
76: my $perlvarref = LONCAPA::Configuration::read_conf('loncapa.conf');
77: my %perlvar = %{$perlvarref};
78:
79: #
80: # parent and shared variables.
81:
82: my %ChildHash; # by pid -> host.
83:
84:
85: my $MaxConnectionCount = 5; # Will get from config later.
86: my $ClientConnection = 0; # Uniquifier for client events.
87:
88: my $DebugLevel = 5;
89: my $IdleTimeout= 3600; # Wait an hour before pruning connections.
90:
91: #
92: # The variables below are only used by the child processes.
93: #
94: my $RemoteHost; # Name of host child is talking to.
95: my $UnixSocketDir= "/home/httpd/sockets";
96: my $IdleConnections = Stack->new(); # Set of idle connections
97: my %ActiveConnections; # Connections to the remote lond.
98: my %ActiveTransactions; # Transactions in flight.
99: my %ActiveClients; # Serial numbers of active clients by socket.
100: my $WorkQueue = Queue->new(); # Queue of pending transactions.
101: my $ClientQueue = Queue->new(); # Queue of clients causing xactinos.
102: my $ConnectionCount = 0;
1.4 foxr 103: my $IdleSeconds = 0; # Number of seconds idle.
1.1 foxr 104:
105: #
1.3 albertel 106:
1.1 foxr 107: =pod
1.3 albertel 108:
109: =head2 GetPeerName
110:
111: Returns the name of the host that a socket object is connected to.
112:
1.1 foxr 113: =cut
114:
115: sub GetPeername {
116: my $connection = shift;
117: my $AdrFamily = shift;
118: my $peer = $connection->peername();
119: my $peerport;
120: my $peerip;
121: if($AdrFamily == AF_INET) {
122: ($peerport, $peerip) = sockaddr_in($peer);
123: my $peername = gethostbyaddr($iaddr, $AdrFamily);
124: return $peername;
125: } elsif ($AdrFamily == AF_UNIX) {
126: my $peerfile;
127: ($peerfile) = sockaddr_un($peer);
128: return $peerfile;
129: }
130: }
131: #----------------------------- Timer management ------------------------
132: =pod
1.3 albertel 133:
1.1 foxr 134: =head2 Debug
1.3 albertel 135:
136: Invoked to issue a debug message.
137:
1.1 foxr 138: =cut
1.3 albertel 139:
1.1 foxr 140: sub Debug {
141: my $level = shift;
142: my $message = shift;
143: if ($level <= $DebugLevel) {
144: print $message." host = ".$RemoteHost."\n";
145: }
146: }
147:
148: sub SocketDump {
149: my $level = shift;
150: my $socket= shift;
151: if($level <= $DebugLevel) {
152: $socket->Dump();
153: }
154: }
1.3 albertel 155:
1.1 foxr 156: =pod
1.3 albertel 157:
1.5 ! foxr 158: =head2 ShowStatus
! 159:
! 160: Place some text as our pid status.
! 161:
! 162: =cut
! 163: sub ShowStatus {
! 164: my $status = shift;
! 165: $0 = "lonc: ".$status;
! 166: }
! 167:
! 168: =pod
! 169:
1.1 foxr 170: =head2 Tick
1.3 albertel 171:
172: Invoked each timer tick.
173:
1.1 foxr 174: =cut
175:
1.5 ! foxr 176:
1.1 foxr 177: sub Tick {
178: my $client;
1.5 ! foxr 179: ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount);
1.1 foxr 180: Debug(6, "Tick");
181: Debug(6, " Current connection count: ".$ConnectionCount);
182: foreach $client (keys %ActiveClients) {
183: Debug(7, " Have client: with id: ".$ActiveClients{$client});
184: }
1.4 foxr 185: # Is it time to prune connection count:
186:
187:
188: if($IdleConnections->Count() &&
189: ($WorkQueue->Count() == 0)) { # Idle connections and nothing to do?
190: $IdleSeconds++;
191: if($IdleSeconds > $IdleTimeout) { # Prune a connection...
192: $Socket = $IdleConnections->pop();
193: KillSocket($Socket, 0);
194: }
195: } else {
196: $IdleSeconds = 0; # Reset idle count if not idle.
197: }
1.5 ! foxr 198:
! 199: # Do we have work in the queue, but no connections to service them?
! 200: # If so, try to make some new connections to get things going again.
! 201: #
! 202:
! 203: my $Requests = $WorkQueue->Count();
! 204: if (($ConnectionCount == 0) && ($Requests > 0)) {
! 205: my $Connections = ($Requests <= $MaxConnectionCount) ?
! 206: $Requests : $MaxConnectionCount;
! 207: Debug(1,"Work but no connections, starting ".$Connections." of them");
! 208: for ($i =0; $i < $Connections; $i++) {
! 209: MakeLondConnection();
! 210: }
! 211:
! 212: }
1.1 foxr 213: }
214:
215: =pod
1.3 albertel 216:
1.1 foxr 217: =head2 SetupTimer
218:
1.3 albertel 219: Sets up a 1 per sec recurring timer event. The event handler is used to:
1.1 foxr 220:
1.3 albertel 221: =item
222:
223: Trigger timeouts on communications along active sockets.
224:
225: =item
226:
227: Trigger disconnections of idle sockets.
1.1 foxr 228:
229: =cut
230:
231: sub SetupTimer {
232: Debug(6, "SetupTimer");
233: Event->timer(interval => 1, debug => 1, cb => \&Tick );
234: }
1.3 albertel 235:
1.1 foxr 236: =pod
1.3 albertel 237:
1.1 foxr 238: =head2 ServerToIdle
1.3 albertel 239:
240: This function is called when a connection to the server is
241: ready for more work.
242:
243: If there is work in the Work queue the top element is dequeued
1.1 foxr 244: and the connection will start to work on it. If the work queue is
245: empty, the connection is pushed on the idle connection stack where
246: it will either get another work unit, or alternatively, if it sits there
247: long enough, it will be shut down and released.
248:
1.3 albertel 249: =cut
1.1 foxr 250:
251: sub ServerToIdle {
252: my $Socket = shift; # Get the socket.
253:
254: &Debug(6, "Server to idle");
255:
256: # If there's work to do, start the transaction:
257:
258: $reqdata = $WorkQueue->dequeue();
259: Debug(9, "Queue gave request data: ".$reqdata);
260: unless($reqdata eq undef) {
261: my $unixSocket = $ClientQueue->dequeue();
262: &Debug(6, "Starting new work request");
263: &Debug(7, "Request: ".$reqdata);
264:
265: &StartRequest($Socket, $unixSocket, $reqdata);
266: } else {
267:
268: # There's no work waiting, so push the server to idle list.
269: &Debug(8, "No new work requests, server connection going idle");
270: delete($ActiveTransactions{$Socket});
271: $IdleConnections->push($Socket);
272: }
273: }
1.3 albertel 274:
1.1 foxr 275: =pod
1.3 albertel 276:
1.1 foxr 277: =head2 ClientWritable
1.3 albertel 278:
279: Event callback for when a client socket is writable.
280:
281: This callback is established when a transaction reponse is
282: avaiable from lond. The response is forwarded to the unix socket
283: as it becomes writable in this sub.
284:
1.1 foxr 285: Parameters:
286:
1.3 albertel 287: =item Event
288:
289: The event that has been triggered. Event->w->data is
290: the data and Event->w->fd is the socket to write.
1.1 foxr 291:
292: =cut
1.3 albertel 293:
1.1 foxr 294: sub ClientWritable {
295: my $Event = shift;
296: my $Watcher = $Event->w;
297: my $Data = $Watcher->data;
298: my $Socket = $Watcher->fd;
299:
300: # Try to send the data:
301:
302: &Debug(6, "ClientWritable writing".$Data);
303: &Debug(9, "Socket is: ".$Socket);
304:
305: my $result = $Socket->send($Data, 0);
306:
307: # $result undefined: the write failed.
308: # otherwise $result is the number of bytes written.
309: # Remove that preceding string from the data.
310: # If the resulting data is empty, destroy the watcher
311: # and set up a read event handler to accept the next
312: # request.
313:
314: &Debug(9,"Send result is ".$result." Defined: ".defined($result));
315: if(defined($result)) {
316: &Debug(9, "send result was defined");
317: if($result == length($Data)) { # Entire string sent.
318: &Debug(9, "ClientWritable data all written");
319: $Watcher->cancel();
320: #
321: # Set up to read next request from socket:
322:
323: my $descr = sprintf("Connection to lonc client %d",
324: $ActiveClients{$Socket});
325: Event->io(cb => \&ClientRequest,
326: poll => 'r',
327: desc => $descr,
328: data => "",
329: fd => $Socket);
330:
331: } else { # Partial string sent.
332: $Watcher->data(substr($Data, $result));
333: }
334:
335: } else { # Error of some sort...
336:
337: # Some errnos are possible:
338: my $errno = $!;
339: if($errno == POSIX::EWOULDBLOCK ||
340: $errno == POSIX::EAGAIN ||
341: $errno == POSIX::EINTR) {
342: # No action taken?
343: } else { # Unanticipated errno.
344: &Debug(5,"ClientWritable error or peer shutdown".$RemoteHost);
345: $Watcher->cancel; # Stop the watcher.
346: $Socket->shutdown(2); # Kill connection
347: $Socket->close(); # Close the socket.
348: }
349:
350: }
351: }
352:
353: =pod
1.3 albertel 354:
1.1 foxr 355: =head2 CompleteTransaction
1.3 albertel 356:
357: Called when the reply data has been received for a lond
1.1 foxr 358: transaction. The reply data must now be sent to the
359: ultimate client on the other end of the Unix socket. This is
360: done by setting up a writable event for the socket with the
361: data the reply data.
1.3 albertel 362:
1.1 foxr 363: Parameters:
1.3 albertel 364:
365: =item Socket
366:
367: Socket on which the lond transaction occured. This is a
368: LondConnection. The data received is in the TransactionReply member.
369:
370: =item Client
371:
372: Unix domain socket open on the ultimate client.
1.1 foxr 373:
374: =cut
1.3 albertel 375:
1.1 foxr 376: sub CompleteTransaction {
377: &Debug(6,"Complete transaction");
378: my $Socket = shift;
379: my $Client = shift;
380:
381: my $data = $Socket->GetReply(); # Data to send.
382:
383: &Debug(8," Reply was: ".$data);
384: my $Serial = $ActiveClients{$Client};
385: my $desc = sprintf("Connection to lonc client %d",
386: $Serial);
387: Event->io(fd => $Client,
388: poll => "w",
389: desc => $desc,
390: cb => \&ClientWritable,
391: data => $data);
392: }
1.4 foxr 393: =pod
394: =head2 FailTransaction
395:
396: Finishes a transaction with failure because the associated lond socket
397: disconnected. It is up to our client to retry if desired.
398:
399: Parameters:
400:
401: =item client
402:
403: The UNIX domain socket open on our client.
404:
405: =cut
406:
407: sub FailTransaction {
408: my $client = shift;
409:
410: &Debug(8, "Failing transaction due to disconnect");
411: my $Serial = $ActiveClients{$client};
412: my $desc = sprintf("Connection to lonc client %d", $Serial);
413: my $data = "error: Connection to lond lost\n";
414:
415: Event->io(fd => $client,
416: poll => "w",
417: desc => $desc,
418: cb => \&ClientWritable,
419: data => $data);
420:
421: }
422:
423: =pod
424:
425: =head2 KillSocket
426:
427: Destroys a socket. This function can be called either when a socket
428: has died of 'natural' causes or because a socket needs to be pruned due to
429: idleness. If the socket has died naturally, if there are no longer any
430: live connections a new connection is created (in case there are transactions
431: in the queue). If the socket has been pruned, it is never re-created.
432:
433: Parameters:
1.1 foxr 434:
1.4 foxr 435: =item Socket
436:
437: The socket to kill off.
438:
439: =item Restart
440:
441: nonzero if we are allowed to create a new connection.
442:
443:
444: =cut
445: sub KillSocket {
446: my $Socket = shift;
447: my $Restart= shift;
448:
449: # If the socket came from the active connection set, delete it.
450: # otherwise it came from the idle set and has already been destroyed:
451:
452: if(exists($ActiveTransactions{$Socket})) {
453: delete ($ActiveTransactions{$Socket});
454: }
455: if(exists($ActiveConnections{$Socket})) {
456: delete($ActiveConnections{$Socket});
457: }
458: $ConnectionCount--;
459: if( ($ConnectionCount = 0) && ($Restart)) {
460: MakeLondConnection();
461: }
462:
463: }
1.1 foxr 464:
465: =pod
1.3 albertel 466:
1.1 foxr 467: =head2 LondReadable
1.3 albertel 468:
1.1 foxr 469: This function is called whenever a lond connection
470: is readable. The action is state dependent:
471:
1.3 albertel 472: =head3 State=Initialized
473:
474: We''re waiting for the challenge, this is a no-op until the
1.1 foxr 475: state changes.
1.3 albertel 476:
1.1 foxr 477: =head3 State=Challenged
1.3 albertel 478:
479: The challenge has arrived we need to transition to Writable.
1.1 foxr 480: The connection must echo the challenge back.
1.3 albertel 481:
1.1 foxr 482: =head3 State=ChallengeReplied
1.3 albertel 483:
484: The challenge has been replied to. The we are receiveing the
1.1 foxr 485: 'ok' from the partner.
1.3 albertel 486:
1.1 foxr 487: =head3 State=RequestingKey
1.3 albertel 488:
489: The ok has been received and we need to send the request for
1.1 foxr 490: an encryption key. Transition to writable for that.
1.3 albertel 491:
1.1 foxr 492: =head3 State=ReceivingKey
1.3 albertel 493:
494: The the key has been requested, now we are reading the new key.
495:
1.1 foxr 496: =head3 State=Idle
1.3 albertel 497:
498: The encryption key has been negotiated or we have finished
1.1 foxr 499: reading data from the a transaction. If the callback data has
500: a client as well as the socket iformation, then we are
501: doing a transaction and the data received is relayed to the client
502: before the socket is put on the idle list.
1.3 albertel 503:
1.1 foxr 504: =head3 State=SendingRequest
1.3 albertel 505:
506: I do not think this state can be received here, but if it is,
1.1 foxr 507: the appropriate thing to do is to transition to writable, and send
508: the request.
1.3 albertel 509:
1.1 foxr 510: =head3 State=ReceivingReply
1.3 albertel 511:
512: We finished sending the request to the server and now transition
1.1 foxr 513: to readable to receive the reply.
514:
515: The parameter to this function are:
1.3 albertel 516:
1.1 foxr 517: The event. Implicit in this is the watcher and its data. The data
518: contains at least the lond connection object and, if a
519: transaction is in progress, the socket attached to the local client.
520:
1.3 albertel 521: =cut
1.1 foxr 522:
523: sub LondReadable {
524: my $Event = shift;
525: my $Watcher = $Event->w;
526: my $Socket = $Watcher->data;
527: my $client = undef;
528:
529:
530: my $State = $Socket->GetState(); # All action depends on the state.
531:
532: &Debug(6,"LondReadable called state = ".$State);
533: SocketDump(6, $Socket);
534:
535: if($Socket->Readable() != 0) {
1.4 foxr 536: # bad return from socket read. Currently this means that
537: # The socket has become disconnected. We fail the transaction.
538:
539: if(exists($ActiveTransactions{$Socket})) {
540: Debug(3,"Lond connection lost failing transaction");
541: FailTransaction($ActiveTransactions{$Socket});
542: }
543: $Watcher->cancel();
544: KillSocket($Socket, 1);
545: return;
1.1 foxr 546: }
547: SocketDump(6,$Socket);
548:
549: $State = $Socket->GetState(); # Update in case of transition.
550: &Debug(6, "After read, state is ".$State);
551:
552: if($State eq "Initialized") {
553:
554:
555: } elsif ($State eq "ChallengeReceived") {
556: # The challenge must be echoed back; The state machine
557: # in the connection takes care of setting that up. Just
558: # need to transition to writable:
559:
560: $Watcher->poll("w");
561: $Watcher->cb(\&LondWritable);
562:
563: } elsif ($State eq "ChallengeReplied") {
564:
565:
566: } elsif ($State eq "RequestingKey") {
567: # The ok was received. Now we need to request the key
568: # That requires us to be writable:
569:
570: $Watcher->poll("w");
571: $Watcher->cb(\&LondWritable);
572:
573: } elsif ($State eq "ReceivingKey") {
574:
575: } elsif ($State eq "Idle") {
576: # If necessary, complete a transaction and then go into the
577: # idle queue.
578: if(exists($ActiveTransactions{$Socket})) {
579: Debug(8,"Completing transaction!!");
580: CompleteTransaction($Socket,
581: $ActiveTransactions{$Socket});
582: }
583: $Watcher->cancel();
584: ServerToIdle($Socket); # Next work unit or idle.
585:
586: } elsif ($State eq "SendingRequest") {
587: # We need to be writable for this and probably don't belong
588: # here inthe first place.
589:
590: Deubg(6, "SendingRequest state encountered in readable");
591: $Watcher->poll("w");
592: $Watcher->cb(\&LondWritable);
593:
594: } elsif ($State eq "ReceivingReply") {
595:
596:
597: } else {
598: # Invalid state.
599: Debug(4, "Invalid state in LondReadable");
600: }
601: }
1.3 albertel 602:
1.1 foxr 603: =pod
1.3 albertel 604:
1.1 foxr 605: =head2 LondWritable
1.3 albertel 606:
1.1 foxr 607: This function is called whenever a lond connection
608: becomes writable while there is a writeable monitoring
609: event. The action taken is very state dependent:
1.3 albertel 610:
1.1 foxr 611: =head3 State = Connected
1.3 albertel 612:
613: The connection is in the process of sending the 'init' hailing to the
614: lond on the remote end. The connection object''s Writable member is
615: called. On error, ConnectionError is called to destroy the connection
616: and remove it from the ActiveConnections hash
617:
1.1 foxr 618: =head3 Initialized
1.3 albertel 619:
620: 'init' has been sent, writability monitoring is removed and
621: readability monitoring is started with LondReadable as the callback.
622:
1.1 foxr 623: =head3 ChallengeReceived
1.3 albertel 624:
625: The connection has received the who are you challenge from the remote
626: system, and is in the process of sending the challenge
627: response. Writable is called.
628:
1.1 foxr 629: =head3 ChallengeReplied
1.3 albertel 630:
631: The connection has replied to the initial challenge The we switch to
632: monitoring readability looking for the server to reply with 'ok'.
633:
1.1 foxr 634: =head3 RequestingKey
1.3 albertel 635:
636: The connection is in the process of requesting its encryption key.
637: Writable is called.
638:
1.1 foxr 639: =head3 ReceivingKey
1.3 albertel 640:
641: The connection has sent the request for a key. Switch to readability
642: monitoring to accept the key
643:
1.1 foxr 644: =head3 SendingRequest
1.3 albertel 645:
646: The connection is in the process of sending a request to the server.
647: This request is part of a client transaction. All the states until
648: now represent the client setup protocol. Writable is called.
649:
1.1 foxr 650: =head3 ReceivingReply
651:
1.3 albertel 652: The connection has sent a request. Now it must receive a reply.
653: Readability monitoring is requested.
654:
655: This function is an event handler and therefore receives as
1.1 foxr 656: a parameter the event that has fired. The data for the watcher
657: of this event is a reference to a list of one or two elements,
658: depending on state. The first (and possibly only) element is the
659: socket. The second (present only if a request is in progress)
660: is the socket on which to return a reply to the caller.
661:
662: =cut
1.3 albertel 663:
1.1 foxr 664: sub LondWritable {
665: my $Event = shift;
666: my $Watcher = $Event->w;
667: my @data = $Watcher->data;
668: Debug(6,"LondWritable State = ".$State." data has ".@data." elts.\n");
669:
670: my $Socket = $data[0]; # I know there's at least a socket.
671:
672: # Figure out what to do depending on the state of the socket:
673:
674:
675: my $State = $Socket->GetState();
676:
677:
678: SocketDump(6,$Socket);
679:
680: if ($State eq "Connected") {
681:
682: if ($Socket->Writable() != 0) {
683: # The write resulted in an error.
1.4 foxr 684: # We'll treat this as if the socket got disconnected:
1.5 ! foxr 685:
1.4 foxr 686: $Watcher->cancel();
687: KillSocket($Socket, 1);
688: return;
1.1 foxr 689: }
1.4 foxr 690: # "init" is being sent...
691:
1.1 foxr 692:
693: } elsif ($State eq "Initialized") {
694:
695: # Now that init was sent, we switch
696: # to watching for readability:
697:
698: $Watcher->poll("r");
699: $Watcher->cb(\&LondReadable);
700:
701: } elsif ($State eq "ChallengeReceived") {
702: # We received the challenge, now we
703: # are echoing it back. This is a no-op,
704: # we're waiting for the state to change
705:
706: if($Socket->Writable() != 0) {
1.5 ! foxr 707:
! 708: $Watcher->cancel();
! 709: KillSocket($Socket, 1);
! 710: return;
1.1 foxr 711: }
712:
713: } elsif ($State eq "ChallengeReplied") {
714: # The echo was sent back, so we switch
715: # to watching readability.
716:
717: $Watcher->poll("r");
718: $Watcher->cb(\&LondReadable);
719:
720: } elsif ($State eq "RequestingKey") {
721: # At this time we're requesting the key.
722: # again, this is essentially a no-op.
723: # we'll write the next chunk until the
724: # state changes.
725:
726: if($Socket->Writable() != 0) {
727: # Write resulted in an error.
1.5 ! foxr 728:
! 729: $Watcher->cancel();
! 730: KillSocket($Socket, 1);
! 731: return;
! 732:
1.1 foxr 733: }
734: } elsif ($State eq "ReceivingKey") {
735: # Now we need to wait for the key
736: # to come back from the peer:
737:
738: $Watcher->poll("r");
739: $Watcher->cb(\&LondReadable);
740:
741: } elsif ($State eq "SendingRequest") {
742: # At this time we are sending a request to the
743: # peer... write the next chunk:
744:
745: if($Socket->Writable() != 0) {
746:
1.5 ! foxr 747: if(exists($ActiveTransactions{$Socket})) {
! 748: Debug(3, "Lond connection lost, failing transactions");
! 749: FailTransaction($ActiveTransactions{$Socket});
! 750: }
! 751: $Watcher->cancel();
! 752: KillSocket($Socket, 1);
! 753: return;
! 754:
1.1 foxr 755: }
756:
757: } elsif ($State eq "ReceivingReply") {
758: # The send has completed. Wait for the
759: # data to come in for a reply.
760: Debug(8,"Writable sent request/receiving reply");
761: $Watcher->poll("r");
762: $Watcher->cb(\&LondReadable);
763:
764: } else {
765: # Control only passes here on an error:
766: # the socket state does not match any
767: # of the known states... so an error
768: # must be logged.
769:
770: &Debug(4, "Invalid socket state ".$State."\n");
771: }
772:
773: }
774:
775: =pod
1.3 albertel 776:
1.1 foxr 777: =head2 MakeLondConnection
1.3 albertel 778:
779: Create a new lond connection object, and start it towards its initial
780: idleness. Once idle, it becomes elligible to receive transactions
781: from the work queue. If the work queue is not empty when the
782: connection is completed and becomes idle, it will dequeue an entry and
783: start off on it.
784:
1.1 foxr 785: =cut
1.3 albertel 786:
1.1 foxr 787: sub MakeLondConnection {
788: Debug(4,"MakeLondConnection to ".GetServerHost()." on port "
789: .GetServerPort());
790:
791: my $Connection = LondConnection->new(&GetServerHost(),
792: &GetServerPort());
793:
794: if($Connection == undef) { # Needs to be more robust later.
1.5 ! foxr 795: Debug(0,"Failed to make a connection with lond.");
! 796: } else {
! 797: # The connection needs to have writability
! 798: # monitored in order to send the init sequence
! 799: # that starts the whole authentication/key
! 800: # exchange underway.
! 801: #
! 802: my $Socket = $Connection->GetSocket();
! 803: if($Socket == undef) {
! 804: die "did not get a socket from the connection";
! 805: } else {
! 806: &Debug(9,"MakeLondConnection got socket: ".$Socket);
! 807: }
1.1 foxr 808:
1.5 ! foxr 809:
! 810: $event = Event->io(fd => $Socket,
! 811: poll => 'w',
! 812: cb => \&LondWritable,
! 813: data => ($Connection, undef),
! 814: desc => 'Connection to lond server');
! 815: $ActiveConnections{$Connection} = $event;
! 816:
! 817: $ConnectionCount++;
1.1 foxr 818: }
819:
820: }
1.3 albertel 821:
1.1 foxr 822: =pod
1.3 albertel 823:
1.1 foxr 824: =head2 StartRequest
1.3 albertel 825:
826: Starts a lond request going on a specified lond connection.
827: parameters are:
828:
829: =item $Lond
830:
831: Connection to the lond that will send the transaction and receive the
832: reply.
833:
834: =item $Client
835:
836: Connection to the client that is making this request We got the
837: request from this socket, and when the request has been relayed to
838: lond and we get a reply back from lond it will get sent to this
839: socket.
840:
841: =item $Request
842:
843: The text of the request to send.
844:
1.1 foxr 845: =cut
846:
847: sub StartRequest {
848: my $Lond = shift;
849: my $Client = shift;
850: my $Request = shift;
851:
852: Debug(6, "StartRequest: ".$Request);
853:
854: my $Socket = $Lond->GetSocket();
855:
856: $ActiveTransactions{$Lond} = $Client; # Socket to relay to client.
857:
858: $Lond->InitiateTransaction($Request);
859: $event = Event->io(fd => $Lond->GetSocket(),
860: poll => "w",
861: cb => \&LondWritable,
862: data => $Lond,
863: desc => "lond transaction connection");
864: $ActiveConnections{$Lond} = $event;
865: Debug(8," Start Request made watcher data with ".$event->data."\n");
866: }
867:
868: =pod
1.3 albertel 869:
1.1 foxr 870: =head2 QueueTransaction
1.3 albertel 871:
872: If there is an idle lond connection, it is put to work doing this
873: transaction. Otherwise, the transaction is placed in the work queue.
874: If placed in the work queue and the maximum number of connections has
875: not yet been created, a new connection will be started. Our goal is
876: to eventually have a sufficient number of connections that the work
877: queue will typically be empty. parameters are:
878:
879: =item Socket
880:
881: open on the lonc client.
882:
883: =item Request
884:
885: data to send to the lond.
1.1 foxr 886:
887: =cut
1.3 albertel 888:
1.1 foxr 889: sub QueueTransaction {
890: my $requestSocket = shift;
891: my $requestData = shift;
892:
893: Debug(6,"QueueTransaction: ".$requestData);
894:
895: my $LondSocket = $IdleConnections->pop();
896: if(!defined $LondSocket) { # Need to queue request.
897: Debug(8,"Must queue...");
898: $ClientQueue->enqueue($requestSocket);
899: $WorkQueue->enqueue($requestData);
900: if($ConnectionCount < $MaxConnectionCount) {
901: Debug(4,"Starting additional lond connection");
902: MakeLondConnection();
903: }
904: } else { # Can start the request:
905: Debug(8,"Can start...");
906: StartRequest($LondSocket, $requestSocket, $requestData);
907: }
908: }
909:
910: #-------------------------- Lonc UNIX socket handling ---------------------
1.3 albertel 911:
1.1 foxr 912: =pod
1.3 albertel 913:
1.1 foxr 914: =head2 ClientRequest
1.3 albertel 915:
916: Callback that is called when data can be read from the UNIX domain
917: socket connecting us with an apache server process.
1.1 foxr 918:
919: =cut
920:
921: sub ClientRequest {
922: Debug(6, "ClientRequest");
923: my $event = shift;
924: my $watcher = $event->w;
925: my $socket = $watcher->fd;
926: my $data = $watcher->data;
927: my $thisread;
928:
929: Debug(9, " Watcher named: ".$watcher->desc);
930:
931: my $rv = $socket->recv($thisread, POSIX::BUFSIZ, 0);
932: Debug(8, "rcv: data length = ".length($thisread)
933: ." read =".$thisread);
934: unless (defined $rv && length($thisread)) {
935: # Likely eof on socket.
936: Debug(5,"Client Socket closed on lonc for ".$RemoteHost);
937: close($socket);
938: $watcher->cancel();
939: delete($ActiveClients{$socket});
940: }
941: Debug(8,"Data: ".$data." this read: ".$thisread);
942: $data = $data.$thisread; # Append new data.
943: $watcher->data($data);
944: if($data =~ /(.*\n)/) { # Request entirely read.
945: Debug(8, "Complete transaction received: ".$data);
946: QueueTransaction($socket, $data);
947: $watcher->cancel(); # Done looking for input data.
948: }
949:
950: }
951:
952:
953: =pod
1.3 albertel 954:
1.1 foxr 955: =head2 NewClient
1.3 albertel 956:
957: Callback that is called when a connection is received on the unix
958: socket for a new client of lonc. The callback is parameterized by the
959: event.. which is a-priori assumed to be an io event, and therefore has
960: an fd member that is the Listener socket. We Accept the connection
961: and register a new event on the readability of that socket:
962:
1.1 foxr 963: =cut
1.3 albertel 964:
1.1 foxr 965: sub NewClient {
966: Debug(6, "NewClient");
967: my $event = shift; # Get the event parameters.
968: my $watcher = $event->w;
969: my $socket = $watcher->fd; # Get the event' socket.
970: my $connection = $socket->accept(); # Accept the client connection.
971: Debug(8,"Connection request accepted from "
972: .GetPeername($connection, AF_UNIX));
973:
974:
975: my $description = sprintf("Connection to lonc client %d",
976: $ClientConnection);
977: Debug(9, "Creating event named: ".$description);
978: Event->io(cb => \&ClientRequest,
979: poll => 'r',
980: desc => $description,
981: data => "",
982: fd => $connection);
983: $ActiveClients{$connection} = $ClientConnection;
984: $ClientConnection++;
985: }
1.3 albertel 986:
987: =pod
988:
989: =head2 GetLoncSocketPath
990:
991: Returns the name of the UNIX socket on which to listen for client
992: connections.
1.1 foxr 993:
994: =cut
1.3 albertel 995:
1.1 foxr 996: sub GetLoncSocketPath {
997: return $UnixSocketDir."/".GetServerHost();
998: }
999:
1.3 albertel 1000: =pod
1001:
1002: =head2 GetServerHost
1003:
1004: Returns the host whose lond we talk with.
1005:
1.1 foxr 1006: =cut
1.3 albertel 1007:
1.1 foxr 1008: sub GetServerHost { # Stub - get this from config.
1009: return $RemoteHost; # Setup by the fork.
1010: }
1.3 albertel 1011:
1012: =pod
1013:
1014: =head2 GetServerPort
1015:
1016: Returns the lond port number.
1017:
1.1 foxr 1018: =cut
1.3 albertel 1019:
1.1 foxr 1020: sub GetServerPort { # Stub - get this from config.
1021: return $perlvar{londPort};
1022: }
1.3 albertel 1023:
1024: =pod
1025:
1026: =head2 SetupLoncListener
1027:
1028: Setup a lonc listener event. The event is called when the socket
1029: becomes readable.. that corresponds to the receipt of a new
1030: connection. The event handler established will accept the connection
1031: (creating a communcations channel), that int turn will establish
1032: another event handler to subess requests.
1.1 foxr 1033:
1034: =cut
1.3 albertel 1035:
1.1 foxr 1036: sub SetupLoncListener {
1037:
1038: my $socket;
1039: my $SocketName = GetLoncSocketPath();
1040: unlink($SocketName);
1041: unless ($socket = IO::Socket::UNIX->new(Local => $SocketName,
1042: Listen => 10,
1043: Type => SOCK_STREAM)) {
1044: die "Failed to create a lonc listner socket";
1045: }
1046: Event->io(cb => \&NewClient,
1047: poll => 'r',
1048: desc => 'Lonc listener Unix Socket',
1049: fd => $socket);
1050: }
1051:
1052: =pod
1.3 albertel 1053:
1.1 foxr 1054: =head2 ChildProcess
1055:
1056: This sub implements a child process for a single lonc daemon.
1057:
1058: =cut
1059:
1060: sub ChildProcess {
1061:
1062: print "Loncnew\n";
1063:
1064: # For now turn off signals.
1065:
1066: $SIG{QUIT} = IGNORE;
1067: $SIG{HUP} = IGNORE;
1068: $SIG{USR1} = IGNORE;
1069: $SIG{INT} = IGNORE;
1070: $SIG{CHLD} = IGNORE;
1071: $SIG{__DIE__} = IGNORE;
1072:
1073: SetupTimer();
1074:
1075: SetupLoncListener();
1076:
1077: $Event::Debuglevel = $DebugLevel;
1078:
1079: Debug(9, "Making initial lond connection for ".$RemoteHost);
1080:
1081: # Setup the initial server connection:
1082:
1083: &MakeLondConnection();
1.5 ! foxr 1084:
! 1085: if($ConnectionCount == 0) {
! 1086: Debug(1,"Could not make initial connection..\n");
! 1087: Debug(1,"Will retry when there's work to do\n");
! 1088: }
1.1 foxr 1089: Debug(9,"Entering event loop");
1090: my $ret = Event::loop(); # Start the main event loop.
1091:
1092:
1093: die "Main event loop exited!!!";
1094: }
1095:
1096: # Create a new child for host passed in:
1097:
1098: sub CreateChild {
1099: my $host = shift;
1100: $RemoteHost = $host;
1101: Debug(3, "Forking off child for ".$RemoteHost);
1102: sleep(5);
1103: $pid = fork;
1104: if($pid) { # Parent
1105: $ChildHash{$pid} = $RemoteHost;
1106: } else { # child.
1.5 ! foxr 1107: ShowStatus("Connected to ".$RemoteHost);
1.1 foxr 1108: ChildProcess;
1109: }
1110:
1111: }
1112: #
1113: # Parent process logic pass 1:
1114: # For each entry in the hosts table, we will
1115: # fork off an instance of ChildProcess to service the transactions
1116: # to that host. Each pid will be entered in a global hash
1117: # with the value of the key, the host.
1118: # The parent will then enter a loop to wait for process exits.
1119: # Each exit gets logged and the child gets restarted.
1120: #
1121:
1.5 ! foxr 1122: #
! 1123: # Fork and start in new session so hang-up isn't going to
! 1124: # happen without intent.
! 1125: #
! 1126:
! 1127:
! 1128: ShowStatus("Parent writing pid file:");
! 1129: $execdir = $perlvar{'lonDaemons'};
! 1130: open (PIDSAVE, ">$execdir/logs/lonc.pid");
! 1131: print PIDSAVE "$$\n";
! 1132: close(PIDSAVE);
! 1133:
! 1134: ShowStatus("Forking node servers");
! 1135:
1.1 foxr 1136: my $HostIterator = LondConnection::GetHostIterator;
1137: while (! $HostIterator->end()) {
1138:
1139: $hostentryref = $HostIterator->get();
1140: CreateChild($hostentryref->[0]);
1141: $HostIterator->next();
1142: }
1143:
1144: # Maintain the population:
1.5 ! foxr 1145:
! 1146: ShowStatus("Parent keeping the flock");
1.1 foxr 1147:
1148: while(1) {
1149: $deadchild = wait();
1150: if(exists $ChildHash{$deadchild}) { # need to restart.
1151: $deadhost = $ChildHash{$deadchild};
1152: delete($ChildHash{$deadchild});
1153: Debug(4,"Lost child pid= ".$deadchild.
1154: "Connected to host ".$deadhost);
1155: CreateChild($deadhost);
1156: }
1157: }
1158:
1159: =head1 Theory
1.3 albertel 1160:
1161: The event class is used to build this as a single process with an
1162: event driven model. The following events are handled:
1.1 foxr 1163:
1164: =item UNIX Socket connection Received
1165:
1166: =item Request data arrives on UNIX data transfer socket.
1167:
1168: =item lond connection becomes writable.
1169:
1170: =item timer fires at 1 second intervals.
1171:
1172: All sockets are run in non-blocking mode. Timeouts managed by the timer
1173: handler prevents hung connections.
1174:
1175: Key data structures:
1176:
1.3 albertel 1177: =item RequestQueue
1178:
1179: A queue of requests received from UNIX sockets that are
1180: waiting for a chance to be forwarded on a lond connection socket.
1181:
1182: =item ActiveConnections
1183:
1184: A hash of lond connections that have transactions in process that are
1185: available to be timed out.
1186:
1187: =item ActiveTransactions
1188:
1189: A hash indexed by lond connections that contain the client reply
1190: socket for each connection that has an active transaction on it.
1191:
1192: =item IdleConnections
1193:
1194: A hash of lond connections that have no work to do. These connections
1195: can be closed if they are idle for a long enough time.
1.1 foxr 1196:
1197: =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