Return to lonManage CVS log

Up to [LON-CAPA] / loncom

re-factored the LondConnection state machine sequencing into a separate
sub:   SequenceStateMachine

    1: #!/usr/bin/perl
    2: # The LearningOnline Network with CAPA
    3: #
    4: #  lonManage supports remote management of nodes in a LonCAPA cluster.
    5: #
    6: #  $Id: lonManage,v 1.25 2003/11/04 11:52:06 foxr Exp $
    7: #
    8: # $Id: lonManage,v 1.25 2003/11/04 11:52:06 foxr Exp $
    9: #
   10: # Copyright Michigan State University Board of Trustees
   11: #
   12: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   13: ## LON-CAPA is free software; you can redistribute it and/or modify
   14: # it under the terms of the GNU General Public License as published by
   15: # the Free Software Foundation; either version 2 of the License, or
   16: # (at your option) any later version.
   17: #
   18: # LON-CAPA is distributed in the hope that it will be useful,
   19: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   20: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   21: # GNU General Public License for more details.
   22: #
   23: # You should have received a copy of the GNU General Public License
   24: # along with LON-CAPA; if not, write to the Free Software
   25: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   26: #
   27: # /home/httpd/html/adm/gpl.txt
   28: #
   29: # http://www.lon-capa.org/
   30: #
   31: #
   32: #   lonManage supports management of remot nodes in a lonCAPA cluster.
   33: #   it is a command line tool.  The following command line syntax (usage)
   34: #   is supported:
   35: #
   36: #    lonManage  -push   <tablename>  newfile  [host]
   37: #        Push <tablename> to the lonTabs directory.  Note that
   38: #        <tablename> must be one of:
   39: #           host  (hosts.tab)
   40: #           domain (domain.tab)
   41: #
   42: #    lonManage  -reinit lonc [host]
   43: #           Sends a HUP signal to the remote systems's lond.
   44: #
   45: #    lonmanage  -reinit lond [host]
   46: #          Requests the remote system's lond perform the same action as if
   47: #          it had received a HUP signal.
   48: #
   49: #    In the above syntax, the host above is the hosts.tab name of a host,
   50: #    not the IP address of the host
   51: #  
   52: #   If [host] is not supplied, every host in the client's hosts.tab
   53: #   table is iterated through and procesed..
   54: #
   55: #
   56: 
   57: 
   58: 
   59: # Modules required:
   60: 
   61: use lib ".";
   62: 
   63: use strict;			# Because it's good practice.
   64: use English;			# Cause I like meaningful names.
   65: use Getopt::Long;
   66: use LondConnection;
   67: use IO::Poll qw(POLLRDNORM POLLWRNORM POLLIN POLLHUP POLLOUT);
   68: 
   69: # File scoped variables:
   70: 
   71: my %perlvar;			# Perl variable defs from apache config.
   72: my %hostshash;			# Host table as a host indexed hash.
   73: 
   74: my $MyHost="";			# Host name to use as me.
   75: my $ForeignHostTab="";		# Name of foreign hosts table.
   76: 
   77: my $DefaultServerPort =  5663;	# Default server port if standalone.
   78: my $ServerPort;			# Port used to connect to lond.
   79: 
   80: my $TransitionTimeout = 5;	# Poll timeout in seconds.
   81: 
   82: 
   83: # LondConnection::SetDebug(10);
   84: 
   85: 
   86: #
   87: #   prints out utility's command usage info.
   88: #
   89: sub Usage  {
   90:     print "Usage:";
   91:     print <<USAGE;
   92:  lonManage  [--myname=host --hosts=table] --push=<tablename>  newfile  [host]
   93:         Push <tablename> to the lonTabs directory.  Note that
   94:         <tablename> must be one of:
   95:            host  (hosts.tab)
   96:            domain (domain.tab)
   97: 
   98:  lonManage [--myname=host --hosts=table] --reinit=lonc [host]
   99:        Causes lonc in the remote system to reread hosts.tab and
  100:        adjust the set of clients that are being maintained to match
  101:        the new file.
  102:        
  103: 
  104:  lonManage [--myname=host --hosts=table] --reinit=lond [host]
  105:        Causes lond in the remote system to reread the hosts.tab file
  106:        and adjust the set of servers to match changes in that file.
  107: 
  108:     In the above syntax, the host above is the hosts.tab name of a host,
  109:     not the IP address of the host.
  110: 
  111:     If [host] is omitted, all hosts in the hosts.tab file are iterated
  112:     over.
  113: 
  114:  For all of the above syntaxes if --myname=host and --hosts=table are
  115:  supplied (both must be present), the utility runs in standalone mode
  116:  presenting itself to the world as 'host' and using the hosts.tab file
  117:  specified in the --hosts switch.
  118: USAGE
  119: 
  120: 
  121: }
  122: 
  123: #
  124: #  Make a direct connection to the lond in 'host'.  The port is 
  125: #  gotten from the global variable:  ServerPort.
  126: #  Returns:
  127: #    The connection or undef if one could not be formed.
  128: #
  129: sub MakeLondConnection {
  130:     my $host = shift;
  131: 
  132:     my $Connection = LondConnection->new($host, $ServerPort);
  133:     return return $Connection;
  134: }
  135: #
  136: #   Process the connection state machine until the connection
  137: #   becomes idle. This is used both to negotiate the initial
  138: #   connection, during which the LondConnection sequences a rather 
  139: #   complex state machine and during the transaction itself
  140: #   for a simpler set of transitions.
  141: #   All we really need to be concerned with is whether or not
  142: #   we're readable or writable and the final state:
  143: #
  144: #   Parameter:
  145: #       connection   - Represents the LondConnection to be sequenced.
  146: #       timeout      - Maximum time to wait for readable/writable sockets.
  147: #                      in seconds. < 0 waits forever.
  148: #   Return:
  149: #       'ok'         - We got to idle ok.
  150: #       'error:msg'  - An error occured. msg describes the error.
  151: #
  152: sub SequenceStateMachine {
  153:     my $connection   = shift;
  154:     my $timeout      = shift;
  155: 
  156:     my $Socket       = $connection->GetSocket;
  157:     my $returnstatus = "ok";	              # optimist!!!
  158:     my $error        = 0;	              # Used to force early loop termination
  159:                                               # damned perl has no break!!.
  160:     my $state        = $connection->GetState;
  161: 
  162:     while(($connection->GetState ne "Idle") && (!$error)) {
  163: 	#
  164: 	# Figure out what the connection wants. read/write and wait for it
  165: 	# or for the timeout.
  166: 	#
  167: 	my $wantread = $connection->WantReadable;
  168: 	my $poll     = new IO::Poll;
  169: 	$poll->mask($Socket, => $wantread ? POLLIN : POLLOUT);
  170: 	$poll->poll($timeout);
  171: 	my $done     = $poll->handles();
  172: 	if(scalar($done) == 0) {            # no handles ready... timeout!!
  173: 	    $returnstatus  = "error:";
  174: 	    $returnstatus .= "Timeout in state $state\n";
  175: 	    $error         = 1;
  176: 	} else {
  177: 	    my $status;
  178: 	    $status        = $wantread ? $connection->Readable :
  179: 		                         $connection->Writable;
  180: 	    if($status != 0) {
  181: 		$returnstatus  =  "error:";
  182: 		$returnstatus .=  " I/O failed in state $state\n";
  183: 		$error = 1;
  184: 	    }
  185: 	}
  186: 	$state = $connection->GetState;
  187:     }
  188:     return $returnstatus;
  189: }
  190: 
  191: #
  192: #    This function runs through the section of the connection
  193: #   state machine that has to do with negotiating the startup 
  194: #   sequence with lond.  The general strategy is to loop
  195: #   until the connection state becomes idle or disconnected.
  196: #   Disconnected indicates an error or rejection of the
  197: #   connection at some point in the negotiation.
  198: #   idle indicates a connection ready for a request.
  199: #   The main loop consults the object to determine if it
  200: #   wants to be writeable or readable, waits for that
  201: #   condition on the socket (with timeout) and  then issues
  202: #   the appropriate LondConnection call. Note that
  203: #   LondConnection is capable of doing everything necessary
  204: #   to get to the initial idle state.
  205: # 
  206: #
  207: #  Parameters:
  208: #     connection - A connection that has been created with
  209: #                  the remote lond.  This connection should
  210: #                  be in the Connected state ready to send
  211: #                  the init sequence.
  212: #
  213: sub NegotiateStartup {
  214:     my $connection = shift;
  215:     my $returnstatus = "ok";	# Optimistic!!.
  216: 
  217:     my $state      = $connection->GetState;
  218:     if($state ne "Connected") {
  219: 	print "Error: Initial lond connection state: $state should be Connected\n";
  220: 	return "error";
  221:     }
  222: 
  223:     return SequenceStateMachine($connection, $TransitionTimeout);
  224: }
  225: #
  226: #   Perform a transaction with the remote lond.
  227: #   Paramters:
  228: #      connection - the connection object that represents
  229: #                   a LondConnection to the remote lond.
  230: #      command    - The request to send to the remote system.
  231: #   Returns:
  232: #       The 'reaction' of the lond to this command.
  233: #       However if the connection to lond is lost during the transaction
  234: #       or some other error occurs, the text "error:con_lost" is returned.
  235: #    
  236: sub PerformTransaction {
  237:     my $connection  = shift;
  238:     my $command     = shift;
  239:     my $retval;                          # What we'll returnl.
  240: 
  241:    
  242:     #  Set up the connection to do the transaction then
  243:     #  do the I/O until idle or error.
  244:     #
  245:     $connection->InitiateTransaction($command);
  246: 
  247:     my $status = SequenceStateMachine($connection, $TransitionTimeout);
  248:     if($status eq "ok") {
  249: 	$retval = $connection->GetReply;
  250:     } else {
  251: 	$retval = $status;
  252:     }
  253: 
  254:     return $retval;
  255: }
  256: #
  257: # Performs a transaction direct to a remote lond.
  258: #   Parameter:
  259: #      cmd  - The text of the request.
  260: #      host - The host to which the request ultimately goes.
  261: #   Returns:
  262: #      The text of the reply from the lond or con_lost if not able to contact
  263: #      lond/lonc etc.
  264: #
  265: sub subreply {
  266:     my $cmd = shift;
  267:     my $host = shift;
  268: 
  269: 
  270:     my $connection  = MakeLondConnection($host);
  271:     if ($connection eq undef) {
  272: 	return "Connect Failed";
  273:     }
  274:     my $reply = NegotiateStartup($connection);
  275:     if($reply ne "ok") {
  276: 	return "connection negotiation failed";
  277:     }
  278:     my $reply =  PerformTransaction($connection, $cmd);
  279:     return $reply;
  280: 
  281: 
  282:      #    my ($cmd,$server)=@_;
  283:      #    my $peerfile="$perlvar{'lonSockDir'}/$server";
  284:      #    my $client=IO::Socket::UNIX->new(Peer    =>"$peerfile",
  285:      #                                     Type    => SOCK_STREAM,
  286:      #                                     Timeout => 10)
  287:      #       or return "con_lost";
  288:      #    print $client "$cmd\n";
  289:      #    my $answer=<$client>;
  290:      #    if (!$answer) { $answer="con_lost"; }
  291:      #    chomp($answer);
  292:      #    return $answer;
  293: }
  294: #   >>> BUGBUG <<< 
  295: #
  296: #  Use Getopt::Long to parse the parameters of the program.
  297: #
  298: #  Return value is a list consisting of:
  299: #    A 'command' which is one of:
  300: #       push   - table push requested.
  301: #       reinit - reinit requested.
  302: #   Additional parameters as follows:
  303: #       for push: Tablename, hostname
  304: #       for reinit: Appname  hostname
  305: #
  306: #   This function does not validation of the parameters of push and
  307: #   reinit.
  308: #
  309: #   returns a list.  The first element of the list is the operation name
  310: #   (e.g. reinit or push).  The second element is the switch parameter.
  311: #   for push, this is the table name, for reinit, this is the process name.
  312: #   Additional elements of the list are the command argument.  The count of
  313: #   command arguments is validated, but not their semantics.
  314: #
  315: #   returns an empty list if the parse fails.
  316: #
  317: 
  318: 
  319: sub ParseArgs {
  320:     my $pushing   = '';
  321:     my $reinitting = '';
  322: 
  323:     if(!GetOptions('push=s'    => \$pushing,
  324: 	           'reinit=s'  => \$reinitting,
  325: 		   'myname=s' => \$MyHost,
  326: 		   'hosts=s' => \$ForeignHostTab)) {
  327: 	return ();
  328:     }
  329:     #  The --myname and --hosts switch must have values and
  330:     #  most both appear if either appears:
  331: 
  332:     if(($MyHost ne "") && ($ForeignHostTab eq "")) {
  333: 	return ();
  334:     }
  335:     if(($ForeignHostTab ne "") && ($MyHost eq "")) {
  336: 	return ();
  337:     }
  338: 
  339:     #  Require exactly   one of --push and --reinit
  340: 
  341:     my $command    = '';
  342:     my $commandarg = '';
  343:     my $paramcount = @ARGV; 	# Number of additional arguments.
  344:     
  345: 
  346:     if($pushing ne '') {
  347: 
  348:         # --push takes in addition a table, and an optional  host:
  349:         #
  350: 	if(($paramcount != 2) && ($paramcount != 1)) {
  351: 	    return ();		# Invalid parameter count.
  352: 	}
  353: 	if($command ne '') {
  354: 	    return ();
  355: 	} else {
  356: 	    
  357: 	    $command    = 'push';
  358: 	    $commandarg = $pushing;
  359: 	}
  360:     }
  361: 
  362:     if ($reinitting ne '') {
  363: 
  364: 	# --reinit takes in addition just an optional  host name
  365: 
  366: 	if($paramcount > 1) {
  367: 	    return ();
  368: 	}
  369: 	if($command ne '') {
  370: 	    return ();
  371: 	} else {
  372: 	    $command    = 'reinit';
  373: 	    $commandarg = $reinitting; 
  374: 	}
  375:     }
  376: 
  377:     #  Build the result list:
  378: 
  379:     my @result = ($command, $commandarg);
  380:     my $i;
  381:     for($i = 0; $i < $paramcount; $i++) {
  382: 	push(@result, $ARGV[$i]);
  383:     }
  384:     
  385:     return @result;
  386: }
  387: #
  388: #  Read the loncapa configuration stuff.  If ForeignHostTab is empty,
  389: #  assume we are part of a loncapa cluster and read the hosts.tab
  390: #  file from the config directory.  Otherwise, ForeignHossTab
  391: #  is the name of an alternate configuration file to read in 
  392: #  standalone mode.
  393: #
  394: sub ReadConfig {
  395: 
  396:     if($ForeignHostTab eq "") {
  397: 	my $perlvarref = LondConnection::read_conf('loncapa.conf');
  398: 	%perlvar       = %{$perlvarref};
  399: 	my $hoststab   = LondConnection::read_hosts(
  400: 					    "$perlvar{'lonTabDir'}/hosts.tab");
  401: 	%hostshash     = %{$hoststab};
  402: 	$MyHost        = $perlvar{lonHostID}; # Set hostname from vars.
  403: 	$ServerPort    = $perlvar{londPort};
  404:     } else {
  405: 	
  406: 	LondConnection::ReadForeignConfig($MyHost, $ForeignHostTab);
  407: 	  my $hoststab = LondConnection::read_hosts($ForeignHostTab); #  we need to know too.
  408: 	  %hostshash   = %{$hoststab};
  409: 	  $ServerPort    = $DefaultServerPort;
  410:       }
  411:     
  412: }
  413: #
  414: #  Determine if the target host is valid.
  415: #  This is done by reading the current hosts.tab file.
  416: #  For the host to be valid, it must be inthe file.
  417: #
  418: #  Parameters:
  419: #     host   - Name of host to check on.
  420: #  Returns:
  421: #     true   if host is valid.
  422: #     false  if host is invalid.
  423: #
  424: sub ValidHost {
  425:     my $host       = shift;
  426:    
  427: 
  428:     return defined $hostshash{$host};
  429: 
  430: }
  431: 
  432: 
  433: 
  434: #
  435: #  Performs a transaction with lonc.
  436: #  By the time this is called, the transaction has already been
  437: #  validated by the caller.
  438: #
  439: #   Parameters:
  440: #
  441: #   host    - hosts.tab name of the host whose lonc we'll be talking to.
  442: #   command - The base command we'll be asking lond to execute.
  443: #   body    - [optional] If supplied, this is a command body that is a ref.
  444: #             to an array of lines that will be appended to the 
  445: #             command.
  446: #
  447: #  NOTE:
  448: #    The command will be done as an encrypted operation.
  449: #
  450: sub Transact {
  451:     my $host    = shift;
  452:     my $command = shift;
  453:     my $haveBody= 0;
  454:     my $body;
  455:     my $i;
  456: 
  457:     if(scalar @ARG) {
  458: 	$body = shift;
  459: 	$haveBody = 1;
  460:     }
  461:     #  Construct the command to send to the server:
  462:     
  463:     my $request = "encrypt\:";	# All requests are encrypted.
  464:     $request   .= $command;
  465:     if($haveBody) {
  466: 	$request .= "\:";
  467: 	my $bodylines = scalar @$body;
  468: 	for($i = 0; $i < $bodylines; $i++) {
  469: 	    $request .= $$body[$i];
  470: 	}
  471:     } else {
  472: 	$request .= "\n";
  473:     }
  474:     # Body is now built... transact with lond..
  475:     
  476:     my $answer = subreply($request, $host);
  477: 
  478:     print "$answer\n";
  479: 
  480: }
  481: #
  482: #   Called to push a file to the remote system.
  483: #   The only legal files to push are hosts.tab and domain.tab.
  484: #   Security is somewhat improved by
  485: #   
  486: #   - Requiring the user run as root.
  487: #   - Connecting with lonc rather than lond directly ensuring this is a loncapa
  488: #     host
  489: #   - We must appear in the remote host's hosts.tab file.
  490: #   - The host must appear in our hosts.tab file.
  491: #
  492: #  Parameters:
  493: #     tablename - must be one of hosts or domain.
  494: #     tablefile - name of the file containing the table to push.
  495: #     host      - name of the host to push this file to.     
  496: #
  497: #    >>>BUGBUG<<< This belongs in lonnet.pm.
  498: #
  499: sub PushFile {
  500:     my $tablename = shift;
  501:     my $tablefile = shift;
  502:     my $host      = shift;
  503:     
  504:     # Open the table file:
  505: 
  506:     if(!open(TABLEFILE, "<$tablefile")) {
  507: 	die "ENOENT - No such file or directory $tablefile";
  508:     }
  509:   
  510:     # Require that the host be valid:
  511: 
  512:     if(!ValidHost($host)) {
  513: 	die "EHOSTINVAL - Invalid host $host"; # Ok so I invented this 'errno'.
  514:     }
  515:     # Read in the file.  If the table name is valid, push it.
  516: 
  517:     my @table = <TABLEFILE>;	#  These files are pretty small.
  518:     close TABLEFILE;
  519: 
  520:     if( ($tablename eq "host")    ||
  521: 	($tablename eq "domain")) {
  522: 	print("Pushing $tablename to $host\n");
  523: 	Transact($host, "pushfile:$tablename",\@table);
  524:     } else {
  525: 	die "EINVAL - Invalid parameter. tablename: $tablename must be host or domain";
  526:     }
  527: }
  528: #
  529: #   This function is called to reinitialize a server in a remote host.
  530: #   The servers that can be reinitialized are:
  531: #   - lonc   - The lonc client process.
  532: #   - lond   - The lond daemon.
  533: #  NOTE:
  534: #    Reinitialization in this case means re-scanning the hosts table,
  535: #    starting new lond/lonc's as approprate and stopping existing lonc/lond's.
  536: #
  537: #  Parameters:
  538: #     process - The name of the process to reinit (lonc or lond).
  539: #     host    - The host in which this reinit will happen.
  540: #
  541: #   >>>BUGBUG<<<< This belongs  in lonnet.pm
  542: #
  543: sub ReinitProcess {
  544:     my $process = shift;
  545:     my $host    = shift;
  546: 
  547:     #  Ensure the host is valid:
  548:     
  549:     if(!ValidHost($host)) {
  550: 	die "EHOSTINVAL - Invalid host $host";
  551:     }
  552:     # Ensure target process selector is valid:
  553: 
  554:     if(($process eq "lonc") ||
  555:        ($process eq "lond")) {
  556: 	print("Reinitializing $process in $host\n");
  557: 	Transact($host, "reinit:$process");
  558:     } else {
  559: 	die "EINVAL -Invalid parameter. Process $process must be lonc or lond";
  560:     }
  561: }
  562: #--------------------------- Entry point: --------------------------
  563: 
  564: 
  565: 
  566: #  Parse the parameters
  567: #  If command parsing failed, then print usage:
  568: 
  569: my @params   = ParseArgs;
  570: my $nparam   = @params;
  571: 
  572: if($nparam == 0) {
  573:     Usage;
  574:     exit -1;
  575: }
  576: #
  577: #   Next, ensure we are running as EID root.
  578: #
  579: if ($EUID != 0) {
  580:     die "ENOPRIV - No privilege for requested operation"
  581: }
  582: 
  583: #
  584: #   Read the configuration file.
  585: #   
  586: 
  587: ReadConfig;			# Read the configuration info (incl.hosts).
  588: 
  589: #   Based on the operation requested invoke the appropriate function:
  590: 
  591: my $operation = shift @params;
  592: 
  593: if($operation eq "push") {  # push tablename filename host
  594:     my $tablename = shift @params;
  595:     my $tablefile = shift @params;
  596:     my $host      = shift @params;
  597:     if($host) {
  598: 	PushFile($tablename, $tablefile, $host);
  599:     } else {			# Push to whole cluster.
  600: 	foreach my $host (keys %hostshash) {
  601: 	    PushFile($tablename, $tablefile, $host);
  602: 	}
  603:     }
  604: 
  605: } elsif($operation eq "reinit") {	# reinit processname host.
  606:     my $process   = shift @params;
  607:     my $host      = shift @params;
  608:     if ($host) {
  609: 	ReinitProcess($process, $host);
  610:     } else {			# Reinit whole cluster.
  611: 	foreach my $host (keys %hostshash) {
  612: 	    ReinitProcess($process,$host);
  613: 	}
  614:     }
  615: } 
  616: else {
  617:     Usage;
  618: }
  619: exit 0;
  620: 
  621: =head1 NAME
  622:     lonManage - Command line utility for remote management of lonCAPA
  623:     cluster nodes.
  624: 
  625: =head1 SYNOPSIS
  626: 
  627: Usage:
  628:     B<lonManage  --push=<tablename>  newfile  host>
  629:         Push <tablename> to the lonTabs directory.  Note that
  630:         <tablename> must be one of:
  631:            hosts  (hosts.tab)
  632:            domain (domain.tab)
  633: 
  634:     B<lonManage  --reinit=lonc host>
  635:            Sends a HUP signal to the remote systems's lond.
  636: 
  637:     B<lonmanage  --reinit=lond host>
  638:           Requests the remote system's lond perform the same action as if
  639:           it had received a HUP signal.
  640: 
  641:     In the above syntax, the host above is the hosts.tab name of a host,
  642:     not the IP address of the host.
  643: 
  644: 
  645: =head1 DESCRIPTION
  646: 
  647: =head1 PREREQUISITES
  648: 
  649: =item strict
  650: =item Getopt::Long
  651: =item English
  652: =item IO::Socket::UNIX
  653: 
  654: =head1 KEY Subroutines.
  655: 
  656: =head1  CATEGORIES
  657:     Command line utility
  658: 
  659: =cut