Annotation of loncom/loncnew, revision 1.1
1.1 ! foxr 1: #!/usr/bin/perl
! 2: #
! 3: # new lonc handles n requestors spread out bver m connections to londs.
! 4: # This module is based on the Event class.
! 5: # Development iterations:
! 6: # - Setup basic event loop. (done)
! 7: # - Add timer dispatch. (done)
! 8: # - Add ability to accept lonc UNIX domain sockets. (done)
! 9: # - Add ability to create/negotiate lond connections (done).
! 10: # - Add general logic for dispatching requests and timeouts.
! 11: # - Add support for the lonc/lond requests.
! 12: # - Add logging/status monitoring.
! 13: # - Add Signal handling - HUP restarts. USR1 status report.
! 14: # - Add Configuration file I/O
! 15: # - Add Pending request processing on startup.
! 16: # - Add management/status request interface.
! 17:
! 18: use lib "/home/httpd/lib/perl/";
! 19: use lib "/home/foxr/newloncapa/types";
! 20: use Event qw(:DEFAULT );
! 21: use POSIX qw(:signal_h);
! 22: use IO::Socket;
! 23: use IO::Socket::INET;
! 24: use IO::Socket::UNIX;
! 25: use Socket;
! 26: use Crypt::IDEA;
! 27: use LONCAPA::Queue;
! 28: use LONCAPA::Stack;
! 29: use LONCAPA::LondConnection;
! 30: use LONCAPA::Configuration;
! 31: use LONCAPA::HashIterator;
! 32:
! 33: print "Loncnew starting\n";
! 34:
! 35: #
! 36: # Disable all signals we might receive from outside for now.
! 37: #
! 38: $SIG{QUIT} = IGNORE;
! 39: $SIG{HUP} = IGNORE;
! 40: $SIG{USR1} = IGNORE;
! 41: $SIG{INT} = IGNORE;
! 42: $SIG{CHLD} = IGNORE;
! 43: $SIG{__DIE__} = IGNORE;
! 44:
! 45:
! 46: # Read the httpd configuration file to get perl variables
! 47: # normally set in apache modules:
! 48:
! 49: my $perlvarref = LONCAPA::Configuration::read_conf('loncapa.conf');
! 50: my %perlvar = %{$perlvarref};
! 51:
! 52: #
! 53: # parent and shared variables.
! 54:
! 55: my %ChildHash; # by pid -> host.
! 56:
! 57:
! 58: my $MaxConnectionCount = 5; # Will get from config later.
! 59: my $ClientConnection = 0; # Uniquifier for client events.
! 60:
! 61: my $DebugLevel = 5;
! 62: my $IdleTimeout= 3600; # Wait an hour before pruning connections.
! 63:
! 64: #
! 65: # The variables below are only used by the child processes.
! 66: #
! 67: my $RemoteHost; # Name of host child is talking to.
! 68: my $UnixSocketDir= "/home/httpd/sockets";
! 69: my $IdleConnections = Stack->new(); # Set of idle connections
! 70: my %ActiveConnections; # Connections to the remote lond.
! 71: my %ActiveTransactions; # Transactions in flight.
! 72: my %ActiveClients; # Serial numbers of active clients by socket.
! 73: my $WorkQueue = Queue->new(); # Queue of pending transactions.
! 74: my $ClientQueue = Queue->new(); # Queue of clients causing xactinos.
! 75: my $ConnectionCount = 0;
! 76:
! 77:
! 78: #
! 79: =pod
! 80: =head 2 GetPeerName
! 81: Returns the name of the host that a socket object is connected
! 82: to.
! 83: =cut
! 84:
! 85: sub GetPeername {
! 86: my $connection = shift;
! 87: my $AdrFamily = shift;
! 88: my $peer = $connection->peername();
! 89: my $peerport;
! 90: my $peerip;
! 91: if($AdrFamily == AF_INET) {
! 92: ($peerport, $peerip) = sockaddr_in($peer);
! 93: my $peername = gethostbyaddr($iaddr, $AdrFamily);
! 94: return $peername;
! 95: } elsif ($AdrFamily == AF_UNIX) {
! 96: my $peerfile;
! 97: ($peerfile) = sockaddr_un($peer);
! 98: return $peerfile;
! 99: }
! 100: }
! 101: #----------------------------- Timer management ------------------------
! 102: =pod
! 103: =head2 Debug
! 104: Invoked to issue a debug message.
! 105: =cut
! 106: sub Debug {
! 107: my $level = shift;
! 108: my $message = shift;
! 109: if ($level <= $DebugLevel) {
! 110: print $message." host = ".$RemoteHost."\n";
! 111: }
! 112: }
! 113:
! 114: sub SocketDump {
! 115: my $level = shift;
! 116: my $socket= shift;
! 117: if($level <= $DebugLevel) {
! 118: $socket->Dump();
! 119: }
! 120: }
! 121: =pod
! 122: =head2 Tick
! 123: Invoked each timer tick.
! 124: =cut
! 125:
! 126: sub Tick {
! 127: my $client;
! 128: Debug(6, "Tick");
! 129: Debug(6, " Current connection count: ".$ConnectionCount);
! 130: foreach $client (keys %ActiveClients) {
! 131: Debug(7, " Have client: with id: ".$ActiveClients{$client});
! 132: }
! 133: }
! 134:
! 135: =pod
! 136: =head2 SetupTimer
! 137: Sets up a 1 per sec recurring timer event. The event handler is used to:
! 138:
! 139: =item Trigger timeouts on communications along active sockets.
! 140: =item Trigger disconnections of idle sockets.
! 141:
! 142:
! 143: =cut
! 144:
! 145: sub SetupTimer {
! 146: Debug(6, "SetupTimer");
! 147: Event->timer(interval => 1, debug => 1, cb => \&Tick );
! 148: }
! 149: =pod
! 150: =head2 ServerToIdle
! 151: This function is called when a connection to the server is
! 152: ready for more work.
! 153: If there is work in the Work queue the top element is dequeued
! 154: and the connection will start to work on it. If the work queue is
! 155: empty, the connection is pushed on the idle connection stack where
! 156: it will either get another work unit, or alternatively, if it sits there
! 157: long enough, it will be shut down and released.
! 158:
! 159:
! 160: =cut
! 161: sub ServerToIdle {
! 162: my $Socket = shift; # Get the socket.
! 163:
! 164: &Debug(6, "Server to idle");
! 165:
! 166: # If there's work to do, start the transaction:
! 167:
! 168: $reqdata = $WorkQueue->dequeue();
! 169: Debug(9, "Queue gave request data: ".$reqdata);
! 170: unless($reqdata eq undef) {
! 171: my $unixSocket = $ClientQueue->dequeue();
! 172: &Debug(6, "Starting new work request");
! 173: &Debug(7, "Request: ".$reqdata);
! 174:
! 175: &StartRequest($Socket, $unixSocket, $reqdata);
! 176: } else {
! 177:
! 178: # There's no work waiting, so push the server to idle list.
! 179: &Debug(8, "No new work requests, server connection going idle");
! 180: delete($ActiveTransactions{$Socket});
! 181: $IdleConnections->push($Socket);
! 182: }
! 183: }
! 184: =pod
! 185: =head2 ClientWritable
! 186: Event callback for when a client socket is writable.
! 187: This callback is established when a transaction reponse is
! 188: avaiable from lond. The response is forwarded to the unix socket
! 189: as it becomes writable in this sub.
! 190: Parameters:
! 191:
! 192: =item Event - The event that has been triggered. Event->w->data is
! 193: the data and Event->w->fd is the socket to write.
! 194:
! 195: =cut
! 196: sub ClientWritable {
! 197: my $Event = shift;
! 198: my $Watcher = $Event->w;
! 199: my $Data = $Watcher->data;
! 200: my $Socket = $Watcher->fd;
! 201:
! 202: # Try to send the data:
! 203:
! 204: &Debug(6, "ClientWritable writing".$Data);
! 205: &Debug(9, "Socket is: ".$Socket);
! 206:
! 207: my $result = $Socket->send($Data, 0);
! 208:
! 209: # $result undefined: the write failed.
! 210: # otherwise $result is the number of bytes written.
! 211: # Remove that preceding string from the data.
! 212: # If the resulting data is empty, destroy the watcher
! 213: # and set up a read event handler to accept the next
! 214: # request.
! 215:
! 216: &Debug(9,"Send result is ".$result." Defined: ".defined($result));
! 217: if(defined($result)) {
! 218: &Debug(9, "send result was defined");
! 219: if($result == length($Data)) { # Entire string sent.
! 220: &Debug(9, "ClientWritable data all written");
! 221: $Watcher->cancel();
! 222: #
! 223: # Set up to read next request from socket:
! 224:
! 225: my $descr = sprintf("Connection to lonc client %d",
! 226: $ActiveClients{$Socket});
! 227: Event->io(cb => \&ClientRequest,
! 228: poll => 'r',
! 229: desc => $descr,
! 230: data => "",
! 231: fd => $Socket);
! 232:
! 233: } else { # Partial string sent.
! 234: $Watcher->data(substr($Data, $result));
! 235: }
! 236:
! 237: } else { # Error of some sort...
! 238:
! 239: # Some errnos are possible:
! 240: my $errno = $!;
! 241: if($errno == POSIX::EWOULDBLOCK ||
! 242: $errno == POSIX::EAGAIN ||
! 243: $errno == POSIX::EINTR) {
! 244: # No action taken?
! 245: } else { # Unanticipated errno.
! 246: &Debug(5,"ClientWritable error or peer shutdown".$RemoteHost);
! 247: $Watcher->cancel; # Stop the watcher.
! 248: $Socket->shutdown(2); # Kill connection
! 249: $Socket->close(); # Close the socket.
! 250: }
! 251:
! 252: }
! 253: }
! 254:
! 255: =pod
! 256: =head2 CompleteTransaction
! 257: Called when the reply data has been received for a lond
! 258: transaction. The reply data must now be sent to the
! 259: ultimate client on the other end of the Unix socket. This is
! 260: done by setting up a writable event for the socket with the
! 261: data the reply data.
! 262: Parameters:
! 263: =item Socket - Socket on which the lond transaction occured. This
! 264: is a LondConnection. The data received is in the
! 265: TransactionReply member.
! 266: =item Client - Unix domain socket open on the ultimate client.
! 267:
! 268: =cut
! 269: sub CompleteTransaction {
! 270: &Debug(6,"Complete transaction");
! 271: my $Socket = shift;
! 272: my $Client = shift;
! 273:
! 274: my $data = $Socket->GetReply(); # Data to send.
! 275:
! 276: &Debug(8," Reply was: ".$data);
! 277: my $Serial = $ActiveClients{$Client};
! 278: my $desc = sprintf("Connection to lonc client %d",
! 279: $Serial);
! 280: Event->io(fd => $Client,
! 281: poll => "w",
! 282: desc => $desc,
! 283: cb => \&ClientWritable,
! 284: data => $data);
! 285: }
! 286:
! 287:
! 288: =pod
! 289: =head2 LondReadable
! 290: This function is called whenever a lond connection
! 291: is readable. The action is state dependent:
! 292:
! 293: =head3 State = Initialized
! 294: We''re waiting for the challenge, this is a no-op until the
! 295: state changes.
! 296: =head3 State=Challenged
! 297: The challenge has arrived we need to transition to Writable.
! 298: The connection must echo the challenge back.
! 299: =head3 State=ChallengeReplied
! 300: The challenge has been replied to. The we are receiveing the
! 301: 'ok' from the partner.
! 302: =head3 State=RequestingKey
! 303: The ok has been received and we need to send the request for
! 304: an encryption key. Transition to writable for that.
! 305: =head3 State=ReceivingKey
! 306: The the key has been requested, now we are reading the new key.
! 307: =head3 State=Idle
! 308: The encryption key has been negotiated or we have finished
! 309: reading data from the a transaction. If the callback data has
! 310: a client as well as the socket iformation, then we are
! 311: doing a transaction and the data received is relayed to the client
! 312: before the socket is put on the idle list.
! 313: =head3 State=SendingRequest
! 314: I do not think this state can be received here, but if it is,
! 315: the appropriate thing to do is to transition to writable, and send
! 316: the request.
! 317: =head3 State=ReceivingReply
! 318: We finished sending the request to the server and now transition
! 319: to readable to receive the reply.
! 320:
! 321: The parameter to this function are:
! 322: The event. Implicit in this is the watcher and its data. The data
! 323: contains at least the lond connection object and, if a
! 324: transaction is in progress, the socket attached to the local client.
! 325:
! 326:
! 327: =cut
! 328: sub LondReadable {
! 329: my $Event = shift;
! 330: my $Watcher = $Event->w;
! 331: my $Socket = $Watcher->data;
! 332: my $client = undef;
! 333:
! 334:
! 335: my $State = $Socket->GetState(); # All action depends on the state.
! 336:
! 337: &Debug(6,"LondReadable called state = ".$State);
! 338: SocketDump(6, $Socket);
! 339:
! 340: if($Socket->Readable() != 0) {
! 341: # bad return from socket read.
! 342: }
! 343: SocketDump(6,$Socket);
! 344:
! 345: $State = $Socket->GetState(); # Update in case of transition.
! 346: &Debug(6, "After read, state is ".$State);
! 347:
! 348: if($State eq "Initialized") {
! 349:
! 350:
! 351: } elsif ($State eq "ChallengeReceived") {
! 352: # The challenge must be echoed back; The state machine
! 353: # in the connection takes care of setting that up. Just
! 354: # need to transition to writable:
! 355:
! 356: $Watcher->poll("w");
! 357: $Watcher->cb(\&LondWritable);
! 358:
! 359: } elsif ($State eq "ChallengeReplied") {
! 360:
! 361:
! 362: } elsif ($State eq "RequestingKey") {
! 363: # The ok was received. Now we need to request the key
! 364: # That requires us to be writable:
! 365:
! 366: $Watcher->poll("w");
! 367: $Watcher->cb(\&LondWritable);
! 368:
! 369: } elsif ($State eq "ReceivingKey") {
! 370:
! 371: } elsif ($State eq "Idle") {
! 372: # If necessary, complete a transaction and then go into the
! 373: # idle queue.
! 374: if(exists($ActiveTransactions{$Socket})) {
! 375: Debug(8,"Completing transaction!!");
! 376: CompleteTransaction($Socket,
! 377: $ActiveTransactions{$Socket});
! 378: }
! 379: $Watcher->cancel();
! 380: ServerToIdle($Socket); # Next work unit or idle.
! 381:
! 382: } elsif ($State eq "SendingRequest") {
! 383: # We need to be writable for this and probably don't belong
! 384: # here inthe first place.
! 385:
! 386: Deubg(6, "SendingRequest state encountered in readable");
! 387: $Watcher->poll("w");
! 388: $Watcher->cb(\&LondWritable);
! 389:
! 390: } elsif ($State eq "ReceivingReply") {
! 391:
! 392:
! 393: } else {
! 394: # Invalid state.
! 395: Debug(4, "Invalid state in LondReadable");
! 396: }
! 397: }
! 398: =pod
! 399: =head2 LondWritable
! 400: This function is called whenever a lond connection
! 401: becomes writable while there is a writeable monitoring
! 402: event. The action taken is very state dependent:
! 403: =head3 State = Connected
! 404: The connection is in the process of sending the
! 405: 'init' hailing to the lond on the remote end.
! 406: The connection object''s Writable member is called.
! 407: On error, ConnectionError is called to destroy
! 408: the connection and remove it from the ActiveConnections
! 409: hash
! 410: =head3 Initialized
! 411: 'init' has been sent, writability monitoring is
! 412: removed and readability monitoring is started
! 413: with LondReadable as the callback.
! 414: =head3 ChallengeReceived
! 415: The connection has received the who are you
! 416: challenge from the remote system, and is in the
! 417: process of sending the challenge response.
! 418: Writable is called.
! 419: =head3 ChallengeReplied
! 420: The connection has replied to the initial challenge
! 421: The we switch to monitoring readability looking
! 422: for the server to reply with 'ok'.
! 423: =head3 RequestingKey
! 424: The connection is in the process of requesting its
! 425: encryption key. Writable is called.
! 426: =head3 ReceivingKey
! 427: The connection has sent the request for a key.
! 428: Switch to readability monitoring to accept the key
! 429: =head3 SendingRequest
! 430: The connection is in the process of sending a
! 431: request to the server. This request is part of
! 432: a client transaction. All the states until now
! 433: represent the client setup protocol. Writable
! 434: is called.
! 435: =head3 ReceivingReply
! 436: The connection has sent a request. Now it must
! 437: receive a reply. Readability monitoring is
! 438: requested.
! 439:
! 440: This function is an event handler and therefore receives as
! 441: a parameter the event that has fired. The data for the watcher
! 442: of this event is a reference to a list of one or two elements,
! 443: depending on state. The first (and possibly only) element is the
! 444: socket. The second (present only if a request is in progress)
! 445: is the socket on which to return a reply to the caller.
! 446:
! 447: =cut
! 448: sub LondWritable {
! 449: my $Event = shift;
! 450: my $Watcher = $Event->w;
! 451: my @data = $Watcher->data;
! 452: Debug(6,"LondWritable State = ".$State." data has ".@data." elts.\n");
! 453:
! 454: my $Socket = $data[0]; # I know there's at least a socket.
! 455:
! 456: # Figure out what to do depending on the state of the socket:
! 457:
! 458:
! 459: my $State = $Socket->GetState();
! 460:
! 461:
! 462: SocketDump(6,$Socket);
! 463:
! 464: if ($State eq "Connected") {
! 465: # "init" is being sent...
! 466:
! 467: if ($Socket->Writable() != 0) {
! 468: # The write resulted in an error.
! 469: }
! 470:
! 471: } elsif ($State eq "Initialized") {
! 472:
! 473: # Now that init was sent, we switch
! 474: # to watching for readability:
! 475:
! 476: $Watcher->poll("r");
! 477: $Watcher->cb(\&LondReadable);
! 478:
! 479: } elsif ($State eq "ChallengeReceived") {
! 480: # We received the challenge, now we
! 481: # are echoing it back. This is a no-op,
! 482: # we're waiting for the state to change
! 483:
! 484: if($Socket->Writable() != 0) {
! 485: # Write of the next chunk resulted in an error.
! 486: }
! 487:
! 488: } elsif ($State eq "ChallengeReplied") {
! 489: # The echo was sent back, so we switch
! 490: # to watching readability.
! 491:
! 492: $Watcher->poll("r");
! 493: $Watcher->cb(\&LondReadable);
! 494:
! 495: } elsif ($State eq "RequestingKey") {
! 496: # At this time we're requesting the key.
! 497: # again, this is essentially a no-op.
! 498: # we'll write the next chunk until the
! 499: # state changes.
! 500:
! 501: if($Socket->Writable() != 0) {
! 502: # Write resulted in an error.
! 503: }
! 504:
! 505: } elsif ($State eq "ReceivingKey") {
! 506: # Now we need to wait for the key
! 507: # to come back from the peer:
! 508:
! 509: $Watcher->poll("r");
! 510: $Watcher->cb(\&LondReadable);
! 511:
! 512: } elsif ($State eq "SendingRequest") {
! 513: # At this time we are sending a request to the
! 514: # peer... write the next chunk:
! 515:
! 516: if($Socket->Writable() != 0) {
! 517: # Write resulted in an error.
! 518:
! 519: }
! 520:
! 521: } elsif ($State eq "ReceivingReply") {
! 522: # The send has completed. Wait for the
! 523: # data to come in for a reply.
! 524: Debug(8,"Writable sent request/receiving reply");
! 525: $Watcher->poll("r");
! 526: $Watcher->cb(\&LondReadable);
! 527:
! 528: } else {
! 529: # Control only passes here on an error:
! 530: # the socket state does not match any
! 531: # of the known states... so an error
! 532: # must be logged.
! 533:
! 534: &Debug(4, "Invalid socket state ".$State."\n");
! 535: }
! 536:
! 537: }
! 538:
! 539: =pod
! 540: =head2 MakeLondConnection
! 541: Create a new lond connection object, and start it towards
! 542: its initial idleness. Once idle, it becomes elligible to
! 543: receive transactions from the work queue. If the work queue
! 544: is not empty when the connection is completed and becomes idle,
! 545: it will dequeue an entry and start off on it.
! 546: =cut
! 547: sub MakeLondConnection {
! 548: Debug(4,"MakeLondConnection to ".GetServerHost()." on port "
! 549: .GetServerPort());
! 550:
! 551: my $Connection = LondConnection->new(&GetServerHost(),
! 552: &GetServerPort());
! 553:
! 554: if($Connection == undef) { # Needs to be more robust later.
! 555: die "Failed to make a connection!!".$!."\n";
! 556:
! 557: }
! 558: # The connection needs to have writability
! 559: # monitored in order to send the init sequence
! 560: # that starts the whole authentication/key
! 561: # exchange underway.
! 562: #
! 563: my $Socket = $Connection->GetSocket();
! 564: if($Socket == undef) {
! 565: die "did not get a socket from the connection";
! 566: } else {
! 567: &Debug(9,"MakeLondConnection got socket: ".$Socket);
! 568: }
! 569:
! 570:
! 571: $event = Event->io(fd => $Socket,
! 572: poll => 'w',
! 573: cb => \&LondWritable,
! 574: data => ($Connection, undef),
! 575: desc => 'Connection to lond server');
! 576: $ActiveConnections{$Lond} = $event;
! 577:
! 578: $ConnectionCount++;
! 579:
! 580:
! 581: }
! 582: =pod
! 583: =head2 StartRequest
! 584: Starts a lond request going on a specified lond connection.
! 585: parameters are:
! 586: =item $Lond - Connection to the lond that will send the transaction
! 587: and receive the reply.
! 588: =item $Client - Connection to the client that is making this request
! 589: We got the request from this socket, and when the request has
! 590: been relayed to lond and we get a reply back from lond it will
! 591: get sent to this socket.
! 592: =item $Request - The text of the request to send.
! 593: =cut
! 594:
! 595: sub StartRequest {
! 596: my $Lond = shift;
! 597: my $Client = shift;
! 598: my $Request = shift;
! 599:
! 600: Debug(6, "StartRequest: ".$Request);
! 601:
! 602: my $Socket = $Lond->GetSocket();
! 603:
! 604: $ActiveTransactions{$Lond} = $Client; # Socket to relay to client.
! 605:
! 606: $Lond->InitiateTransaction($Request);
! 607: $event = Event->io(fd => $Lond->GetSocket(),
! 608: poll => "w",
! 609: cb => \&LondWritable,
! 610: data => $Lond,
! 611: desc => "lond transaction connection");
! 612: $ActiveConnections{$Lond} = $event;
! 613: Debug(8," Start Request made watcher data with ".$event->data."\n");
! 614: }
! 615:
! 616: =pod
! 617: =head2 QueueTransaction
! 618: - If there is an idle lond connection, it is put to
! 619: work doing this transaction. Otherwise, the transaction is
! 620: placed in the work queue. If placed in the work queue and the
! 621: maximum number of connections has not yet been created, a new
! 622: connection will be started. Our goal is to eventually have
! 623: a sufficient number of connections that the work queue will
! 624: typically be empty.
! 625: parameters are:
! 626: =item Socket open on the lonc client.
! 627: =item Request data to send to the lond.
! 628:
! 629: =cut
! 630: sub QueueTransaction {
! 631: my $requestSocket = shift;
! 632: my $requestData = shift;
! 633:
! 634: Debug(6,"QueueTransaction: ".$requestData);
! 635:
! 636: my $LondSocket = $IdleConnections->pop();
! 637: if(!defined $LondSocket) { # Need to queue request.
! 638: Debug(8,"Must queue...");
! 639: $ClientQueue->enqueue($requestSocket);
! 640: $WorkQueue->enqueue($requestData);
! 641: if($ConnectionCount < $MaxConnectionCount) {
! 642: Debug(4,"Starting additional lond connection");
! 643: MakeLondConnection();
! 644: }
! 645: } else { # Can start the request:
! 646: Debug(8,"Can start...");
! 647: StartRequest($LondSocket, $requestSocket, $requestData);
! 648: }
! 649: }
! 650:
! 651: #-------------------------- Lonc UNIX socket handling ---------------------
! 652: =pod
! 653: =head2 ClientRequest
! 654: Callback that is called when data can be read from the
! 655: UNIX domain socket connecting us with an apache server process.
! 656:
! 657: =cut
! 658:
! 659: sub ClientRequest {
! 660: Debug(6, "ClientRequest");
! 661: my $event = shift;
! 662: my $watcher = $event->w;
! 663: my $socket = $watcher->fd;
! 664: my $data = $watcher->data;
! 665: my $thisread;
! 666:
! 667: Debug(9, " Watcher named: ".$watcher->desc);
! 668:
! 669: my $rv = $socket->recv($thisread, POSIX::BUFSIZ, 0);
! 670: Debug(8, "rcv: data length = ".length($thisread)
! 671: ." read =".$thisread);
! 672: unless (defined $rv && length($thisread)) {
! 673: # Likely eof on socket.
! 674: Debug(5,"Client Socket closed on lonc for ".$RemoteHost);
! 675: close($socket);
! 676: $watcher->cancel();
! 677: delete($ActiveClients{$socket});
! 678: }
! 679: Debug(8,"Data: ".$data." this read: ".$thisread);
! 680: $data = $data.$thisread; # Append new data.
! 681: $watcher->data($data);
! 682: if($data =~ /(.*\n)/) { # Request entirely read.
! 683: Debug(8, "Complete transaction received: ".$data);
! 684: QueueTransaction($socket, $data);
! 685: $watcher->cancel(); # Done looking for input data.
! 686: }
! 687:
! 688: }
! 689:
! 690:
! 691: =pod
! 692: =head2 NewClient
! 693: Callback that is called when a connection is received on the
! 694: unix socket for a new client of lonc. The callback is parameterized
! 695: by the event.. which is a-priori assumed to be an io event, and therefore
! 696: has an fd member that is the Listener socket. We Accept the connection
! 697: and register a new event on the readability of that socket:
! 698: =cut
! 699: sub NewClient {
! 700: Debug(6, "NewClient");
! 701: my $event = shift; # Get the event parameters.
! 702: my $watcher = $event->w;
! 703: my $socket = $watcher->fd; # Get the event' socket.
! 704: my $connection = $socket->accept(); # Accept the client connection.
! 705: Debug(8,"Connection request accepted from "
! 706: .GetPeername($connection, AF_UNIX));
! 707:
! 708:
! 709: my $description = sprintf("Connection to lonc client %d",
! 710: $ClientConnection);
! 711: Debug(9, "Creating event named: ".$description);
! 712: Event->io(cb => \&ClientRequest,
! 713: poll => 'r',
! 714: desc => $description,
! 715: data => "",
! 716: fd => $connection);
! 717: $ActiveClients{$connection} = $ClientConnection;
! 718: $ClientConnection++;
! 719: }
! 720: =pod GetLoncSocketPath
! 721: Returns the name of the UNIX socket on which to listen for client
! 722: connections.
! 723:
! 724: =cut
! 725: sub GetLoncSocketPath {
! 726: return $UnixSocketDir."/".GetServerHost();
! 727: }
! 728:
! 729: =pod GetServerHost
! 730: Returns the host whose lond we talk with.
! 731: =cut
! 732: sub GetServerHost { # Stub - get this from config.
! 733: return $RemoteHost; # Setup by the fork.
! 734: }
! 735: =pod GetServerPort
! 736: Returns the lond port number.
! 737: =cut
! 738: sub GetServerPort { # Stub - get this from config.
! 739: return $perlvar{londPort};
! 740: }
! 741: =pod SetupLoncListener
! 742: Setup a lonc listener event. The event is called when
! 743: the socket becomes readable.. that corresponds to the
! 744: receipt of a new connection. The event handler established
! 745: will accept the connection (creating a communcations channel), that
! 746: int turn will establish another event handler to subess requests.
! 747:
! 748: =cut
! 749: sub SetupLoncListener {
! 750:
! 751: my $socket;
! 752: my $SocketName = GetLoncSocketPath();
! 753: unlink($SocketName);
! 754: unless ($socket = IO::Socket::UNIX->new(Local => $SocketName,
! 755: Listen => 10,
! 756: Type => SOCK_STREAM)) {
! 757: die "Failed to create a lonc listner socket";
! 758: }
! 759: Event->io(cb => \&NewClient,
! 760: poll => 'r',
! 761: desc => 'Lonc listener Unix Socket',
! 762: fd => $socket);
! 763: }
! 764:
! 765: =pod
! 766: =head2 ChildProcess
! 767:
! 768: This sub implements a child process for a single lonc daemon.
! 769:
! 770: =cut
! 771:
! 772: sub ChildProcess {
! 773:
! 774: print "Loncnew\n";
! 775:
! 776: # For now turn off signals.
! 777:
! 778: $SIG{QUIT} = IGNORE;
! 779: $SIG{HUP} = IGNORE;
! 780: $SIG{USR1} = IGNORE;
! 781: $SIG{INT} = IGNORE;
! 782: $SIG{CHLD} = IGNORE;
! 783: $SIG{__DIE__} = IGNORE;
! 784:
! 785: SetupTimer();
! 786:
! 787: SetupLoncListener();
! 788:
! 789: $Event::Debuglevel = $DebugLevel;
! 790:
! 791: Debug(9, "Making initial lond connection for ".$RemoteHost);
! 792:
! 793: # Setup the initial server connection:
! 794:
! 795: &MakeLondConnection();
! 796:
! 797: Debug(9,"Entering event loop");
! 798: my $ret = Event::loop(); # Start the main event loop.
! 799:
! 800:
! 801: die "Main event loop exited!!!";
! 802: }
! 803:
! 804: # Create a new child for host passed in:
! 805:
! 806: sub CreateChild {
! 807: my $host = shift;
! 808: $RemoteHost = $host;
! 809: Debug(3, "Forking off child for ".$RemoteHost);
! 810: sleep(5);
! 811: $pid = fork;
! 812: if($pid) { # Parent
! 813: $ChildHash{$pid} = $RemoteHost;
! 814: } else { # child.
! 815: ChildProcess;
! 816: }
! 817:
! 818: }
! 819: #
! 820: # Parent process logic pass 1:
! 821: # For each entry in the hosts table, we will
! 822: # fork off an instance of ChildProcess to service the transactions
! 823: # to that host. Each pid will be entered in a global hash
! 824: # with the value of the key, the host.
! 825: # The parent will then enter a loop to wait for process exits.
! 826: # Each exit gets logged and the child gets restarted.
! 827: #
! 828:
! 829: my $HostIterator = LondConnection::GetHostIterator;
! 830: while (! $HostIterator->end()) {
! 831:
! 832: $hostentryref = $HostIterator->get();
! 833: CreateChild($hostentryref->[0]);
! 834: $HostIterator->next();
! 835: }
! 836:
! 837: # Maintain the population:
! 838:
! 839: while(1) {
! 840: $deadchild = wait();
! 841: if(exists $ChildHash{$deadchild}) { # need to restart.
! 842: $deadhost = $ChildHash{$deadchild};
! 843: delete($ChildHash{$deadchild});
! 844: Debug(4,"Lost child pid= ".$deadchild.
! 845: "Connected to host ".$deadhost);
! 846: CreateChild($deadhost);
! 847: }
! 848: }
! 849:
! 850: =head1 Theory
! 851: The event class is used to build this as a single process with
! 852: an event driven model. The following events are handled:
! 853:
! 854: =item UNIX Socket connection Received
! 855:
! 856: =item Request data arrives on UNIX data transfer socket.
! 857:
! 858: =item lond connection becomes writable.
! 859:
! 860: =item timer fires at 1 second intervals.
! 861:
! 862: All sockets are run in non-blocking mode. Timeouts managed by the timer
! 863: handler prevents hung connections.
! 864:
! 865: Key data structures:
! 866: =item RequestQueue - A queue of requests received from UNIX sockets that are
! 867: waiting for a chance to be forwarded on a lond connection socket.
! 868:
! 869: =item ActiveConnections - A hash of lond connections that have transactions
! 870: in process that are available to be timed out.
! 871:
! 872: =item ActiveTransactions - A hash indexed by lond connections that
! 873: contain the client reply socket for each connection that has an active
! 874: transaction on it.
! 875:
! 876: =item IdleConnections - A hash of lond connections that have no work
! 877: to do. These connections can be closed if they are idle for a long
! 878: enough time.
! 879: =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