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