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