File:  [LON-CAPA] / loncom / clusteradmin
Revision 1.4: download - view: text, annotated - select for diffs
Thu May 12 14:08:54 2011 UTC (12 years, 11 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD
- Fix typos in documentation.
- Skip update of dns_*.tab files on server where clusteradmin is being run.

    1: #!/usr/bin/perl
    2: 
    3: =pod
    4: 
    5: =head1 SYNOPSIS
    6: 
    7:  clusteradmin command [args]
    8: 
    9: =head1 DESCRIPTION
   10: 
   11: Performs an adminstrative action on DNS hosts in the current hosts.tab
   12: file.  For this to work, the current host must be the cluster administrator
   13: on the target systems.  That is this must be a host in managers.tab
   14: Furthermore, lonc must be running on this system.
   15: 
   16: The action is specified by the 'command' parameter which may have additional arguments.
   17: 
   18: All communications with remote clients are made critical so that
   19: they will eventually happen even if the host we want to talk with
   20: is dead.
   21: 
   22: 
   23: =head1 ACTIONS
   24: 
   25: =over 3
   26: 
   27: =item help 
   28: 
   29: Outputs a brief description of the actions supported and what they do.
   30: 
   31: =item update file
   32: 
   33: Update the contents of an administrative file with the contents of that file 
   34: on this system.  'file' is the name of that file, not the path for example:
   35: 
   36:   clusteradmin update dns_hosts.tab
   37: 
   38: =back
   39: 
   40: =head1 ASSUMPTIONS
   41: 
   42: Assume that loncapa is installedin /home/httpd/lib/perl so that we can use
   43: it's modules.  If this is not the case, you mus modify the
   44: use lib line in the program before you can use it.
   45: 
   46: 
   47: =cut
   48: 
   49: use strict;
   50: 
   51: # I'm not sure if there's a better way to establish the location of the libs:
   52: 
   53: use lib ('/home/httpd/lib/perl');
   54: 
   55: use LONCAPA::Configuration;
   56: use File::Basename;
   57: use Apache::lonnet;
   58: 
   59: #----------------------------------------------------------------------------------
   60: #
   61: #  Command dispatch handling:
   62: 
   63: #
   64: #   Dispatch hash for the subcommands.  
   65: #   indexed by the subcommand name, each item is 
   66: #   a reference to the sub that handles the command:
   67: #
   68: 
   69: my %Dispatch;
   70: 
   71: #
   72: #  Define a subcommand:
   73: #
   74: # Parameters:
   75: #    command   - subcommand name string
   76: #    handler   - reference to the handler sub.
   77: # Notes:
   78: #   The handler is dispatched to with the tail of the command 
   79: #   as an array reference parameter.  Suppose the command  is
   80: #
   81: #   clusteradmin update dns_hosts.tab, 
   82: #
   83: #   the array will have a single element:  'dns_hosts.tab'.
   84: #
   85: sub define_command {
   86:     my ($command, $handler)  = @_;
   87: 
   88:     $Dispatch{$command} = $handler;
   89: }
   90: 
   91: #
   92: #   Dispatch to a command:
   93: # Parameters:
   94: #   command    - Name of the command.
   95: #   tail       - Reference to the command tail array.
   96: # Returns:
   97: #   1          - Success.
   98: #   0          - Failure
   99: # Notes:
  100: # 1.  The command handler is assumed to have output any error messages
  101: #     to stderr by now.
  102: # 2.  This function will indicate to stderr if the command isn't in the
  103: #     dispatch hash.
  104: #
  105: sub dispatch_command {
  106:     my ($command, $tail) = @_;
  107:     my $sub;
  108: 
  109:     if (exists($Dispatch{$command})) {
  110: 	$sub = $Dispatch{$command};
  111: 	return $sub->($tail);
  112:     } else {
  113: 	print STDERR "Unrecognized subcommand keyword $command\n";
  114: 	&usage();
  115: 	return 0;
  116:     }
  117: }
  118: #-----------------------------------------------------------------------------------
  119: 
  120: #
  121: #  Provide usage/help string:
  122: #
  123: 
  124: sub usage {
  125:     print STDERR "Usage:\n";
  126:     print STDERR "   clusteradmin subcommand [args]\n";
  127:     print STDERR "Where:\n";
  128:     print STDERR "   subcommand describes what to actually do:\n";
  129:     print STDERR "    help    - Prints this message (args ignored)\n";
  130:     print STDERR "    update  - Updates an administrative file\n";
  131:     print STDERR "              args is one of dns_hosts.tab or dns_domain.tab\n";
  132: 
  133: }
  134: 
  135: &define_command("help", \&usage);
  136: 
  137: 
  138: #--------------------------------------------------------------------------------
  139: #
  140: #  File update subsystem:
  141: 
  142: 
  143: # Given the basename of an administrative file, return the 
  144: # full path to that file.
  145: # Pre-requisistes:
  146: #   Requires that LONCAPA::Configuration is in the use lib path.
  147: # Parameters:
  148: #   $basename   - Base name of the file to locate.
  149: # Returns:
  150: #   Full path to that file.
  151: #
  152: 
  153: my $config_vars = LONCAPA::Configuration::read_conf('loncapa.conf');
  154: my %config = %{$config_vars};
  155: 
  156: 
  157: sub construct_table_path {
  158:     my ($basename) = @_;
  159:     my $directory = $config{'lonTabDir'};
  160: 
  161:     return $directory . '/' . $basename;
  162: }
  163: 
  164: #  Returns the set of hosts that are specified as DNS hosts in the hosts.tab file.
  165: #  Those are the ones with a ^ in column one.
  166: #
  167: #  Returns:
  168: #    The list of host that are DNS hosts.
  169: #
  170: sub get_dns_hosts()
  171: {
  172:     my @result;
  173:     my $hosts_tab = &construct_table_path('hosts.tab');
  174:     open(HOSTS, "<$hosts_tab");
  175:     while (my $line = <HOSTS>) {
  176: 	chomp($line);
  177: 	if ($line =~ /^\^/) {
  178: 	    $line =~ s/^\^//;           # Get rid of leading ^
  179: 	    $line =~ s/\s*$//;          # and any trailing whitespace.
  180: 	    push(@result, $line);
  181: 	}
  182:     }
  183:     return (@result);
  184: }
  185: 
  186: # Actually push the new files to the systems to update.  This is done as a critical
  187: # transaction so that the files eventually get pushed, even if the target hosts
  188: # are down about now.
  189: #
  190: # Parameters: 
  191: #   specifier     - The specifier to hand in the push transaction. This
  192: #                   identifies the target file in the remote lond process.
  193: #   pushfile     - Full path to the file to push.
  194: #   hosts         - Reference to an array of hosts into which the file should be pushed.
  195: #
  196: # Returns:
  197: #    1     - Success.
  198: #    0     - Failure with appropriate output to stderr.
  199: #
  200: sub push_file {
  201:     my ($specifier, $pushfile, $hosts) = @_;
  202: 
  203:     # Read in the entire file:
  204: 
  205:     my $contents;
  206:     my $line;
  207:     open(FILE, "<$pushfile");
  208:     while ($line = <FILE>) {
  209: 	$contents .= $line;
  210:     }
  211: 
  212: 
  213:     # Construct the transaction for safety we encrypt the transaction
  214:     #
  215:     my $cmd = "encrypt:pushfile:$specifier:$contents";
  216: 
  217:     # Iterate over the hosts and run cmd as a critical 
  218:     # operation:
  219: 
  220:     foreach my $host (@$hosts) {
  221: 	my $loncapa_name = &Apache::lonnet::host_from_dns($host);
  222:         next if ($loncapa_name eq $config{'lonHostID'});
  223: 	my $reply  = &Apache::lonnet::critical($cmd, $loncapa_name);
  224: 	if ($reply ne 'ok') {
  225: 	    print STDERR "Reply from $host ($loncapa_name)  not 'ok' was: $reply\n";
  226: 	}
  227:     }
  228:     
  229: }
  230: 
  231: #
  232: #   Controls the push of a file to the servers that deserve to get it.
  233: # Parameters:
  234: #    args   - Tail of the command line (array reference).
  235: # Returns:
  236: #    1      - Success.
  237: #    0      - Failure (printing messages to stderr.
  238: #
  239: sub update_file {
  240:     my ($args) = @_;
  241: 
  242:     if (scalar(@$args) != 1) {
  243: 	print STDERR "Incorrect number of command arguments\n";
  244: 	&usage();
  245: 	return 0;
  246:     } else {
  247: 	my $filename = shift(@$args);
  248: 	
  249: 	# Validate the filename:
  250: 
  251: 	if ($filename eq 'dns_hosts.tab' || $filename eq 'dns_domain.tab') {
  252: 	    my $pushfile   = &construct_table_path($filename);
  253: 	    my $specifier  = basename($filename, ('.tab'));
  254: 	    my @hosts         = (&get_dns_hosts());
  255: 	    return &push_file($specifier, $pushfile,  \@hosts);
  256: 	} else {
  257: 	    print STDERR "Only dns_hosts.tab or dns_domain.tab can be updated\n";
  258: 	    &usage();
  259: 	    return 0;
  260: 	}
  261:     }
  262: }
  263: &define_command("update", \&update_file);
  264: 
  265: #
  266: # Checks if current lonHostID is in managers.tab for the cluster, and is in the cluster.
  267: # Parameters:
  268: #    args   - none
  269: # Returns:
  270: #    1      - lonHostID is is managers.tab
  271: #    ''     - Failure (printing messages to STDERR).
  272: #
  273: sub is_manager {
  274:     my $currhost = $config{'lonHostID'};
  275:     my $canmanage;
  276:     if ($currhost eq '') {
  277:         print STDERR "Could not determine LON-CAPA host ID\n";
  278:         return;
  279:     } elsif (!defined &Apache::lonnet::get_host_ip($currhost)) {
  280:         print STDERR "This LON-CAPA host is not part of the cluster.\n";
  281:     }
  282:     my $tablename = &construct_table_path('managers.tab');
  283:     if (!open (MANAGERS, $tablename)) {
  284:         print STDERR "No managers.tab table. Could not verify host is a manager\n";
  285:         return;
  286:     }
  287:     while(my $host = <MANAGERS>) {
  288:         chomp($host);
  289:         next if ($host =~ /^\#/);
  290:         if ($host eq $currhost) {
  291:             $canmanage = 1;
  292:             last;
  293:         }
  294:     }
  295:     close(MANAGERS);
  296:     return $canmanage;
  297: }
  298: #---------------------------------------------------------------------------------
  299: #
  300: #  Program entry point.  Decode the subcommand from the args array and
  301: #  dispatch to the appropriate command processor.
  302: #
  303: 
  304: my $argc = scalar(@ARGV);
  305: if ($argc == 0) {
  306:     print STDERR "Missing subcommand\n";
  307:     &usage();
  308:     exit(-1);
  309: }
  310: 
  311: if (!&is_manager()) {
  312:     print STDERR  'Script needs to be run from a server designated as a "Manager" in the LON-CAPA cluster'."\n";
  313:     exit(-1);
  314: }
  315: 
  316: my $subcommand = shift(@ARGV);     # argv now the tail.
  317: 
  318: if (!&dispatch_command($subcommand, \@ARGV)) {
  319:     exit(0);
  320: } else {
  321:     exit(-1);
  322: }
  323: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>