Annotation of loncom/loncnew, revision 1.110
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.110 ! raeburn 5: # $Id: loncnew,v 1.109 2020/01/12 01:21:33 raeburn 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).
1.17 foxr 10: ## LON-CAPA is free software; you can redistribute it and/or modify
1.2 albertel 11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
1.1 foxr 28: #
1.97 raeburn 29: # new lonc handles n request out over m connections to londs.
1.1 foxr 30: # This module is based on the Event class.
31: # Development iterations:
32: # - Setup basic event loop. (done)
33: # - Add timer dispatch. (done)
34: # - Add ability to accept lonc UNIX domain sockets. (done)
35: # - Add ability to create/negotiate lond connections (done).
1.7 foxr 36: # - Add general logic for dispatching requests and timeouts. (done).
37: # - Add support for the lonc/lond requests. (done).
1.38 foxr 38: # - Add logging/status monitoring. (done)
39: # - Add Signal handling - HUP restarts. USR1 status report. (done)
1.7 foxr 40: # - Add Configuration file I/O (done).
1.38 foxr 41: # - Add management/status request interface. (done)
1.8 foxr 42: # - Add deferred request capability. (done)
1.38 foxr 43: # - Detect transmission timeouts. (done)
1.7 foxr 44: #
45:
1.23 foxr 46: use strict;
1.1 foxr 47: use lib "/home/httpd/lib/perl/";
48: use Event qw(:DEFAULT );
49: use POSIX qw(:signal_h);
1.12 foxr 50: use POSIX;
1.1 foxr 51: use IO::Socket;
52: use IO::Socket::INET;
53: use IO::Socket::UNIX;
1.9 foxr 54: use IO::File;
1.6 foxr 55: use IO::Handle;
1.1 foxr 56: use Socket;
57: use Crypt::IDEA;
58: use LONCAPA::Queue;
59: use LONCAPA::Stack;
60: use LONCAPA::LondConnection;
1.7 foxr 61: use LONCAPA::LondTransaction;
1.1 foxr 62: use LONCAPA::Configuration;
1.67 albertel 63: use Fcntl qw(:flock);
1.1 foxr 64:
65:
66: # Read the httpd configuration file to get perl variables
67: # normally set in apache modules:
68:
69: my $perlvarref = LONCAPA::Configuration::read_conf('loncapa.conf');
70: my %perlvar = %{$perlvarref};
71:
72: #
73: # parent and shared variables.
74:
1.83 albertel 75: my %ChildPid; # by pid -> host.
76: my %ChildHost; # by host.
1.105 raeburn 77: my %ChildKeyMode; # by pid -> keymode
1.62 foxr 78: my %listening_to; # Socket->host table for who the parent
79: # is listening to.
80: my %parent_dispatchers; # host-> listener watcher events.
1.1 foxr 81:
1.65 foxr 82: my %parent_handlers; # Parent signal handlers...
83:
1.9 foxr 84: my $MaxConnectionCount = 10; # Will get from config later.
1.1 foxr 85: my $ClientConnection = 0; # Uniquifier for client events.
86:
1.9 foxr 87: my $DebugLevel = 0;
1.29 foxr 88: my $NextDebugLevel= 2; # So Sigint can toggle this.
1.94 foxr 89: my $IdleTimeout= 5*60; # Seconds to wait prior to pruning connections.
1.1 foxr 90:
1.39 foxr 91: my $LogTransactions = 0; # When True, all transactions/replies get logged.
1.65 foxr 92: my $executable = $0; # Get the full path to me.
1.39 foxr 93:
1.1 foxr 94: #
95: # The variables below are only used by the child processes.
96: #
1.107 raeburn 97: my $RemoteHost; # Hostname of host child is talking to.
98: my $RemoteHostId; # lonid of host child is talking to.
99: my $RemoteDefHostId; # default lonhostID of host child is talking to.
1.110 ! raeburn 100: my $RemoteLoncapaRev; # LON-CAPA version of host child is talking to,
! 101: # if 2.12.0 or newer, format: X.Y.Z
1.82 albertel 102: my @all_host_ids;
1.20 albertel 103: my $UnixSocketDir= $perlvar{'lonSockDir'};
1.1 foxr 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.
109: my $ConnectionCount = 0;
1.4 foxr 110: my $IdleSeconds = 0; # Number of seconds idle.
1.9 foxr 111: my $Status = ""; # Current status string.
1.14 foxr 112: my $RecentLogEntry = "";
1.72 albertel 113: my $ConnectionRetries=5; # Number of connection retries allowed.
114: my $ConnectionRetriesLeft=5; # Number of connection retries remaining.
1.40 foxr 115: my $LondVersion = "unknown"; # Version of lond we talk with.
1.49 foxr 116: my $KeyMode = ""; # e.g. ssl, local, insecure from last connect.
1.54 foxr 117: my $LondConnecting = 0; # True when a connection is being built.
1.1 foxr 118:
1.60 foxr 119:
120:
1.62 foxr 121: my $I_am_child = 0; # True if this is the child process.
1.57 foxr 122:
1.1 foxr 123: #
1.9 foxr 124: # The hash below gives the HTML format for log messages
125: # given a severity.
126: #
127: my %LogFormats;
128:
1.45 albertel 129: $LogFormats{"CRITICAL"} = "<font color='red'>CRITICAL: %s</font>";
130: $LogFormats{"SUCCESS"} = "<font color='green'>SUCCESS: %s</font>";
131: $LogFormats{"INFO"} = "<font color='yellow'>INFO: %s</font>";
132: $LogFormats{"WARNING"} = "<font color='blue'>WARNING: %s</font>";
1.9 foxr 133: $LogFormats{"DEFAULT"} = " %s ";
134:
1.10 foxr 135:
1.57 foxr 136: # UpdateStatus;
137: # Update the idle status display to show how many connections
138: # are left, retries and other stuff.
139: #
140: sub UpdateStatus {
141: if ($ConnectionRetriesLeft > 0) {
142: ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount
143: ." Retries remaining: ".$ConnectionRetriesLeft
144: ." ($KeyMode)");
145: } else {
146: ShowStatus(GetServerHost()." >> DEAD <<");
147: }
148: }
149:
1.10 foxr 150:
151: =pod
152:
153: =head2 LogPerm
154:
155: Makes an entry into the permanent log file.
156:
157: =cut
1.69 matthew 158:
1.10 foxr 159: sub LogPerm {
160: my $message=shift;
161: my $execdir=$perlvar{'lonDaemons'};
162: my $now=time;
163: my $local=localtime($now);
164: my $fh=IO::File->new(">>$execdir/logs/lonnet.perm.log");
1.86 albertel 165: chomp($message);
1.10 foxr 166: print $fh "$now:$message:$local\n";
167: }
1.9 foxr 168:
169: =pod
170:
171: =head2 Log
172:
173: Logs a message to the log file.
174: Parameters:
175:
176: =item severity
177:
178: One of CRITICAL, WARNING, INFO, SUCCESS used to select the
179: format string used to format the message. if the severity is
180: not a defined severity the Default format string is used.
181:
182: =item message
183:
184: The base message. In addtion to the format string, the message
185: will be appended to a string containing the name of our remote
186: host and the time will be formatted into the message.
187:
188: =cut
189:
190: sub Log {
1.47 foxr 191:
192: my ($severity, $message) = @_;
193:
1.9 foxr 194: if(!$LogFormats{$severity}) {
195: $severity = "DEFAULT";
196: }
197:
198: my $format = $LogFormats{$severity};
199:
200: # Put the window dressing in in front of the message format:
201:
202: my $now = time;
203: my $local = localtime($now);
204: my $finalformat = "$local ($$) [$RemoteHost] [$Status] ";
1.76 albertel 205: $finalformat = $finalformat.$format."\n";
1.9 foxr 206:
207: # open the file and put the result.
208:
209: my $execdir = $perlvar{'lonDaemons'};
210: my $fh = IO::File->new(">>$execdir/logs/lonc.log");
211: my $msg = sprintf($finalformat, $message);
1.14 foxr 212: $RecentLogEntry = $msg;
1.9 foxr 213: print $fh $msg;
214:
1.10 foxr 215:
1.9 foxr 216: }
1.6 foxr 217:
1.3 albertel 218:
1.1 foxr 219: =pod
1.3 albertel 220:
221: =head2 GetPeerName
222:
223: Returns the name of the host that a socket object is connected to.
224:
1.1 foxr 225: =cut
226:
227: sub GetPeername {
1.47 foxr 228:
229:
230: my ($connection, $AdrFamily) = @_;
231:
1.1 foxr 232: my $peer = $connection->peername();
233: my $peerport;
234: my $peerip;
235: if($AdrFamily == AF_INET) {
236: ($peerport, $peerip) = sockaddr_in($peer);
1.23 foxr 237: my $peername = gethostbyaddr($peerip, $AdrFamily);
1.1 foxr 238: return $peername;
239: } elsif ($AdrFamily == AF_UNIX) {
240: my $peerfile;
241: ($peerfile) = sockaddr_un($peer);
242: return $peerfile;
243: }
244: }
245: =pod
1.3 albertel 246:
1.1 foxr 247: =head2 Debug
1.3 albertel 248:
249: Invoked to issue a debug message.
250:
1.1 foxr 251: =cut
1.3 albertel 252:
1.1 foxr 253: sub Debug {
1.47 foxr 254:
255: my ($level, $message) = @_;
256:
1.1 foxr 257: if ($level <= $DebugLevel) {
1.23 foxr 258: Log("INFO", "-Debug- $message host = $RemoteHost");
1.1 foxr 259: }
260: }
261:
262: sub SocketDump {
1.47 foxr 263:
264: my ($level, $socket) = @_;
265:
1.1 foxr 266: if($level <= $DebugLevel) {
1.48 foxr 267: $socket->Dump(-1); # Ensure it will get dumped.
1.1 foxr 268: }
269: }
1.3 albertel 270:
1.1 foxr 271: =pod
1.3 albertel 272:
1.5 foxr 273: =head2 ShowStatus
274:
275: Place some text as our pid status.
1.10 foxr 276: and as what we return in a SIGUSR1
1.5 foxr 277:
278: =cut
1.69 matthew 279:
1.5 foxr 280: sub ShowStatus {
1.10 foxr 281: my $state = shift;
282: my $now = time;
283: my $local = localtime($now);
284: $Status = $local.": ".$state;
285: $0='lonc: '.$state.' '.$local;
1.5 foxr 286: }
287:
288: =pod
289:
1.69 matthew 290: =head2 SocketTimeout
1.15 foxr 291:
292: Called when an action on the socket times out. The socket is
293: destroyed and any active transaction is failed.
294:
295:
296: =cut
1.69 matthew 297:
1.15 foxr 298: sub SocketTimeout {
299: my $Socket = shift;
1.38 foxr 300: Log("WARNING", "A socket timeout was detected");
1.52 foxr 301: Debug(5, " SocketTimeout called: ");
1.48 foxr 302: $Socket->Dump(0);
1.42 foxr 303: if(exists($ActiveTransactions{$Socket})) {
1.43 albertel 304: FailTransaction($ActiveTransactions{$Socket});
1.42 foxr 305: }
1.22 foxr 306: KillSocket($Socket); # A transaction timeout also counts as
307: # a connection failure:
308: $ConnectionRetriesLeft--;
1.42 foxr 309: if($ConnectionRetriesLeft <= 0) {
1.52 foxr 310: Log("CRITICAL", "Host marked DEAD: ".GetServerHost());
1.56 foxr 311: $LondConnecting = 0;
1.42 foxr 312: }
313:
1.15 foxr 314: }
1.80 albertel 315:
1.64 foxr 316: #
317: # This function should be called by the child in all cases where it must
1.80 albertel 318: # exit. The child process must create a lock file for the AF_UNIX socket
319: # in order to prevent connection requests from lonnet in the time between
320: # process exit and the parent picking up the listen again.
321: #
1.64 foxr 322: # Parameters:
323: # exit_code - Exit status value, however see the next parameter.
324: # message - If this optional parameter is supplied, the exit
325: # is via a die with this message.
326: #
327: sub child_exit {
328: my ($exit_code, $message) = @_;
329:
330: # Regardless of how we exit, we may need to do the lock thing:
331:
1.80 albertel 332: #
333: # Create a lock file since there will be a time window
334: # between our exit and the parent's picking up the listen
335: # during which no listens will be done on the
336: # lonnet client socket.
337: #
338: my $lock_file = &GetLoncSocketPath().".lock";
339: open(LOCK,">$lock_file");
340: print LOCK "Contents not important";
341: close(LOCK);
1.81 albertel 342: unlink(&GetLoncSocketPath());
1.64 foxr 343:
1.80 albertel 344: if ($message) {
345: die($message);
1.64 foxr 346: } else {
347: exit($exit_code);
348: }
349: }
1.35 foxr 350: #----------------------------- Timer management ------------------------
1.15 foxr 351:
352: =pod
353:
1.1 foxr 354: =head2 Tick
1.3 albertel 355:
1.97 raeburn 356: Invoked each timer tick.
1.3 albertel 357:
1.1 foxr 358: =cut
359:
1.5 foxr 360:
1.1 foxr 361: sub Tick {
1.52 foxr 362: my ($Event) = @_;
363: my $clock_watcher = $Event->w;
364:
1.1 foxr 365: my $client;
1.57 foxr 366: UpdateStatus();
367:
1.4 foxr 368: # Is it time to prune connection count:
369:
370:
371: if($IdleConnections->Count() &&
372: ($WorkQueue->Count() == 0)) { # Idle connections and nothing to do?
1.52 foxr 373: $IdleSeconds++;
1.4 foxr 374: if($IdleSeconds > $IdleTimeout) { # Prune a connection...
1.23 foxr 375: my $Socket = $IdleConnections->pop();
1.6 foxr 376: KillSocket($Socket);
1.54 foxr 377: $IdleSeconds = 0; # Otherwise all connections get trimmed to fast.
1.57 foxr 378: UpdateStatus();
1.80 albertel 379: if(($ConnectionCount == 0)) {
1.64 foxr 380: &child_exit(0);
381:
1.57 foxr 382: }
1.4 foxr 383: }
384: } else {
385: $IdleSeconds = 0; # Reset idle count if not idle.
386: }
1.15 foxr 387: #
388: # For each inflight transaction, tick down its timeout counter.
389: #
1.35 foxr 390:
1.34 albertel 391: foreach my $item (keys %ActiveConnections) {
392: my $State = $ActiveConnections{$item}->data->GetState();
1.35 foxr 393: if ($State ne 'Idle') {
1.34 albertel 394: Debug(5,"Ticking Socket $State $item");
395: $ActiveConnections{$item}->data->Tick();
396: }
1.15 foxr 397: }
1.5 foxr 398: # Do we have work in the queue, but no connections to service them?
399: # If so, try to make some new connections to get things going again.
400: #
1.57 foxr 401: # Note this code is dead now...
402: #
1.5 foxr 403: my $Requests = $WorkQueue->Count();
1.56 foxr 404: if (($ConnectionCount == 0) && ($Requests > 0) && (!$LondConnecting)) {
1.10 foxr 405: if ($ConnectionRetriesLeft > 0) {
1.56 foxr 406: Debug(5,"Work but no connections, Make a new one");
407: my $success;
408: $success = &MakeLondConnection;
409: if($success == 0) { # All connections failed:
1.29 foxr 410: Debug(5,"Work in queue failed to make any connectiouns\n");
1.22 foxr 411: EmptyQueue(); # Fail pending transactions with con_lost.
1.42 foxr 412: CloseAllLondConnections(); # Should all be closed but....
1.10 foxr 413: }
414: } else {
1.56 foxr 415: $LondConnecting = 0;
1.22 foxr 416: ShowStatus(GetServerHost()." >>> DEAD!!! <<<");
1.29 foxr 417: Debug(5,"Work in queue, but gave up on connections..flushing\n");
1.10 foxr 418: EmptyQueue(); # Connections can't be established.
1.42 foxr 419: CloseAllLondConnections(); # Should all already be closed but...
1.5 foxr 420: }
421:
422: }
1.49 foxr 423: if ($ConnectionCount == 0) {
424: $KeyMode = "";
1.52 foxr 425: $clock_watcher->cancel();
1.49 foxr 426: }
1.66 albertel 427: &UpdateStatus();
1.1 foxr 428: }
429:
430: =pod
1.3 albertel 431:
1.1 foxr 432: =head2 SetupTimer
433:
1.3 albertel 434: Sets up a 1 per sec recurring timer event. The event handler is used to:
1.1 foxr 435:
1.3 albertel 436: =item
437:
438: Trigger timeouts on communications along active sockets.
439:
440: =item
441:
442: Trigger disconnections of idle sockets.
1.1 foxr 443:
444: =cut
445:
446: sub SetupTimer {
1.52 foxr 447: Debug(6, "SetupTimer");
1.92 foxr 448: Event->timer(interval => 1, cb => \&Tick,
449: hard => 1);
1.1 foxr 450: }
1.3 albertel 451:
1.1 foxr 452: =pod
1.3 albertel 453:
1.1 foxr 454: =head2 ServerToIdle
1.3 albertel 455:
456: This function is called when a connection to the server is
457: ready for more work.
458:
459: If there is work in the Work queue the top element is dequeued
1.1 foxr 460: and the connection will start to work on it. If the work queue is
461: empty, the connection is pushed on the idle connection stack where
462: it will either get another work unit, or alternatively, if it sits there
463: long enough, it will be shut down and released.
464:
1.3 albertel 465: =cut
1.1 foxr 466:
467: sub ServerToIdle {
468: my $Socket = shift; # Get the socket.
1.49 foxr 469: $KeyMode = $Socket->{AuthenticationMode};
1.7 foxr 470: delete($ActiveTransactions{$Socket}); # Server has no transaction
1.1 foxr 471:
1.29 foxr 472: &Debug(5, "Server to idle");
1.1 foxr 473:
474: # If there's work to do, start the transaction:
475:
1.23 foxr 476: my $reqdata = $WorkQueue->dequeue(); # This is a LondTransaction
1.29 foxr 477: if ($reqdata ne undef) {
478: Debug(5, "Queue gave request data: ".$reqdata->getRequest());
1.7 foxr 479: &StartRequest($Socket, $reqdata);
1.8 foxr 480:
1.1 foxr 481: } else {
482:
483: # There's no work waiting, so push the server to idle list.
1.29 foxr 484: &Debug(5, "No new work requests, server connection going idle");
1.1 foxr 485: $IdleConnections->push($Socket);
486: }
487: }
1.3 albertel 488:
1.1 foxr 489: =pod
1.3 albertel 490:
1.1 foxr 491: =head2 ClientWritable
1.3 albertel 492:
493: Event callback for when a client socket is writable.
494:
1.97 raeburn 495: This callback is established when a transaction response is
496: available from lond. The response is forwarded to the unix socket
1.3 albertel 497: as it becomes writable in this sub.
498:
1.1 foxr 499: Parameters:
500:
1.3 albertel 501: =item Event
502:
503: The event that has been triggered. Event->w->data is
504: the data and Event->w->fd is the socket to write.
1.1 foxr 505:
506: =cut
1.3 albertel 507:
1.1 foxr 508: sub ClientWritable {
509: my $Event = shift;
510: my $Watcher = $Event->w;
1.84 albertel 511: if (!defined($Watcher)) {
512: &child_exit(-1,'No watcher for event in ClientWritable');
513: }
1.1 foxr 514: my $Data = $Watcher->data;
515: my $Socket = $Watcher->fd;
516:
517: # Try to send the data:
518:
519: &Debug(6, "ClientWritable writing".$Data);
520: &Debug(9, "Socket is: ".$Socket);
521:
1.6 foxr 522: if($Socket->connected) {
523: my $result = $Socket->send($Data, 0);
524:
525: # $result undefined: the write failed.
526: # otherwise $result is the number of bytes written.
527: # Remove that preceding string from the data.
528: # If the resulting data is empty, destroy the watcher
529: # and set up a read event handler to accept the next
530: # request.
531:
532: &Debug(9,"Send result is ".$result." Defined: ".defined($result));
1.29 foxr 533: if($result ne undef) {
1.6 foxr 534: &Debug(9, "send result was defined");
535: if($result == length($Data)) { # Entire string sent.
536: &Debug(9, "ClientWritable data all written");
537: $Watcher->cancel();
538: #
539: # Set up to read next request from socket:
540:
541: my $descr = sprintf("Connection to lonc client %d",
542: $ActiveClients{$Socket});
543: Event->io(cb => \&ClientRequest,
544: poll => 'r',
545: desc => $descr,
546: data => "",
547: fd => $Socket);
548:
549: } else { # Partial string sent.
550: $Watcher->data(substr($Data, $result));
1.15 foxr 551: if($result == 0) { # client hung up on us!!
1.52 foxr 552: # Log("INFO", "lonc pipe client hung up on us!");
1.15 foxr 553: $Watcher->cancel;
554: $Socket->shutdown(2);
555: $Socket->close();
556: }
1.6 foxr 557: }
558:
559: } else { # Error of some sort...
560:
561: # Some errnos are possible:
562: my $errno = $!;
563: if($errno == POSIX::EWOULDBLOCK ||
564: $errno == POSIX::EAGAIN ||
565: $errno == POSIX::EINTR) {
1.96 foxr 566: # No action taken...the socket will be writable firing the event again
567: # which will result in a retry of the write.
1.6 foxr 568: } else { # Unanticipated errno.
569: &Debug(5,"ClientWritable error or peer shutdown".$RemoteHost);
570: $Watcher->cancel; # Stop the watcher.
571: $Socket->shutdown(2); # Kill connection
572: $Socket->close(); # Close the socket.
573: }
1.1 foxr 574:
575: }
1.6 foxr 576: } else {
577: $Watcher->cancel(); # A delayed request...just cancel.
1.84 albertel 578: return;
1.1 foxr 579: }
580: }
581:
582: =pod
1.3 albertel 583:
1.1 foxr 584: =head2 CompleteTransaction
1.3 albertel 585:
586: Called when the reply data has been received for a lond
1.1 foxr 587: transaction. The reply data must now be sent to the
588: ultimate client on the other end of the Unix socket. This is
589: done by setting up a writable event for the socket with the
590: data the reply data.
1.3 albertel 591:
1.1 foxr 592: Parameters:
1.3 albertel 593:
594: =item Socket
595:
1.97 raeburn 596: Socket on which the lond transaction occurred. This is a
597: LondConnection. The data received are in the TransactionReply member.
1.3 albertel 598:
1.7 foxr 599: =item Transaction
1.3 albertel 600:
1.7 foxr 601: The transaction that is being completed.
1.1 foxr 602:
603: =cut
1.3 albertel 604:
1.1 foxr 605: sub CompleteTransaction {
1.29 foxr 606: &Debug(5,"Complete transaction");
1.47 foxr 607:
608: my ($Socket, $Transaction) = @_;
1.1 foxr 609:
1.7 foxr 610: if (!$Transaction->isDeferred()) { # Normal transaction
611: my $data = $Socket->GetReply(); # Data to send.
1.39 foxr 612: if($LogTransactions) {
613: Log("SUCCESS", "Reply from lond: '$data'");
614: }
1.7 foxr 615: StartClientReply($Transaction, $data);
616: } else { # Delete deferred transaction file.
1.9 foxr 617: Log("SUCCESS", "A delayed transaction was completed");
1.109 raeburn 618: LogPerm("S:".$Transaction->getClient().":".$Transaction->getRequest());
1.86 albertel 619: unlink($Transaction->getFile());
1.7 foxr 620: }
1.6 foxr 621: }
1.42 foxr 622:
1.6 foxr 623: =pod
1.42 foxr 624:
1.6 foxr 625: =head1 StartClientReply
626:
627: Initiates a reply to a client where the reply data is a parameter.
628:
1.7 foxr 629: =head2 parameters:
630:
631: =item Transaction
632:
633: The transaction for which we are responding to the client.
634:
635: =item data
636:
1.97 raeburn 637: The data to send to apache client.
1.7 foxr 638:
1.6 foxr 639: =cut
1.42 foxr 640:
1.6 foxr 641: sub StartClientReply {
1.1 foxr 642:
1.47 foxr 643: my ($Transaction, $data) = @_;
1.12 foxr 644:
1.7 foxr 645: my $Client = $Transaction->getClient();
646:
1.1 foxr 647: &Debug(8," Reply was: ".$data);
648: my $Serial = $ActiveClients{$Client};
649: my $desc = sprintf("Connection to lonc client %d",
650: $Serial);
651: Event->io(fd => $Client,
652: poll => "w",
653: desc => $desc,
654: cb => \&ClientWritable,
655: data => $data);
656: }
1.42 foxr 657:
1.4 foxr 658: =pod
1.42 foxr 659:
1.4 foxr 660: =head2 FailTransaction
661:
662: Finishes a transaction with failure because the associated lond socket
1.7 foxr 663: disconnected. There are two possibilities:
664: - The transaction is deferred: in which case we just quietly
665: delete the transaction since there is no client connection.
666: - The transaction is 'live' in which case we initiate the sending
667: of "con_lost" to the client.
668:
1.42 foxr 669: Deleting the transaction means killing it from the %ActiveTransactions hash.
1.4 foxr 670:
671: Parameters:
672:
673: =item client
674:
1.7 foxr 675: The LondTransaction we are failing.
1.42 foxr 676:
1.4 foxr 677: =cut
678:
679: sub FailTransaction {
1.7 foxr 680: my $transaction = shift;
1.52 foxr 681:
682: # If the socket is dead, that's already logged.
683:
684: if ($ConnectionRetriesLeft > 0) {
685: Log("WARNING", "Failing transaction "
1.71 albertel 686: .$transaction->getLoggableRequest());
1.52 foxr 687: }
1.71 albertel 688: Debug(1, "Failing transaction: ".$transaction->getLoggableRequest());
1.10 foxr 689: if (!$transaction->isDeferred()) { # If the transaction is deferred we'll get to it.
1.11 foxr 690: my $client = $transaction->getClient();
1.30 foxr 691: Debug(1," Replying con_lost to ".$transaction->getRequest());
1.11 foxr 692: StartClientReply($transaction, "con_lost\n");
1.7 foxr 693: }
1.4 foxr 694:
695: }
696:
697: =pod
1.69 matthew 698:
1.6 foxr 699: =head1 EmptyQueue
1.7 foxr 700:
1.6 foxr 701: Fails all items in the work queue with con_lost.
1.7 foxr 702: Note that each item in the work queue is a transaction.
703:
1.6 foxr 704: =cut
1.69 matthew 705:
1.6 foxr 706: sub EmptyQueue {
1.22 foxr 707: $ConnectionRetriesLeft--; # Counts as connection failure too.
1.6 foxr 708: while($WorkQueue->Count()) {
1.10 foxr 709: my $request = $WorkQueue->dequeue(); # This is a transaction
1.7 foxr 710: FailTransaction($request);
1.6 foxr 711: }
712: }
713:
714: =pod
1.4 foxr 715:
1.9 foxr 716: =head2 CloseAllLondConnections
717:
718: Close all connections open on lond prior to exit e.g.
719:
720: =cut
1.69 matthew 721:
1.9 foxr 722: sub CloseAllLondConnections {
1.23 foxr 723: foreach my $Socket (keys %ActiveConnections) {
1.42 foxr 724: if(exists($ActiveTransactions{$Socket})) {
725: FailTransaction($ActiveTransactions{$Socket});
726: }
727: KillSocket($Socket);
1.9 foxr 728: }
729: }
730:
731: =pod
732:
1.4 foxr 733: =head2 KillSocket
734:
735: Destroys a socket. This function can be called either when a socket
736: has died of 'natural' causes or because a socket needs to be pruned due to
737: idleness. If the socket has died naturally, if there are no longer any
738: live connections a new connection is created (in case there are transactions
739: in the queue). If the socket has been pruned, it is never re-created.
740:
741: Parameters:
1.1 foxr 742:
1.4 foxr 743: =item Socket
744:
745: The socket to kill off.
746:
1.105 raeburn 747: =item restart
1.4 foxr 748:
1.97 raeburn 749: non-zero if we are allowed to create a new connection.
1.4 foxr 750:
1.69 matthew 751: =cut
1.4 foxr 752:
753: sub KillSocket {
754: my $Socket = shift;
1.105 raeburn 755: my $restart = shift;
1.4 foxr 756:
1.17 foxr 757: Log("WARNING", "Shutting down a socket");
1.9 foxr 758: $Socket->Shutdown();
759:
1.7 foxr 760: # If the socket came from the active connection set,
761: # delete its transaction... note that FailTransaction should
762: # already have been called!!!
763: # otherwise it came from the idle set.
764: #
1.4 foxr 765:
766: if(exists($ActiveTransactions{$Socket})) {
767: delete ($ActiveTransactions{$Socket});
768: }
769: if(exists($ActiveConnections{$Socket})) {
1.90 foxr 770: $ActiveConnections{$Socket}->cancel;
1.4 foxr 771: delete($ActiveConnections{$Socket});
1.105 raeburn 772: # Decrement ConnectionCount unless we will immediately
773: # re-connect (i.e., $restart is true), because this was
774: # a connection where the SSL channel for exchange of the
775: # shared key failed, and we may use an insecure channel.
776: unless ($restart) {
777: $ConnectionCount--;
778: }
1.37 albertel 779: if ($ConnectionCount < 0) { $ConnectionCount = 0; }
1.4 foxr 780: }
1.6 foxr 781: # If the connection count has gone to zero and there is work in the
782: # work queue, the work all gets failed with con_lost.
783: #
1.105 raeburn 784:
1.6 foxr 785: if($ConnectionCount == 0) {
1.98 foxr 786: $LondConnecting = 0; # No connections so also not connecting.
1.22 foxr 787: EmptyQueue();
1.105 raeburn 788: CloseAllLondConnections(); # Should all already be closed but...
789: &clear_childpid($$);
1.4 foxr 790: }
1.90 foxr 791: UpdateStatus();
1.4 foxr 792: }
1.1 foxr 793:
794: =pod
1.3 albertel 795:
1.1 foxr 796: =head2 LondReadable
1.3 albertel 797:
1.1 foxr 798: This function is called whenever a lond connection
799: is readable. The action is state dependent:
800:
1.3 albertel 801: =head3 State=Initialized
802:
1.100 raeburn 803: We are waiting for the challenge, this is a no-op until the
1.1 foxr 804: state changes.
1.3 albertel 805:
1.1 foxr 806: =head3 State=Challenged
1.3 albertel 807:
808: The challenge has arrived we need to transition to Writable.
1.1 foxr 809: The connection must echo the challenge back.
1.3 albertel 810:
1.1 foxr 811: =head3 State=ChallengeReplied
1.3 albertel 812:
1.97 raeburn 813: The challenge has been replied to. Then we are receiving the
1.1 foxr 814: 'ok' from the partner.
1.3 albertel 815:
1.40 foxr 816: =head3 State=ReadingVersionString
817:
818: We have requested the lond version and are reading the
819: version back. Upon completion, we'll store the version away
820: for future use(?).
821:
822: =head3 State=HostSet
823:
824: We have selected the domain name of our peer (multhomed hosts)
825: and are getting the reply (presumably ok) back.
826:
1.1 foxr 827: =head3 State=RequestingKey
1.3 albertel 828:
829: The ok has been received and we need to send the request for
1.1 foxr 830: an encryption key. Transition to writable for that.
1.3 albertel 831:
1.1 foxr 832: =head3 State=ReceivingKey
1.3 albertel 833:
834: The the key has been requested, now we are reading the new key.
835:
1.1 foxr 836: =head3 State=Idle
1.3 albertel 837:
838: The encryption key has been negotiated or we have finished
1.97 raeburn 839: reading data from the a transaction. If the callback data have
1.99 raeburn 840: a client as well as the socket information, then we are
1.97 raeburn 841: doing a transaction and the data received are relayed to the client
1.1 foxr 842: before the socket is put on the idle list.
1.3 albertel 843:
1.1 foxr 844: =head3 State=SendingRequest
1.3 albertel 845:
846: I do not think this state can be received here, but if it is,
1.1 foxr 847: the appropriate thing to do is to transition to writable, and send
848: the request.
1.3 albertel 849:
1.1 foxr 850: =head3 State=ReceivingReply
1.3 albertel 851:
852: We finished sending the request to the server and now transition
1.1 foxr 853: to readable to receive the reply.
854:
855: The parameter to this function are:
1.3 albertel 856:
1.1 foxr 857: The event. Implicit in this is the watcher and its data. The data
1.97 raeburn 858: contain at least the lond connection object and, if a
1.1 foxr 859: transaction is in progress, the socket attached to the local client.
860:
1.3 albertel 861: =cut
1.1 foxr 862:
863: sub LondReadable {
1.8 foxr 864:
1.41 albertel 865: my $Event = shift;
866: my $Watcher = $Event->w;
867: my $Socket = $Watcher->data;
868: my $client = undef;
1.40 foxr 869:
1.41 albertel 870: &Debug(6,"LondReadable called state = ".$Socket->GetState());
1.40 foxr 871:
872:
1.41 albertel 873: my $State = $Socket->GetState(); # All action depends on the state.
1.40 foxr 874:
1.41 albertel 875: SocketDump(6, $Socket);
876: my $status = $Socket->Readable();
1.40 foxr 877:
1.41 albertel 878: &Debug(2, "Socket->Readable returned: $status");
1.40 foxr 879:
1.41 albertel 880: if($status != 0) {
881: # bad return from socket read. Currently this means that
882: # The socket has become disconnected. We fail the transaction.
1.40 foxr 883:
1.41 albertel 884: Log("WARNING",
885: "Lond connection lost.");
1.105 raeburn 886: my $state_on_exit = $Socket->GetState();
1.41 albertel 887: if(exists($ActiveTransactions{$Socket})) {
888: FailTransaction($ActiveTransactions{$Socket});
1.56 foxr 889: } else {
890: # Socket is connecting and failed... need to mark
891: # no longer connecting.
892: $LondConnecting = 0;
1.41 albertel 893: }
894: $Watcher->cancel();
1.105 raeburn 895: if ($state_on_exit eq 'ReInitNoSSL') {
896: # SSL certificate verification failed, and insecure connection
897: # allowed. Send restart arg to KillSocket(), so EmptyQueue()
898: # is not called, as we still hope to process queued request.
899:
900: KillSocket($Socket,1);
901:
902: # Re-initiate creation of Lond Connection for use with queued
903: # request.
904:
905: ShowStatus("Connected to ".$RemoteHost);
906: Log("WARNING","No SSL channel (verification failed), will try with insecure channel");
907: &MakeLondConnection(1);
908:
909: } else {
910: KillSocket($Socket);
911: $ConnectionRetriesLeft--; # Counts as connection failure
912: }
1.41 albertel 913: return;
914: }
915: SocketDump(6,$Socket);
1.17 foxr 916:
1.41 albertel 917: $State = $Socket->GetState(); # Update in case of transition.
918: &Debug(6, "After read, state is ".$State);
1.1 foxr 919:
1.41 albertel 920: if($State eq "Initialized") {
1.1 foxr 921:
922:
1.105 raeburn 923: } elsif ($State eq "ReInitNoSSL") {
924:
1.41 albertel 925: } elsif ($State eq "ChallengeReceived") {
1.1 foxr 926: # The challenge must be echoed back; The state machine
927: # in the connection takes care of setting that up. Just
928: # need to transition to writable:
1.41 albertel 929:
930: $Watcher->cb(\&LondWritable);
931: $Watcher->poll("w");
1.1 foxr 932:
1.41 albertel 933: } elsif ($State eq "ChallengeReplied") {
1.1 foxr 934:
1.41 albertel 935: } elsif ($State eq "RequestingVersion") {
936: # Need to ask for the version... that is writiability:
1.1 foxr 937:
1.41 albertel 938: $Watcher->cb(\&LondWritable);
939: $Watcher->poll("w");
940:
941: } elsif ($State eq "ReadingVersionString") {
942: # Read the rest of the version string...
943: } elsif ($State eq "SetHost") {
944: # Need to request the actual domain get set...
945:
946: $Watcher->cb(\&LondWritable);
947: $Watcher->poll("w");
948: } elsif ($State eq "HostSet") {
949: # Reading the 'ok' from the peer.
950:
951: } elsif ($State eq "RequestingKey") {
1.1 foxr 952: # The ok was received. Now we need to request the key
953: # That requires us to be writable:
954:
1.41 albertel 955: $Watcher->cb(\&LondWritable);
956: $Watcher->poll("w");
1.1 foxr 957:
1.41 albertel 958: } elsif ($State eq "ReceivingKey") {
1.1 foxr 959:
1.41 albertel 960: } elsif ($State eq "Idle") {
1.105 raeburn 961:
962: if ($ConnectionCount == 1) {
963: # Write child Pid file to keep track of ssl and insecure
964: # connections
965:
966: &record_childpid($Socket);
967: }
968:
1.41 albertel 969: # This is as good a spot as any to get the peer version
970: # string:
1.40 foxr 971:
1.41 albertel 972: if($LondVersion eq "unknown") {
973: $LondVersion = $Socket->PeerVersion();
974: Log("INFO", "Connected to lond version: $LondVersion");
975: }
1.1 foxr 976: # If necessary, complete a transaction and then go into the
977: # idle queue.
1.22 foxr 978: # Note that a trasition to idle indicates a live lond
979: # on the other end so reset the connection retries.
980: #
1.41 albertel 981: $ConnectionRetriesLeft = $ConnectionRetries; # success resets the count
982: $Watcher->cancel();
983: if(exists($ActiveTransactions{$Socket})) {
984: Debug(5,"Completing transaction!!");
985: CompleteTransaction($Socket,
986: $ActiveTransactions{$Socket});
987: } else {
1.95 foxr 988: my $count = $Socket->GetClientData();
989: Log("SUCCESS", "Connection ".$count." to "
1.41 albertel 990: .$RemoteHost." now ready for action");
991: }
992: ServerToIdle($Socket); # Next work unit or idle.
1.54 foxr 993:
994: #
995: $LondConnecting = 0; # Best spot I can think of for this.
996: #
1.6 foxr 997:
1.41 albertel 998: } elsif ($State eq "SendingRequest") {
1.1 foxr 999: # We need to be writable for this and probably don't belong
1000: # here inthe first place.
1001:
1.73 albertel 1002: Debug(6, "SendingRequest state encountered in readable");
1.41 albertel 1003: $Watcher->poll("w");
1004: $Watcher->cb(\&LondWritable);
1.1 foxr 1005:
1.41 albertel 1006: } elsif ($State eq "ReceivingReply") {
1.1 foxr 1007:
1008:
1.41 albertel 1009: } else {
1010: # Invalid state.
1011: Debug(4, "Invalid state in LondReadable");
1012: }
1.1 foxr 1013: }
1.3 albertel 1014:
1.1 foxr 1015: =pod
1.3 albertel 1016:
1.1 foxr 1017: =head2 LondWritable
1.3 albertel 1018:
1.1 foxr 1019: This function is called whenever a lond connection
1020: becomes writable while there is a writeable monitoring
1021: event. The action taken is very state dependent:
1.3 albertel 1022:
1.1 foxr 1023: =head3 State = Connected
1.3 albertel 1024:
1025: The connection is in the process of sending the 'init' hailing to the
1.100 raeburn 1026: lond on the remote end. The Writable member of the connection object
1027: is called. On error, call ConnectionError to destroy the connection
1028: and remove it from the ActiveConnections hash.
1.3 albertel 1029:
1.1 foxr 1030: =head3 Initialized
1.3 albertel 1031:
1032: 'init' has been sent, writability monitoring is removed and
1033: readability monitoring is started with LondReadable as the callback.
1034:
1.1 foxr 1035: =head3 ChallengeReceived
1.3 albertel 1036:
1037: The connection has received the who are you challenge from the remote
1038: system, and is in the process of sending the challenge
1039: response. Writable is called.
1040:
1.1 foxr 1041: =head3 ChallengeReplied
1.3 albertel 1042:
1043: The connection has replied to the initial challenge The we switch to
1044: monitoring readability looking for the server to reply with 'ok'.
1045:
1.1 foxr 1046: =head3 RequestingKey
1.3 albertel 1047:
1048: The connection is in the process of requesting its encryption key.
1049: Writable is called.
1050:
1.1 foxr 1051: =head3 ReceivingKey
1.3 albertel 1052:
1053: The connection has sent the request for a key. Switch to readability
1054: monitoring to accept the key
1055:
1.1 foxr 1056: =head3 SendingRequest
1.3 albertel 1057:
1058: The connection is in the process of sending a request to the server.
1059: This request is part of a client transaction. All the states until
1060: now represent the client setup protocol. Writable is called.
1061:
1.1 foxr 1062: =head3 ReceivingReply
1063:
1.3 albertel 1064: The connection has sent a request. Now it must receive a reply.
1065: Readability monitoring is requested.
1066:
1067: This function is an event handler and therefore receives as
1.1 foxr 1068: a parameter the event that has fired. The data for the watcher
1069: of this event is a reference to a list of one or two elements,
1070: depending on state. The first (and possibly only) element is the
1071: socket. The second (present only if a request is in progress)
1072: is the socket on which to return a reply to the caller.
1073:
1074: =cut
1.3 albertel 1075:
1.1 foxr 1076: sub LondWritable {
1077: my $Event = shift;
1078: my $Watcher = $Event->w;
1.8 foxr 1079: my $Socket = $Watcher->data;
1080: my $State = $Socket->GetState();
1.1 foxr 1081:
1.8 foxr 1082: Debug(6,"LondWritable State = ".$State."\n");
1.1 foxr 1083:
1.8 foxr 1084:
1.1 foxr 1085: # Figure out what to do depending on the state of the socket:
1086:
1087:
1088:
1089:
1090: SocketDump(6,$Socket);
1091:
1.42 foxr 1092: # If the socket is writable, we must always write.
1093: # Only by writing will we undergo state transitions.
1094: # Old logic wrote in state specific code below, however
1095: # That forces us at least through another invocation of
1096: # this function after writability is possible again.
1097: # This logic also factors out common code for handling
1098: # write failures... in all cases, write failures
1099: # Kill the socket.
1100: # This logic makes the branches of the >big< if below
1101: # so that the writing states are actually NO-OPs.
1102:
1103: if ($Socket->Writable() != 0) {
1.43 albertel 1104: # The write resulted in an error.
1105: # We'll treat this as if the socket got disconnected:
1106: Log("WARNING", "Connection to ".$RemoteHost.
1107: " has been disconnected");
1108: if(exists($ActiveTransactions{$Socket})) {
1109: FailTransaction($ActiveTransactions{$Socket});
1.56 foxr 1110: } else {
1111: # In the process of conneting, so need to turn that off.
1112:
1113: $LondConnecting = 0;
1.43 albertel 1114: }
1115: $Watcher->cancel();
1116: KillSocket($Socket);
1117: return;
1.42 foxr 1118: }
1119:
1120:
1121:
1.41 albertel 1122: if ($State eq "Connected") {
1.1 foxr 1123:
1.41 albertel 1124: # "init" is being sent...
1.42 foxr 1125:
1.41 albertel 1126: } elsif ($State eq "Initialized") {
1.4 foxr 1127:
1.41 albertel 1128: # Now that init was sent, we switch
1129: # to watching for readability:
1.1 foxr 1130:
1.41 albertel 1131: $Watcher->cb(\&LondReadable);
1132: $Watcher->poll("r");
1.105 raeburn 1133:
1134: } elsif ($State eq "ReInitNoSSL") {
1135:
1.41 albertel 1136: } elsif ($State eq "ChallengeReceived") {
1137: # We received the challenge, now we
1138: # are echoing it back. This is a no-op,
1139: # we're waiting for the state to change
1.1 foxr 1140:
1.41 albertel 1141: } elsif ($State eq "ChallengeReplied") {
1142: # The echo was sent back, so we switch
1143: # to watching readability.
1144:
1145: $Watcher->cb(\&LondReadable);
1146: $Watcher->poll("r");
1147: } elsif ($State eq "RequestingVersion") {
1148: # Sending the peer a version request...
1.42 foxr 1149:
1.41 albertel 1150: } elsif ($State eq "ReadingVersionString") {
1151: # Transition to read since we have sent the
1152: # version command and now just need to read the
1153: # version string from the peer:
1.40 foxr 1154:
1.41 albertel 1155: $Watcher->cb(\&LondReadable);
1156: $Watcher->poll("r");
1.40 foxr 1157:
1.41 albertel 1158: } elsif ($State eq "SetHost") {
1159: # Setting the remote domain...
1.42 foxr 1160:
1.41 albertel 1161: } elsif ($State eq "HostSet") {
1162: # Back to readable to get the ok.
1.40 foxr 1163:
1.41 albertel 1164: $Watcher->cb(\&LondReadable);
1165: $Watcher->poll("r");
1.40 foxr 1166:
1167:
1.41 albertel 1168: } elsif ($State eq "RequestingKey") {
1169: # At this time we're requesting the key.
1170: # again, this is essentially a no-op.
1171:
1172: } elsif ($State eq "ReceivingKey") {
1173: # Now we need to wait for the key
1174: # to come back from the peer:
1175:
1176: $Watcher->cb(\&LondReadable);
1177: $Watcher->poll("r");
1178:
1179: } elsif ($State eq "SendingRequest") {
1.40 foxr 1180:
1.41 albertel 1181: # At this time we are sending a request to the
1.1 foxr 1182: # peer... write the next chunk:
1183:
1.41 albertel 1184:
1185: } elsif ($State eq "ReceivingReply") {
1186: # The send has completed. Wait for the
1187: # data to come in for a reply.
1188: Debug(8,"Writable sent request/receiving reply");
1189: $Watcher->cb(\&LondReadable);
1190: $Watcher->poll("r");
1.1 foxr 1191:
1.41 albertel 1192: } else {
1193: # Control only passes here on an error:
1194: # the socket state does not match any
1195: # of the known states... so an error
1196: # must be logged.
1.1 foxr 1197:
1.41 albertel 1198: &Debug(4, "Invalid socket state ".$State."\n");
1199: }
1.1 foxr 1200:
1201: }
1.81 albertel 1202:
1.6 foxr 1203: =pod
1204:
1205: =cut
1.69 matthew 1206:
1.81 albertel 1207:
1.6 foxr 1208: sub QueueDelayed {
1.8 foxr 1209: Debug(3,"QueueDelayed called");
1210:
1.6 foxr 1211: my $path = "$perlvar{'lonSockDir'}/delayed";
1.8 foxr 1212:
1213: Debug(4, "Delayed path: ".$path);
1.6 foxr 1214: opendir(DIRHANDLE, $path);
1.75 albertel 1215:
1.82 albertel 1216: my $host_id_re = '(?:'.join('|',map {quotemeta($_)} (@all_host_ids)).')';
1.75 albertel 1217: my @alldelayed = grep(/\.$host_id_re$/, readdir(DIRHANDLE));
1.6 foxr 1218: closedir(DIRHANDLE);
1.75 albertel 1219: foreach my $dfname (sort(@alldelayed)) {
1220: my $reqfile = "$path/$dfname";
1221: my ($host_id) = ($dfname =~ /\.([^.]*)$/);
1222: Debug(4, "queueing ".$reqfile." for $host_id");
1.6 foxr 1223: my $Handle = IO::File->new($reqfile);
1224: my $cmd = <$Handle>;
1.8 foxr 1225: chomp $cmd; # There may or may not be a newline...
1.12 foxr 1226: $cmd = $cmd."\n"; # now for sure there's exactly one newline.
1.75 albertel 1227: my $Transaction = LondTransaction->new("sethost:$host_id:$cmd");
1.7 foxr 1228: $Transaction->SetDeferred($reqfile);
1229: QueueTransaction($Transaction);
1.6 foxr 1230: }
1231:
1232: }
1.1 foxr 1233:
1234: =pod
1.3 albertel 1235:
1.1 foxr 1236: =head2 MakeLondConnection
1.3 albertel 1237:
1238: Create a new lond connection object, and start it towards its initial
1.97 raeburn 1239: idleness. Once idle, it becomes eligible to receive transactions
1.3 albertel 1240: from the work queue. If the work queue is not empty when the
1241: connection is completed and becomes idle, it will dequeue an entry and
1242: start off on it.
1243:
1.1 foxr 1244: =cut
1.3 albertel 1245:
1.105 raeburn 1246: sub MakeLondConnection {
1247: my ($restart) = @_;
1.1 foxr 1248: Debug(4,"MakeLondConnection to ".GetServerHost()." on port "
1249: .GetServerPort());
1250:
1251: my $Connection = LondConnection->new(&GetServerHost(),
1.81 albertel 1252: &GetServerPort(),
1.107 raeburn 1253: &GetHostId(),
1.108 raeburn 1254: &GetDefHostId(),
1255: &GetLoncapaRev());
1.1 foxr 1256:
1.105 raeburn 1257: if($Connection eq undef) {
1.9 foxr 1258: Log("CRITICAL","Failed to make a connection with lond.");
1.10 foxr 1259: $ConnectionRetriesLeft--;
1260: return 0; # Failure.
1.5 foxr 1261: } else {
1.82 albertel 1262: $LondConnecting = 1; # Connection in progress.
1.5 foxr 1263: # The connection needs to have writability
1264: # monitored in order to send the init sequence
1265: # that starts the whole authentication/key
1266: # exchange underway.
1267: #
1268: my $Socket = $Connection->GetSocket();
1.30 foxr 1269: if($Socket eq undef) {
1.64 foxr 1270: &child_exit(-1, "did not get a socket from the connection");
1.5 foxr 1271: } else {
1272: &Debug(9,"MakeLondConnection got socket: ".$Socket);
1273: }
1.1 foxr 1274:
1.21 foxr 1275: $Connection->SetTimeoutCallback(\&SocketTimeout);
1276:
1.23 foxr 1277: my $event = Event->io(fd => $Socket,
1.5 foxr 1278: poll => 'w',
1279: cb => \&LondWritable,
1.8 foxr 1280: data => $Connection,
1.5 foxr 1281: desc => 'Connection to lond server');
1282: $ActiveConnections{$Connection} = $event;
1.52 foxr 1283: if ($ConnectionCount == 0) {
1284: &SetupTimer; # Need to handle timeouts with connections...
1285: }
1.105 raeburn 1286: unless ($restart) {
1287: $ConnectionCount++;
1288: }
1.95 foxr 1289: $Connection->SetClientData($ConnectionCount);
1.8 foxr 1290: Debug(4, "Connection count = ".$ConnectionCount);
1.6 foxr 1291: if($ConnectionCount == 1) { # First Connection:
1292: QueueDelayed;
1293: }
1.97 raeburn 1294: Log("SUCCESS", "Created connection ".$ConnectionCount
1.9 foxr 1295: ." to host ".GetServerHost());
1.10 foxr 1296: return 1; # Return success.
1.1 foxr 1297: }
1298:
1299: }
1.3 albertel 1300:
1.1 foxr 1301: =pod
1.3 albertel 1302:
1.1 foxr 1303: =head2 StartRequest
1.3 albertel 1304:
1305: Starts a lond request going on a specified lond connection.
1306: parameters are:
1307:
1308: =item $Lond
1309:
1310: Connection to the lond that will send the transaction and receive the
1311: reply.
1312:
1313: =item $Client
1314:
1.97 raeburn 1315: Connection to the client that is making this request. We got the
1.3 albertel 1316: request from this socket, and when the request has been relayed to
1317: lond and we get a reply back from lond it will get sent to this
1318: socket.
1319:
1320: =item $Request
1321:
1322: The text of the request to send.
1323:
1.1 foxr 1324: =cut
1325:
1326: sub StartRequest {
1.47 foxr 1327:
1328: my ($Lond, $Request) = @_;
1.1 foxr 1329:
1.7 foxr 1330: Debug(6, "StartRequest: ".$Request->getRequest());
1.1 foxr 1331:
1332: my $Socket = $Lond->GetSocket();
1333:
1.7 foxr 1334: $Request->Activate($Lond);
1335: $ActiveTransactions{$Lond} = $Request;
1.1 foxr 1336:
1.7 foxr 1337: $Lond->InitiateTransaction($Request->getRequest());
1.23 foxr 1338: my $event = Event->io(fd => $Socket,
1.1 foxr 1339: poll => "w",
1340: cb => \&LondWritable,
1341: data => $Lond,
1342: desc => "lond transaction connection");
1343: $ActiveConnections{$Lond} = $event;
1344: Debug(8," Start Request made watcher data with ".$event->data."\n");
1345: }
1346:
1347: =pod
1.3 albertel 1348:
1.1 foxr 1349: =head2 QueueTransaction
1.3 albertel 1350:
1351: If there is an idle lond connection, it is put to work doing this
1352: transaction. Otherwise, the transaction is placed in the work queue.
1353: If placed in the work queue and the maximum number of connections has
1354: not yet been created, a new connection will be started. Our goal is
1355: to eventually have a sufficient number of connections that the work
1356: queue will typically be empty. parameters are:
1357:
1358: =item Socket
1359:
1360: open on the lonc client.
1361:
1362: =item Request
1363:
1364: data to send to the lond.
1.1 foxr 1365:
1366: =cut
1.3 albertel 1367:
1.1 foxr 1368: sub QueueTransaction {
1369:
1.7 foxr 1370: my $requestData = shift; # This is a LondTransaction.
1371: my $cmd = $requestData->getRequest();
1372:
1373: Debug(6,"QueueTransaction: ".$cmd);
1.1 foxr 1374:
1375: my $LondSocket = $IdleConnections->pop();
1376: if(!defined $LondSocket) { # Need to queue request.
1.29 foxr 1377: Debug(5,"Must queue...");
1.1 foxr 1378: $WorkQueue->enqueue($requestData);
1.56 foxr 1379: Debug(5, "Queue Transaction startnew $ConnectionCount $LondConnecting");
1380: if(($ConnectionCount < $MaxConnectionCount) && (! $LondConnecting)) {
1381:
1.22 foxr 1382: if($ConnectionRetriesLeft > 0) {
1.29 foxr 1383: Debug(5,"Starting additional lond connection");
1.56 foxr 1384: if(&MakeLondConnection() == 0) {
1.22 foxr 1385: EmptyQueue(); # Fail transactions, can't make connection.
1.42 foxr 1386: CloseAllLondConnections; # Should all be closed but...
1.22 foxr 1387: }
1388: } else {
1389: ShowStatus(GetServerHost()." >>> DEAD !!!! <<<");
1.56 foxr 1390: $LondConnecting = 0;
1.22 foxr 1391: EmptyQueue(); # It's worse than that ... he's dead Jim.
1.42 foxr 1392: CloseAllLondConnections; # Should all be closed but..
1.17 foxr 1393: }
1.1 foxr 1394: }
1395: } else { # Can start the request:
1396: Debug(8,"Can start...");
1.7 foxr 1397: StartRequest($LondSocket, $requestData);
1.1 foxr 1398: }
1399: }
1400:
1.95 foxr 1401: #-------------------------- Lonc UNIX socket handling -------------------
1.1 foxr 1402: =pod
1.3 albertel 1403:
1.1 foxr 1404: =head2 ClientRequest
1.97 raeburn 1405:
1.3 albertel 1406: Callback that is called when data can be read from the UNIX domain
1407: socket connecting us with an apache server process.
1.1 foxr 1408:
1409: =cut
1410:
1411: sub ClientRequest {
1412: Debug(6, "ClientRequest");
1413: my $event = shift;
1414: my $watcher = $event->w;
1415: my $socket = $watcher->fd;
1416: my $data = $watcher->data;
1417: my $thisread;
1418:
1419: Debug(9, " Watcher named: ".$watcher->desc);
1420:
1421: my $rv = $socket->recv($thisread, POSIX::BUFSIZ, 0);
1422: Debug(8, "rcv: data length = ".length($thisread)
1423: ." read =".$thisread);
1.29 foxr 1424: unless (defined $rv && length($thisread)) {
1.1 foxr 1425: # Likely eof on socket.
1426: Debug(5,"Client Socket closed on lonc for ".$RemoteHost);
1427: close($socket);
1428: $watcher->cancel();
1429: delete($ActiveClients{$socket});
1.10 foxr 1430: return;
1.1 foxr 1431: }
1432: Debug(8,"Data: ".$data." this read: ".$thisread);
1433: $data = $data.$thisread; # Append new data.
1434: $watcher->data($data);
1.44 albertel 1435: if($data =~ /\n$/) { # Request entirely read.
1.87 albertel 1436: if ($data eq "close_connection_exit\n") {
1.9 foxr 1437: Log("CRITICAL",
1438: "Request Close Connection ... exiting");
1439: CloseAllLondConnections();
1440: exit;
1.87 albertel 1441: } elsif ($data eq "reset_retries\n") {
1442: Log("INFO", "Resetting Connection Retries.");
1443: $ConnectionRetriesLeft = $ConnectionRetries;
1444: &UpdateStatus();
1445: my $Transaction = LondTransaction->new($data);
1446: $Transaction->SetClient($socket);
1447: StartClientReply($Transaction, "ok\n");
1448: $watcher->cancel();
1449: return;
1.9 foxr 1450: }
1.1 foxr 1451: Debug(8, "Complete transaction received: ".$data);
1.87 albertel 1452: if ($LogTransactions) {
1.39 foxr 1453: Log("SUCCESS", "Transaction: '$data'"); # Transaction has \n.
1454: }
1.8 foxr 1455: my $Transaction = LondTransaction->new($data);
1.7 foxr 1456: $Transaction->SetClient($socket);
1457: QueueTransaction($Transaction);
1.1 foxr 1458: $watcher->cancel(); # Done looking for input data.
1459: }
1460:
1461: }
1462:
1.62 foxr 1463: #
1464: # Accept a connection request for a client (lonc child) and
1465: # start up an event watcher to keep an eye on input from that
1466: # Event. This can be called both from NewClient and from
1.80 albertel 1467: # ChildProcess.
1.62 foxr 1468: # Parameters:
1469: # $socket - The listener socket.
1470: # Returns:
1471: # NONE
1472: # Side Effects:
1473: # An event is made to watch the accepted connection.
1474: # Active clients hash is updated to reflect the new connection.
1475: # The client connection count is incremented.
1476: #
1477: sub accept_client {
1478: my ($socket) = @_;
1479:
1480: Debug(8, "Entering accept for lonc UNIX socket\n");
1481: my $connection = $socket->accept(); # Accept the client connection.
1482: Debug(8,"Connection request accepted from "
1483: .GetPeername($connection, AF_UNIX));
1484:
1485:
1486: my $description = sprintf("Connection to lonc client %d",
1487: $ClientConnection);
1488: Debug(9, "Creating event named: ".$description);
1489: Event->io(cb => \&ClientRequest,
1490: poll => 'r',
1491: desc => $description,
1492: data => "",
1493: fd => $connection);
1494: $ActiveClients{$connection} = $ClientConnection;
1495: $ClientConnection++;
1496: }
1.1 foxr 1497:
1498: =pod
1.3 albertel 1499:
1.1 foxr 1500: =head2 NewClient
1.3 albertel 1501:
1502: Callback that is called when a connection is received on the unix
1503: socket for a new client of lonc. The callback is parameterized by the
1504: event.. which is a-priori assumed to be an io event, and therefore has
1.97 raeburn 1505: an fd member that is the Listener socket. We accept the connection
1.3 albertel 1506: and register a new event on the readability of that socket:
1507:
1.1 foxr 1508: =cut
1.3 albertel 1509:
1.1 foxr 1510: sub NewClient {
1511: Debug(6, "NewClient");
1512: my $event = shift; # Get the event parameters.
1513: my $watcher = $event->w;
1514: my $socket = $watcher->fd; # Get the event' socket.
1515:
1.62 foxr 1516: &accept_client($socket);
1.1 foxr 1517: }
1.3 albertel 1518:
1519: =pod
1520:
1521: =head2 GetLoncSocketPath
1522:
1523: Returns the name of the UNIX socket on which to listen for client
1524: connections.
1.1 foxr 1525:
1.58 foxr 1526: =head2 Parameters:
1527:
1528: host (optional) - Name of the host socket to return.. defaults to
1529: the return from GetServerHost().
1530:
1.1 foxr 1531: =cut
1.3 albertel 1532:
1.1 foxr 1533: sub GetLoncSocketPath {
1.58 foxr 1534:
1535: my $host = GetServerHost(); # Default host.
1536: if (@_) {
1537: ($host) = @_; # Override if supplied.
1538: }
1539: return $UnixSocketDir."/".$host;
1.1 foxr 1540: }
1541:
1.3 albertel 1542: =pod
1543:
1544: =head2 GetServerHost
1545:
1546: Returns the host whose lond we talk with.
1547:
1.1 foxr 1548: =cut
1.3 albertel 1549:
1.7 foxr 1550: sub GetServerHost {
1.1 foxr 1551: return $RemoteHost; # Setup by the fork.
1552: }
1.3 albertel 1553:
1554: =pod
1555:
1.107 raeburn 1556: =head2 GetHostId
1.81 albertel 1557:
1558: Returns the hostid whose lond we talk with.
1559:
1560: =cut
1561:
1562: sub GetHostId {
1563: return $RemoteHostId; # Setup by the fork.
1564: }
1565:
1566: =pod
1567:
1.107 raeburn 1568: =head2 GetDefHostId
1569:
1570: Returns the default hostid for the node whose lond we talk with.
1571:
1572: =cut
1573:
1574: sub GetDefHostId { # Setup by the fork.
1575: return $RemoteDefHostId;
1576: }
1577:
1578: =pod
1579:
1.108 raeburn 1580: =head2 GetLoncapaRev
1581:
1582: Returns the LON-CAPA version for the node whose lond we talk with.
1583:
1584: =cut
1585:
1586: sub GetLoncapaRev {
1587: return $RemoteLoncapaRev; # Setup by the fork.
1588: }
1589:
1590: =pod
1591:
1.3 albertel 1592: =head2 GetServerPort
1593:
1594: Returns the lond port number.
1595:
1.1 foxr 1596: =cut
1.3 albertel 1597:
1.7 foxr 1598: sub GetServerPort {
1.1 foxr 1599: return $perlvar{londPort};
1600: }
1.3 albertel 1601:
1602: =pod
1603:
1604: =head2 SetupLoncListener
1605:
1606: Setup a lonc listener event. The event is called when the socket
1607: becomes readable.. that corresponds to the receipt of a new
1608: connection. The event handler established will accept the connection
1.99 raeburn 1609: (creating a communications channel), that in turn will establish
1.3 albertel 1610: another event handler to subess requests.
1.1 foxr 1611:
1.58 foxr 1612: =head2 Parameters:
1613:
1614: host (optional) Name of the host to set up a unix socket to.
1615:
1.1 foxr 1616: =cut
1.3 albertel 1617:
1.1 foxr 1618: sub SetupLoncListener {
1.78 albertel 1619: my ($host,$SocketName) = @_;
1620: if (!$host) { $host = &GetServerHost(); }
1621: if (!$SocketName) { $SocketName = &GetLoncSocketPath($host); }
1.1 foxr 1622:
1.78 albertel 1623:
1624: unlink($SocketName);
1.58 foxr 1625:
1.1 foxr 1626: my $socket;
1.7 foxr 1627: unless ($socket =IO::Socket::UNIX->new(Local => $SocketName,
1.55 albertel 1628: Listen => 250,
1.1 foxr 1629: Type => SOCK_STREAM)) {
1.64 foxr 1630: if($I_am_child) {
1631: &child_exit(-1, "Failed to create a lonc listener socket");
1632: } else {
1633: die "Failed to create a lonc listner socket";
1634: }
1.1 foxr 1635: }
1.59 foxr 1636: return $socket;
1.1 foxr 1637: }
1638:
1.39 foxr 1639: #
1640: # Toggle transaction logging.
1641: # Implicit inputs:
1642: # LogTransactions
1643: # Implicit Outputs:
1644: # LogTransactions
1645: sub ToggleTransactionLogging {
1646: print STDERR "Toggle transaction logging...\n";
1647: if(!$LogTransactions) {
1648: $LogTransactions = 1;
1649: } else {
1650: $LogTransactions = 0;
1651: }
1652:
1653:
1654: Log("SUCCESS", "Toggled transaction logging: $LogTransactions \n");
1655: }
1656:
1.14 foxr 1657: =pod
1658:
1659: =head2 ChildStatus
1660:
1661: Child USR1 signal handler to report the most recent status
1662: into the status file.
1663:
1.22 foxr 1664: We also use this to reset the retries count in order to allow the
1665: client to retry connections with a previously dead server.
1.69 matthew 1666:
1.14 foxr 1667: =cut
1.46 albertel 1668:
1.14 foxr 1669: sub ChildStatus {
1670: my $event = shift;
1671: my $watcher = $event->w;
1672:
1673: Debug(2, "Reporting child status because : ".$watcher->data);
1674: my $docdir = $perlvar{'lonDocRoot'};
1.67 albertel 1675:
1676: open(LOG,">>$docdir/lon-status/loncstatus.txt");
1677: flock(LOG,LOCK_EX);
1678: print LOG $$."\t".$RemoteHost."\t".$Status."\t".
1.14 foxr 1679: $RecentLogEntry."\n";
1.38 foxr 1680: #
1681: # Write out information about each of the connections:
1682: #
1.46 albertel 1683: if ($DebugLevel > 2) {
1.67 albertel 1684: print LOG "Active connection statuses: \n";
1.46 albertel 1685: my $i = 1;
1686: print STDERR "================================= Socket Status Dump:\n";
1687: foreach my $item (keys %ActiveConnections) {
1688: my $Socket = $ActiveConnections{$item}->data;
1689: my $state = $Socket->GetState();
1.67 albertel 1690: print LOG "Connection $i State: $state\n";
1.46 albertel 1691: print STDERR "---------------------- Connection $i \n";
1.48 foxr 1692: $Socket->Dump(-1); # Ensure it gets dumped..
1.46 albertel 1693: $i++;
1694: }
1.38 foxr 1695: }
1.67 albertel 1696: flock(LOG,LOCK_UN);
1697: close(LOG);
1.22 foxr 1698: $ConnectionRetriesLeft = $ConnectionRetries;
1.70 albertel 1699: UpdateStatus();
1.14 foxr 1700: }
1701:
1.1 foxr 1702: =pod
1.3 albertel 1703:
1.10 foxr 1704: =head2 SignalledToDeath
1705:
1706: Called in response to a signal that causes a chid process to die.
1707:
1708: =cut
1709:
1710:
1711: sub SignalledToDeath {
1.14 foxr 1712: my $event = shift;
1713: my $watcher= $event->w;
1714:
1715: Debug(2,"Signalled to death! via ".$watcher->data);
1.17 foxr 1716: my ($signal) = $watcher->data;
1.10 foxr 1717: chomp($signal);
1718: Log("CRITICAL", "Abnormal exit. Child $$ for $RemoteHost "
1719: ."died through "."\"$signal\"");
1.68 albertel 1720: #LogPerm("F:lonc: $$ on $RemoteHost signalled to death: "
1721: # ."\"$signal\"");
1.105 raeburn 1722: &clear_childpid($$);
1.12 foxr 1723: exit 0;
1.10 foxr 1724:
1725: }
1.16 foxr 1726:
1.69 matthew 1727: =pod
1728:
1.16 foxr 1729: =head2 ToggleDebug
1730:
1731: This sub toggles trace debugging on and off.
1732:
1733: =cut
1734:
1735: sub ToggleDebug {
1736: my $Current = $DebugLevel;
1737: $DebugLevel = $NextDebugLevel;
1738: $NextDebugLevel = $Current;
1739:
1740: Log("SUCCESS", "New debugging level for $RemoteHost now $DebugLevel");
1741:
1742: }
1743:
1.69 matthew 1744: =pod
1745:
1.1 foxr 1746: =head2 ChildProcess
1747:
1748: This sub implements a child process for a single lonc daemon.
1.61 foxr 1749: Optional parameter:
1.97 raeburn 1750: $socket - if provided, this is a socket already open for listening
1751: on the client socket. Otherwise, a new listener is set up.
1.1 foxr 1752:
1753: =cut
1754:
1755: sub ChildProcess {
1.80 albertel 1756: # We've inherited all the
1.62 foxr 1757: # events of our parent and those have to be cancelled or else
1758: # all holy bloody chaos will result.. trust me, I already made
1759: # >that< mistake.
1760:
1761: my $host = GetServerHost();
1762: foreach my $listener (keys %parent_dispatchers) {
1763: my $watcher = $parent_dispatchers{$listener};
1764: my $s = $watcher->fd;
1765: if ($listener ne $host) { # Close everyone but me.
1766: Debug(5, "Closing listen socket for $listener");
1767: $s->close();
1768: }
1769: Debug(5, "Killing watcher for $listener");
1770:
1771: $watcher->cancel();
1.65 foxr 1772: delete($parent_dispatchers{$listener});
1.62 foxr 1773:
1774: }
1.65 foxr 1775:
1776: # kill off the parent's signal handlers too!
1777: #
1778:
1779: for my $handler (keys %parent_handlers) {
1780: my $watcher = $parent_handlers{$handler};
1781: $watcher->cancel();
1782: delete($parent_handlers{$handler});
1783: }
1784:
1.64 foxr 1785: $I_am_child = 1; # Seems like in spite of it all I may still getting
1786: # parent event dispatches.. flag I'm a child.
1.1 foxr 1787:
1788:
1.14 foxr 1789: #
1790: # Signals must be handled by the Event framework...
1.61 foxr 1791: #
1.14 foxr 1792:
1793: Event->signal(signal => "QUIT",
1794: cb => \&SignalledToDeath,
1795: data => "QUIT");
1796: Event->signal(signal => "HUP",
1797: cb => \&ChildStatus,
1798: data => "HUP");
1799: Event->signal(signal => "USR1",
1800: cb => \&ChildStatus,
1801: data => "USR1");
1.39 foxr 1802: Event->signal(signal => "USR2",
1803: cb => \&ToggleTransactionLogging);
1.16 foxr 1804: Event->signal(signal => "INT",
1805: cb => \&ToggleDebug,
1806: data => "INT");
1.1 foxr 1807:
1.93 foxr 1808: # Block the pipe signal we'll get when the socket disconnects. We detect
1809: # socket disconnection via send/receive failures. On disconnect, the
1810: # socket becomes readable .. which will force the disconnect detection.
1811:
1812: my $set = POSIX::SigSet->new(SIGPIPE);
1813: sigprocmask(SIG_BLOCK, $set);
1814:
1.62 foxr 1815: # Figure out if we got passed a socket or need to open one to listen for
1816: # client requests.
1817:
1.61 foxr 1818: my ($socket) = @_;
1819: if (!$socket) {
1820:
1821: $socket = SetupLoncListener();
1822: }
1.62 foxr 1823: # Establish an event to listen for client connection requests.
1824:
1825:
1.59 foxr 1826: Event->io(cb => \&NewClient,
1827: poll => 'r',
1828: desc => 'Lonc Listener Unix Socket',
1829: fd => $socket);
1.1 foxr 1830:
1.76 albertel 1831: $Event::DebugLevel = $DebugLevel;
1.1 foxr 1832:
1833: Debug(9, "Making initial lond connection for ".$RemoteHost);
1834:
1835: # Setup the initial server connection:
1836:
1.62 foxr 1837: # &MakeLondConnection(); // let first work request do it.
1.10 foxr 1838:
1.80 albertel 1839: # need to accept the connection since the event may not fire.
1.62 foxr 1840:
1.80 albertel 1841: &accept_client($socket);
1.5 foxr 1842:
1.1 foxr 1843: Debug(9,"Entering event loop");
1844: my $ret = Event::loop(); # Start the main event loop.
1845:
1846:
1.64 foxr 1847: &child_exit (-1,"Main event loop exited!!!");
1.1 foxr 1848: }
1849:
1850: # Create a new child for host passed in:
1851:
1852: sub CreateChild {
1.108 raeburn 1853: my ($host, $hostid, $defhostid, $loncaparev) = @_;
1.52 foxr 1854:
1.12 foxr 1855: my $sigset = POSIX::SigSet->new(SIGINT);
1856: sigprocmask(SIG_BLOCK, $sigset);
1.1 foxr 1857: $RemoteHost = $host;
1.91 foxr 1858: ShowStatus('Parent keeping the flock'); # Update time in status message.
1.9 foxr 1859: Log("CRITICAL", "Forking server for ".$host);
1.23 foxr 1860: my $pid = fork;
1.1 foxr 1861: if($pid) { # Parent
1.17 foxr 1862: $RemoteHost = "Parent";
1.83 albertel 1863: $ChildPid{$pid} = $host;
1.12 foxr 1864: sigprocmask(SIG_UNBLOCK, $sigset);
1.82 albertel 1865: undef(@all_host_ids);
1.1 foxr 1866: } else { # child.
1.81 albertel 1867: $RemoteHostId = $hostid;
1.107 raeburn 1868: $RemoteDefHostId = $defhostid;
1.108 raeburn 1869: $RemoteLoncapaRev = $loncaparev;
1.5 foxr 1870: ShowStatus("Connected to ".$RemoteHost);
1.23 foxr 1871: $SIG{INT} = 'DEFAULT';
1.12 foxr 1872: sigprocmask(SIG_UNBLOCK, $sigset);
1.81 albertel 1873: &ChildProcess(); # Does not return.
1.1 foxr 1874: }
1.61 foxr 1875: }
1.1 foxr 1876:
1.61 foxr 1877: # parent_client_connection:
1878: # Event handler that processes client connections for the parent process.
1879: # This sub is called when the parent is listening on a socket and
1880: # a connection request arrives. We must:
1881: # Start a child process to accept the connection request.
1882: # Kill our listen on the socket.
1883: # Parameter:
1884: # event - The event object that was created to monitor this socket.
1885: # event->w->fd is the socket.
1886: # Returns:
1887: # NONE
1888: #
1889: sub parent_client_connection {
1.62 foxr 1890: if ($I_am_child) {
1891: # Should not get here, but seem to anyway:
1892: &Debug(5," Child caught parent client connection event!!");
1893: my ($event) = @_;
1894: my $watcher = $event->w;
1895: $watcher->cancel(); # Try to kill it off again!!
1896: } else {
1897: &Debug(9, "parent_client_connection");
1898: my ($event) = @_;
1899: my $watcher = $event->w;
1900: my $socket = $watcher->fd;
1.81 albertel 1901: my $connection = $socket->accept(); # Accept the client connection.
1902: Event->io(cb => \&get_remote_hostname,
1903: poll => 'r',
1904: data => "",
1905: fd => $connection);
1.77 albertel 1906: }
1907: }
1908:
1909: sub get_remote_hostname {
1.82 albertel 1910: my ($event) = @_;
1911: my $watcher = $event->w;
1912: my $socket = $watcher->fd;
1913:
1914: my $thisread;
1915: my $rv = $socket->recv($thisread, POSIX::BUFSIZ, 0);
1916: Debug(8, "rcv: data length = ".length($thisread)." read =".$thisread);
1917: if (!defined($rv) || length($thisread) == 0) {
1918: # Likely eof on socket.
1919: Debug(5,"Client Socket closed on lonc for p_c_c");
1920: close($socket);
1921: $watcher->cancel();
1922: return;
1923: }
1924:
1925: my $data = $watcher->data().$thisread;
1926: $watcher->data($data);
1927: if($data =~ /\n$/) { # Request entirely read.
1928: chomp($data);
1929: } else {
1930: return;
1931: }
1.77 albertel 1932:
1.82 albertel 1933: &Debug(5,"Creating child for $data (parent_client_connection)");
1934: (my $hostname,my $lonid,@all_host_ids) = split(':',$data);
1.110 ! raeburn 1935: my $remotelcrev;
! 1936: if ((scalar(@all_host_ids) > 1) && ($all_host_ids[0] =~ /^\d+\.\d+\.[\w.]+$/)) {
! 1937: $remotelcrev = shift(@all_host_ids);
! 1938: }
1.83 albertel 1939: $ChildHost{$hostname}++;
1940: if ($ChildHost{$hostname} == 1) {
1.110 ! raeburn 1941: &CreateChild($hostname,$lonid,$all_host_ids[-1],$remotelcrev);
1.83 albertel 1942: } else {
1943: &Log('WARNING',"Request for a second child on $hostname");
1944: }
1.82 albertel 1945: # Clean up the listen since now the child takes over until it exits.
1946: $watcher->cancel(); # Nolonger listening to this event
1947: $socket->send("done\n");
1948: $socket->close();
1.61 foxr 1949: }
1950:
1951: # parent_listen:
1952: # Opens a socket and starts a listen for the parent process on a client UNIX
1953: # domain socket.
1954: #
1955: # This involves:
1956: # Creating a socket for listen.
1957: # Removing any socket lock file
1958: # Adding an event handler for this socket becoming readable
1959: # To the parent's event dispatcher.
1960: # Parameters:
1961: # loncapa_host - LonCAPA cluster name of the host represented by the client
1962: # socket.
1963: # Returns:
1964: # NONE
1965: #
1966: sub parent_listen {
1967: my ($loncapa_host) = @_;
1968: Debug(5, "parent_listen: $loncapa_host");
1969:
1.78 albertel 1970: my ($socket,$file);
1971: if (!$loncapa_host) {
1972: $loncapa_host = 'common_parent';
1973: $file = $perlvar{'lonSockCreate'};
1974: } else {
1975: $file = &GetLoncSocketPath($loncapa_host);
1976: }
1977: $socket = &SetupLoncListener($loncapa_host,$file);
1978:
1.62 foxr 1979: $listening_to{$socket} = $loncapa_host;
1.61 foxr 1980: if (!$socket) {
1981: die "Unable to create a listen socket for $loncapa_host";
1982: }
1983:
1.78 albertel 1984: my $lock_file = $file.".lock";
1.61 foxr 1985: unlink($lock_file); # No problem if it doesn't exist yet [startup e.g.]
1986:
1.77 albertel 1987: my $watcher =
1988: Event->io(cb => \&parent_client_connection,
1989: poll => 'r',
1990: desc => "Parent listener unix socket ($loncapa_host)",
1991: data => "",
1992: fd => $socket);
1.62 foxr 1993: $parent_dispatchers{$loncapa_host} = $watcher;
1.61 foxr 1994:
1995: }
1996:
1.77 albertel 1997: sub parent_clean_up {
1998: my ($loncapa_host) = @_;
1.87 albertel 1999: Debug(1, "parent_clean_up: $loncapa_host");
1.77 albertel 2000:
2001: my $socket_file = &GetLoncSocketPath($loncapa_host);
2002: unlink($socket_file); # No problem if it doesn't exist yet [startup e.g.]
2003: my $lock_file = $socket_file.".lock";
2004: unlink($lock_file); # No problem if it doesn't exist yet [startup e.g.]
2005: }
2006:
1.61 foxr 2007:
1.83 albertel 2008:
2009: # This sub initiates a listen on the common unix domain lonc client socket.
2010: # loncnew starts up with no children, and only spawns off children when a
2011: # connection request occurs on the common client unix socket. The spawned
2012: # child continues to run until it has been idle a while at which point it
2013: # eventually exits and once more the parent picks up the listen.
1.61 foxr 2014: #
2015: # Parameters:
2016: # NONE
2017: # Implicit Inputs:
2018: # The configuration file that has been read in by LondConnection.
2019: # Returns:
2020: # NONE
2021: #
1.77 albertel 2022: sub listen_on_common_socket {
2023: Debug(5, "listen_on_common_socket");
1.78 albertel 2024: &parent_listen();
1.77 albertel 2025: }
2026:
1.63 foxr 2027: # server_died is called whenever a child process exits.
2028: # Since this is dispatched via a signal, we must process all
2029: # dead children until there are no more left. The action
2030: # is to:
2031: # - Remove the child from the bookeeping hashes
2032: # - Re-establish a listen on the unix domain socket associated
2033: # with that host.
2034: # Parameters:
2035: # The event, but we don't actually care about it.
2036: sub server_died {
2037: &Debug(9, "server_died called...");
2038:
2039: while(1) { # Loop until waitpid nowait fails.
2040: my $pid = waitpid(-1, WNOHANG);
2041: if($pid <= 0) {
2042: return; # Nothing left to wait for.
2043: }
2044: # need the host to restart:
2045:
1.83 albertel 2046: my $host = $ChildPid{$pid};
1.63 foxr 2047: if($host) { # It's for real...
2048: &Debug(9, "Caught sigchild for $host");
1.105 raeburn 2049: &clear_childpid($pid);
1.83 albertel 2050: delete($ChildPid{$pid});
2051: delete($ChildHost{$host});
1.81 albertel 2052: &parent_clean_up($host);
2053:
1.63 foxr 2054: } else {
2055: &Debug(5, "Caught sigchild for pid not in hosts hash: $pid");
2056: }
2057: }
2058:
2059: }
2060:
1.1 foxr 2061: #
2062: # Parent process logic pass 1:
2063: # For each entry in the hosts table, we will
2064: # fork off an instance of ChildProcess to service the transactions
2065: # to that host. Each pid will be entered in a global hash
2066: # with the value of the key, the host.
2067: # The parent will then enter a loop to wait for process exits.
2068: # Each exit gets logged and the child gets restarted.
2069: #
2070:
1.5 foxr 2071: #
2072: # Fork and start in new session so hang-up isn't going to
2073: # happen without intent.
2074: #
2075:
2076:
1.6 foxr 2077:
2078:
1.8 foxr 2079:
1.6 foxr 2080:
2081: ShowStatus("Forming new session");
2082: my $childpid = fork;
2083: if ($childpid != 0) {
2084: sleep 4; # Give child a chacne to break to
2085: exit 0; # a new sesion.
2086: }
1.8 foxr 2087: #
2088: # Write my pid into the pid file so I can be located
2089: #
2090:
2091: ShowStatus("Parent writing pid file:");
1.23 foxr 2092: my $execdir = $perlvar{'lonDaemons'};
1.8 foxr 2093: open (PIDSAVE, ">$execdir/logs/lonc.pid");
2094: print PIDSAVE "$$\n";
2095: close(PIDSAVE);
1.6 foxr 2096:
1.17 foxr 2097:
2098:
1.6 foxr 2099: if (POSIX::setsid() < 0) {
2100: print "Could not create new session\n";
2101: exit -1;
2102: }
1.5 foxr 2103:
2104: ShowStatus("Forking node servers");
2105:
1.9 foxr 2106: Log("CRITICAL", "--------------- Starting children ---------------");
2107:
1.31 foxr 2108: LondConnection::ReadConfig; # Read standard config files.
1.1 foxr 2109:
1.80 albertel 2110: $RemoteHost = "[parent]";
1.81 albertel 2111: &listen_on_common_socket();
1.60 foxr 2112:
1.12 foxr 2113: $RemoteHost = "Parent Server";
1.1 foxr 2114:
2115: # Maintain the population:
1.5 foxr 2116:
2117: ShowStatus("Parent keeping the flock");
1.1 foxr 2118:
1.12 foxr 2119:
1.80 albertel 2120: # We need to setup a SIGChild event to handle the exit (natural or otherwise)
2121: # of the children.
1.61 foxr 2122:
1.80 albertel 2123: Event->signal(cb => \&server_died,
2124: desc => "Child exit handler",
2125: signal => "CHLD");
2126:
2127:
2128: # Set up all the other signals we set up.
2129:
2130: $parent_handlers{INT} = Event->signal(cb => \&Terminate,
2131: desc => "Parent INT handler",
2132: signal => "INT");
2133: $parent_handlers{TERM} = Event->signal(cb => \&Terminate,
2134: desc => "Parent TERM handler",
2135: signal => "TERM");
1.81 albertel 2136: $parent_handlers{HUP} = Event->signal(cb => \&KillThemAll,
2137: desc => "Parent HUP handler.",
2138: signal => "HUP");
1.80 albertel 2139: $parent_handlers{USR1} = Event->signal(cb => \&CheckKids,
2140: desc => "Parent USR1 handler",
2141: signal => "USR1");
2142: $parent_handlers{USR2} = Event->signal(cb => \&UpdateKids,
2143: desc => "Parent USR2 handler.",
2144: signal => "USR2");
2145:
2146: # Start procdesing events.
2147:
2148: $Event::DebugLevel = $DebugLevel;
2149: Debug(9, "Parent entering event loop");
2150: my $ret = Event::loop();
2151: die "Main Event loop exited: $ret";
1.14 foxr 2152:
2153: =pod
2154:
2155: =head1 CheckKids
2156:
2157: Since kids do not die as easily in this implementation
1.97 raeburn 2158: as the previous one, there is no need to restart the
1.14 foxr 2159: dead ones (all dead kids get restarted when they die!!)
2160: The only thing this function does is to pass USR1 to the
2161: kids so that they report their status.
2162:
2163: =cut
2164:
2165: sub CheckKids {
2166: Debug(2, "Checking status of children");
2167: my $docdir = $perlvar{'lonDocRoot'};
2168: my $fh = IO::File->new(">$docdir/lon-status/loncstatus.txt");
2169: my $now=time;
2170: my $local=localtime($now);
2171: print $fh "LONC status $local - parent $$ \n\n";
1.65 foxr 2172: foreach my $host (keys %parent_dispatchers) {
2173: print $fh "LONC Parent process listening for $host\n";
2174: }
1.83 albertel 2175: foreach my $pid (keys %ChildPid) {
1.14 foxr 2176: Debug(2, "Sending USR1 -> $pid");
2177: kill 'USR1' => $pid; # Tell Child to report status.
2178: }
1.65 foxr 2179:
1.14 foxr 2180: }
1.24 foxr 2181:
2182: =pod
2183:
2184: =head1 UpdateKids
2185:
1.25 foxr 2186: parent's SIGUSR2 handler. This handler:
1.24 foxr 2187:
2188: =item
2189:
2190: Rereads the hosts file.
2191:
2192: =item
2193:
2194: Kills off (via sigint) children for hosts that have disappeared.
2195:
2196: =item
2197:
1.27 foxr 2198: QUITs children for hosts that already exist (this just forces a status display
1.24 foxr 2199: and resets the connection retry count for that host.
2200:
2201: =item
2202:
2203: Starts new children for hosts that have been added to the hosts.tab file since
2204: the start of the master program and maintains them.
2205:
2206: =cut
2207:
2208: sub UpdateKids {
1.27 foxr 2209:
1.25 foxr 2210: Log("INFO", "Updating connections via SIGUSR2");
1.27 foxr 2211:
1.65 foxr 2212: # I'm not sure what I was thinking in the first implementation.
2213: # someone will have to work hard to convince me the effect is any
2214: # different than Restart, especially now that we don't start up
2215: # per host servers automatically, may as well just restart.
2216: # The down side is transactions that are in flight will get timed out
2217: # (lost unless they are critical).
1.27 foxr 2218:
1.81 albertel 2219: &KillThemAll();
1.101 raeburn 2220: LondConnection->ResetReadConfig();
1.105 raeburn 2221: ShowStatus('Parent keeping the flock');
1.24 foxr 2222: }
2223:
1.14 foxr 2224:
1.13 foxr 2225: =pod
2226:
2227: =head1 Restart
2228:
2229: Signal handler for HUP... all children are killed and
1.97 raeburn 2230: we self restart. This is an el-cheapo way to re-read
1.13 foxr 2231: the config file.
2232:
2233: =cut
2234:
2235: sub Restart {
1.23 foxr 2236: &KillThemAll; # First kill all the children.
1.101 raeburn 2237: LondConnection->ResetReadConfig();
1.13 foxr 2238: Log("CRITICAL", "Restarting");
2239: my $execdir = $perlvar{'lonDaemons'};
2240: unlink("$execdir/logs/lonc.pid");
1.65 foxr 2241: exec("$executable");
1.10 foxr 2242: }
1.12 foxr 2243:
2244: =pod
2245:
2246: =head1 KillThemAll
2247:
2248: Signal handler that kills all children by sending them a
1.17 foxr 2249: SIGHUP. Responds to sigint and sigterm.
1.12 foxr 2250:
2251: =cut
2252:
1.10 foxr 2253: sub KillThemAll {
1.12 foxr 2254: Debug(2, "Kill them all!!");
1.85 albertel 2255:
2256: #local($SIG{CHLD}) = 'IGNORE';
2257: # Our children >will< die.
2258: # but we need to catch their death and cleanup after them in case this is
2259: # a restart set of kills
2260: my @allpids = keys(%ChildPid);
2261: foreach my $pid (@allpids) {
1.83 albertel 2262: my $serving = $ChildPid{$pid};
1.52 foxr 2263: ShowStatus("Nicely Killing lonc for $serving pid = $pid");
2264: Log("CRITICAL", "Nicely Killing lonc for $serving pid = $pid");
1.17 foxr 2265: kill 'QUIT' => $pid;
1.105 raeburn 2266: &clear_childpid($pid);
1.12 foxr 2267: }
1.85 albertel 2268: ShowStatus("Finished killing child processes off.");
1.1 foxr 2269: }
1.12 foxr 2270:
1.52 foxr 2271:
2272: #
2273: # Kill all children via KILL. Just in case the
2274: # first shot didn't get them.
2275:
2276: sub really_kill_them_all_dammit
2277: {
2278: Debug(2, "Kill them all Dammit");
2279: local($SIG{CHLD} = 'IGNORE'); # In case some purist reenabled them.
1.83 albertel 2280: foreach my $pid (keys %ChildPid) {
2281: my $serving = $ChildPid{$pid};
1.52 foxr 2282: &ShowStatus("Nastily killing lonc for $serving pid = $pid");
2283: Log("CRITICAL", "Nastily killing lonc for $serving pid = $pid");
2284: kill 'KILL' => $pid;
1.83 albertel 2285: delete($ChildPid{$pid});
1.105 raeburn 2286: delete($ChildKeyMode{$pid});
1.52 foxr 2287: my $execdir = $perlvar{'lonDaemons'};
2288: unlink("$execdir/logs/lonc.pid");
2289: }
2290: }
1.69 matthew 2291:
1.14 foxr 2292: =pod
2293:
2294: =head1 Terminate
2295:
2296: Terminate the system.
2297:
2298: =cut
2299:
2300: sub Terminate {
1.52 foxr 2301: &Log("CRITICAL", "Asked to kill children.. first be nice...");
2302: &KillThemAll;
2303: #
2304: # By now they really should all be dead.. but just in case
2305: # send them all SIGKILL's after a bit of waiting:
2306:
2307: sleep(4);
2308: &Log("CRITICAL", "Now kill children nasty");
2309: &really_kill_them_all_dammit;
1.17 foxr 2310: Log("CRITICAL","Master process exiting");
2311: exit 0;
1.14 foxr 2312:
2313: }
1.81 albertel 2314:
1.105 raeburn 2315: =pod
2316:
2317: =cut
2318:
1.81 albertel 2319: sub my_hostname {
1.104 raeburn 2320: use Sys::Hostname::FQDN();
2321: my $name = Sys::Hostname::FQDN::fqdn();
1.81 albertel 2322: &Debug(9,"Name is $name");
2323: return $name;
2324: }
2325:
1.105 raeburn 2326: sub record_childpid {
2327: my ($Socket) = @_;
2328: my $docdir = $perlvar{'lonDocRoot'};
2329: my $authmode = $Socket->GetKeyMode();
2330: my $peer = $Socket->PeerLoncapaHim();
2331: if (($authmode eq 'ssl') || ($authmode eq 'insecure')) {
2332: my $childpid = $$;
2333: if ($childpid) {
2334: unless (exists($ChildKeyMode{$childpid})) {
2335: $ChildKeyMode{$childpid} = $authmode;
2336: }
2337: if (-d "$docdir/lon-status/loncchld") {
2338: unless (-e "$docdir/lon-status/loncchld/$childpid") {
2339: if (open (my $pidfh,'>',"$docdir/lon-status/loncchld/$childpid")) {
2340: print $pidfh "$peer:$authmode\n";
2341: close($pidfh);
2342: }
2343: }
2344: }
2345: }
2346: }
2347: return;
2348: }
2349:
2350: sub clear_childpid {
2351: my ($childpid) = @_;
2352: my $docdir = $perlvar{'lonDocRoot'};
2353: if (-d "$docdir/lon-status/loncchld") {
2354: if ($childpid =~ /^\d+$/) {
2355: if (($ChildKeyMode{$childpid} eq 'insecure') ||
2356: ($ChildKeyMode{$childpid} eq 'ssl')) {
2357: if (-e "$docdir/lon-status/loncchld/$childpid") {
2358: unlink("$docdir/lon-status/loncchld/$childpid");
2359: }
2360: }
2361: }
2362: }
2363: if (exists($ChildKeyMode{$childpid})) {
2364: delete($ChildKeyMode{$childpid});
2365: }
2366: return;
2367: }
2368:
1.12 foxr 2369: =pod
1.1 foxr 2370:
2371: =head1 Theory
1.3 albertel 2372:
2373: The event class is used to build this as a single process with an
2374: event driven model. The following events are handled:
1.1 foxr 2375:
2376: =item UNIX Socket connection Received
2377:
2378: =item Request data arrives on UNIX data transfer socket.
2379:
2380: =item lond connection becomes writable.
2381:
2382: =item timer fires at 1 second intervals.
2383:
2384: All sockets are run in non-blocking mode. Timeouts managed by the timer
2385: handler prevents hung connections.
2386:
2387: Key data structures:
2388:
1.3 albertel 2389: =item RequestQueue
2390:
2391: A queue of requests received from UNIX sockets that are
2392: waiting for a chance to be forwarded on a lond connection socket.
2393:
2394: =item ActiveConnections
2395:
2396: A hash of lond connections that have transactions in process that are
2397: available to be timed out.
2398:
2399: =item ActiveTransactions
2400:
2401: A hash indexed by lond connections that contain the client reply
2402: socket for each connection that has an active transaction on it.
2403:
2404: =item IdleConnections
2405:
2406: A hash of lond connections that have no work to do. These connections
2407: can be closed if they are idle for a long enough time.
1.1 foxr 2408:
2409: =cut
1.88 foxr 2410:
2411: =pod
2412:
2413: =head1 Log messages
2414:
2415: The following is a list of log messages that can appear in the
2416: lonc.log file. Each log file has a severity and a message.
2417:
2418: =over 2
2419:
2420: =item Warning A socket timeout was detected
2421:
2422: If there are pending transactions in the socket's queue,
2423: they are failed (saved if critical). If the connection
2424: retry count gets exceeded by this, the
2425: remote host is marked as dead.
1.97 raeburn 2426: Called when timeouts occurred during the connection and
1.88 foxr 2427: connection dialog with a remote host.
2428:
2429: =item Critical Host makred DEAD <hostname>
2430:
2431: The numer of retry counts for contacting a host was
2432: exceeded. The host is marked dead an no
2433: further attempts will be made by that child.
2434:
2435: =item Info lonc pipe client hung up on us
2436:
2437: Write to the client pipe indicated no data transferred
2438: Socket to remote host is shut down. Reply to the client
2439: is discarded. Note: This is commented out in &ClientWriteable
2440:
2441: =item Success Reply from lond: <data>
2442:
2443: Can be enabled for debugging by setting LogTransactions to nonzero.
2444: Indicates a successful transaction with lond, <data> is the data received
2445: from the remote lond.
2446:
2447: =item Success A delayed transaction was completed
2448:
2449: A transaction that must be reliable was executed and completed
2450: as lonc restarted. This is followed by a mesage of the form
2451:
2452: S: client-name : request
2453:
2454: =item WARNING Failing transaction <cmd>:<subcmd>
2455:
2456: Transaction failed on a socket, but the failure retry count for the remote
2457: node has not yet been exhausted (the node is not yet marked dead).
2458: cmd is the command, subcmd is the subcommand. This results from a con_lost
2459: when communicating with lond.
2460:
2461: =item WARNING Shutting down a socket
2462:
2463: Called when a socket is being closed to lond. This is emitted both when
2464: idle pruning is being done and when the socket has been disconnected by the remote.
2465:
2466: =item WARNING Lond connection lost.
2467:
2468: Called when a read from lond's socket failed indicating lond has closed the
2469: connection or died. This should be followed by one or more
2470:
2471: "WARNING Failing transaction..." msgs for each in-flight or queued transaction.
2472:
1.105 raeburn 2473: =item WARNING No SSL channel (verification failed), will try with insecure channel.
2474:
2475: Called when promotion of a socket to SSL failed because SSL certificate verification failed.
2476: Domain configuration must also permit insecure channel use for key exchange. Connection
2477: negotiation will start again from the beginning, but with Authentication Mode not set to ssl.
2478:
1.88 foxr 2479: =item INFO Connected to lond version: <version>
2480:
2481: When connection negotiation is complete, the lond version is requested and logged here.
2482:
2483: =item SUCCESS Connection n to host now ready for action
2484:
2485: Emitted when connection has been completed with lond. n is then number of
2486: concurrent connections and host, the host to which the connection has just
2487: been established.
2488:
2489: =item WARNING Connection to host has been disconnected
2490:
2491: Write to a lond resulted in failure status. Connection to lond is dropped.
2492:
2493: =item SUCCESS Created connection n to host host
2494:
2495: Initial connection request to host..(before negotiation).
2496:
2497: =item CRITICAL Request Close Connection ... exiting
2498:
2499: Client has sent "close_connection_exit" The loncnew server is exiting.
2500:
2501: =item INFO Resetting Connection Retries
2502:
2503: Client has sent "reset_retries" The lond connection retries are reset to zero for the
2504: corresponding lond.
2505:
2506: =item SUCCESS Transaction <data>
2507:
2508: Only emitted if the global variable $LogTransactions was set to true.
2509: A client has requested a lond transaction <data> is the contents of the request.
2510:
2511: =item SUCCESS Toggled transaction logging <LogTransactions>
2512:
2513: The state of the $LogTransactions global has been toggled, and its current value
2514: (after being toggled) is displayed. When non zero additional logging of transactions
2515: is enabled for debugging purposes. Transaction logging is toggled on receipt of a USR2
2516: signal.
2517:
2518: =item CRITICAL Abnormal exit. Child <pid> for <host> died thorugh signal.
2519:
2520: QUIT signal received. lonc child process is exiting.
2521:
2522: =item SUCCESS New debugging level for <RemoteHost> now <DebugLevel>
2523:
2524: Debugging toggled for the host loncnew is talking with.
2525: Currently debugging is a level based scheme with higher number
2526: conveying more information. The daemon starts out at
2527: DebugLevel 0 and can toggle back and forth between that and
2528: DebugLevel 2 These are controlled by
2529: the global variables $DebugLevel and $NextDebugLevel
2530: The debug level can go up to 9.
2531: SIGINT toggles the debug level. The higher the debug level the
2532: more debugging information is spewed. See the Debug
2533: sub in loncnew.
2534:
2535: =item CRITICAL Forking server for host
2536:
2537: A child is being created to service requests for the specified host.
2538:
2539:
2540: =item WARNING Request for a second child on hostname
2541:
2542: Somehow loncnew was asked to start a second child on a host that already had a child
2543: servicing it. This request is not honored, but themessage is emitted. This could happen
2544: due to a race condition. When a client attempts to contact loncnew for a new host, a child
2545: is forked off to handle the requests for that server. The parent then backs off the Unix
2546: domain socket leaving it for the child to service all requests. If in the time between
2547: creating the child, and backing off, a new connection request comes in to the unix domain
2548: socket, this could trigger (unlikely but remotely possible),.
2549:
2550: =item CRITICAL ------ Starting Children ----
2551:
2552: This message should probably be changed to "Entering event loop" as the loncnew only starts
2553: children as needed. This message is emitted as new events are established and
2554: the event processing loop is entered.
2555:
2556: =item INFO Updating connections via SIGUSR2
2557:
2558: SIGUSR2 received. The original code would kill all clients, re-read the host file,
1.97 raeburn 2559: then restart children for each host. Now that children are started on demand, this
1.88 foxr 2560: just kills all child processes and lets requests start them as needed again.
2561:
2562:
2563: =item CRITICAL Restarting
2564:
2565: SigHUP received. all the children are killed and the script exec's itself to start again.
2566:
2567: =item CRITICAL Nicely killing lonc for host pid = <pid>
2568:
2569: Attempting to kill the child that is serving the specified host (pid given) cleanly via
1.97 raeburn 2570: SIGQUIT. The child should handle that, clean up nicely and exit.
1.88 foxr 2571:
2572: =item CRITICAL Nastily killing lonc for host pid = <pid>
2573:
2574: The child specified did not die when requested via SIGQUIT. Therefore it is killed
2575: via SIGKILL.
2576:
2577: =item CRITICAL Asked to kill children.. first be nice..
2578:
2579: In the parent's INT handler. INT kills the child processes. This inidicate loncnew
2580: is about to attempt to kill all known children via SIGQUIT. This message should be followed
2581: by one "Nicely killing" message for each extant child.
2582:
2583: =item CRITICAL Now kill children nasty
2584:
2585: In the parent's INT handler. remaining children are about to be killed via
2586: SIGKILL. Should be followed by a Nastily killing... for each lonc child that
2587: refused to die.
2588:
2589: =item CRITICAL Master process exiting
2590:
2591: In the parent's INT handler. just prior to the exit 0 call.
2592:
2593: =back
2594:
2595: =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