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