File:  [LON-CAPA] / loncom / clusteradmin
Revision 1.7: download - view: text, annotated - select for diffs
Mon Aug 20 22:31:49 2018 UTC (5 years, 8 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD
- Update POD.

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

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