File:  [LON-CAPA] / loncom / clusteradmin
Revision 1.8: download - view: text, annotated - select for diffs
Mon Aug 20 22:42:05 2018 UTC (5 years, 7 months ago) by raeburn
Branches: MAIN
CVS tags: version_2_12_X, HEAD
- Cluster manager can push updated Certificate Revocation List to cluster's
  "name servers".

    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.8 2018/08/20 22:42:05 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, dns_domain.tab\n";
  160:     print STDERR "              or loncapaCAcrl.pem\n";
  161: 
  162: }
  163: 
  164: &define_command("help", \&usage);
  165: 
  166: 
  167: #--------------------------------------------------------------------------------
  168: #
  169: #  File update subsystem:
  170: 
  171: 
  172: # Given the basename of an administrative file, return the 
  173: # full path to that file.
  174: # Pre-requisistes:
  175: #   Requires that LONCAPA::Configuration is in the use lib path.
  176: # Parameters:
  177: #   $basename   - Base name of the file to locate.
  178: # Returns:
  179: #   Full path to that file.
  180: #
  181: 
  182: my $config_vars = LONCAPA::Configuration::read_conf('loncapa.conf');
  183: my %config = %{$config_vars};
  184: my $logfile = $config{'lonDaemons'}.'/logs/dns_updates.log';
  185: 
  186: 
  187: sub construct_table_path {
  188:     my ($basename) = @_;
  189:     my $directory;
  190:     if ($basename eq 'managers.tab') {
  191:         $directory = $config{'lonTabDir'};
  192:     } elsif ($basename eq 'loncapaCAcrl.pem') {
  193:         $directory = $config{'lonCertificateDirectory'};
  194:     } elsif ($basename =~ /^(dns_|)(hosts|domain)\.tab$/) {
  195:         $directory = $config{'lonTabDir'};
  196:     }
  197:     return $directory . '/' . $basename;
  198: }
  199: 
  200: #  Returns the set of hosts that are specified as DNS hosts in the hosts.tab file.
  201: #  Those are the ones with a ^ in column one.
  202: #
  203: #  Returns:
  204: #    The list of host that are DNS hosts.
  205: #
  206: sub get_dns_hosts()
  207: {
  208:     my @result;
  209:     my $hosts_tab = &construct_table_path('hosts.tab');
  210:     if (open(HOSTS,'<',$hosts_tab)) {
  211:         while (my $line = <HOSTS>) {
  212: 	    chomp($line);
  213: 	    if ($line =~ /^\^/) {
  214:                 if ($line =~ /^\^([\w.\-]+)/) {
  215:                     push(@result,$1);
  216:                 }
  217: 	    }
  218:         }
  219:     }
  220:     return (@result);
  221: }
  222: 
  223: # Actually push the new files to the systems to update.  This is done as a critical
  224: # transaction so that the files eventually get pushed, even if the target hosts
  225: # are down about now.
  226: #
  227: # Parameters: 
  228: #   specifier     - The specifier to hand in the push transaction. This
  229: #                   identifies the target file in the remote lond process.
  230: #   pushfile     - Full path to the file to push.
  231: #   hosts         - Reference to an array of hosts into which the file should be pushed.
  232: #
  233: # Returns:
  234: #    1     - Success.
  235: #    0     - Failure with appropriate output to stderr.
  236: #
  237: sub push_file {
  238:     my ($specifier, $pushfile, $hosts, $fh) = @_;
  239: 
  240:     # Read in the entire file:
  241: 
  242:     my $contents;
  243:     my $line;
  244:     open(FILE,'<',$pushfile);
  245:     while ($line = <FILE>) {
  246: 	$contents .= $line;
  247:     }
  248: 
  249: 
  250:     # Construct the transaction for safety we encrypt the transaction
  251:     #
  252:     my $cmd = "encrypt:pushfile:$specifier:$contents";
  253: 
  254:     # Iterate over the hosts and run cmd as a critical 
  255:     # operation:
  256: 
  257:     my @ids=&Apache::lonnet::current_machine_ids();
  258:     foreach my $host (@$hosts) {
  259: 	my $loncapa_name = &Apache::lonnet::host_from_dns($host);
  260:         next if (grep(/^\Q$loncapa_name\E$/,@ids));
  261: 	my $reply  = &Apache::lonnet::critical($cmd, $loncapa_name);
  262:         my $msg;
  263:         if ($reply eq 'ok') {
  264:             $msg = "$pushfile pushed to $host ($loncapa_name): $reply\n";
  265:         } else {
  266:             $msg = "Reply from $host ($loncapa_name)  not 'ok' was: $reply\n";
  267:         }
  268:         print $fh $msg;
  269:         print STDERR $msg;
  270:     }
  271:     return;   
  272: }
  273: 
  274: #
  275: #   Controls the push of a file to the servers that deserve to get it.
  276: # Parameters:
  277: #    args   - Tail of the command line (array reference).
  278: # Returns:
  279: #    1      - Success.
  280: #    0      - Failure (printing messages to stderr.
  281: #
  282: sub update_file {
  283:     my ($args) = @_;
  284: 
  285:     if (scalar(@$args) != 1) {
  286: 	print STDERR "Incorrect number of command arguments\n";
  287: 	&usage();
  288: 	return 0;
  289:     } else {
  290: 	my $filename = shift(@$args);
  291: 	
  292: 	# Validate the filename:
  293: 
  294: 	if (($filename eq 'dns_hosts.tab') || ($filename eq 'dns_domain.tab') || 
  295:             ($filename eq 'hosts.tab') || ($filename eq 'domain.tab') ||
  296:             ($filename eq 'loncapaCAcrl.pem')) {
  297:             my ($result,$fh);
  298:             if (!-e $logfile) {
  299:                 system("touch $logfile");
  300:                 system("chown www:www $logfile");
  301:             }
  302:             if (open ($fh,'>>',$logfile)) {
  303:                 print $fh "clusteradmin update started: ".localtime(time)."\n";
  304: 	        my $pushfile   = &construct_table_path($filename);
  305:                 my @hosts         = (&get_dns_hosts());
  306:                 my $ext = 'tab';
  307:                 if ($filename eq 'loncapaCAcrl.pem') {
  308:                     $ext = 'pem';
  309:                 }
  310: 	        my $specifier  = basename($filename, (".$ext"));
  311: 	        my @hosts         = (&get_dns_hosts());
  312: 	        $result = &push_file($specifier, $pushfile,  \@hosts, $fh);
  313:                 print $fh "ended: ".localtime(time)."\n";                 
  314:                 close($fh);
  315:             } else {
  316:                 print STDERR "Could not open $logfile to append. Exiting.\n";
  317:             }
  318:             return $result;
  319: 	} else {
  320: 	    print STDERR "Only dns_hosts.tab, dns_domain.tab or loncapaCAcrl.pem can be updated\n";
  321: 	    &usage();
  322: 	    return 0;
  323: 	}
  324:     }
  325: }
  326: &define_command("update", \&update_file);
  327: 
  328: #
  329: # Checks if current lonHostID is in managers.tab for the cluster, and is in the cluster.
  330: # Parameters:
  331: #    args   - none
  332: # Returns:
  333: #    1      - lonHostID is is managers.tab
  334: #    ''     - Failure (printing messages to STDERR).
  335: #
  336: sub is_manager {
  337:     my $currhost = $config{'lonHostID'};
  338:     my $canmanage;
  339:     if ($currhost eq '') {
  340:         print STDERR "Could not determine LON-CAPA host ID\n";
  341:         return;
  342:     } elsif (!defined &Apache::lonnet::get_host_ip($currhost)) {
  343:         print STDERR "This LON-CAPA host is not part of the cluster.\n";
  344:     }
  345:     my $tablename = &construct_table_path('managers.tab');
  346:     if (!open (MANAGERS, $tablename)) {
  347:         print STDERR "No managers.tab table. Could not verify host is a manager\n";
  348:         return;
  349:     }
  350:     while(my $host = <MANAGERS>) {
  351:         chomp($host);
  352:         next if ($host =~ /^\#/);
  353:         if ($host eq $currhost) {
  354:             $canmanage = 1;
  355:             last;
  356:         }
  357:     }
  358:     close(MANAGERS);
  359:     return $canmanage;
  360: }
  361: #---------------------------------------------------------------------------------
  362: #
  363: #  Program entry point.  Decode the subcommand from the args array and
  364: #  dispatch to the appropriate command processor.
  365: #
  366: 
  367: if ($< != 0) { # Am I root?
  368:    print('You must be root in order to run clusteradmin.'.
  369:          "\n");
  370:    exit(-1);
  371: }
  372: 
  373: my $argc = scalar(@ARGV);
  374: if ($argc == 0) {
  375:     print STDERR "Missing subcommand\n";
  376:     &usage();
  377:     exit(-1);
  378: }
  379: 
  380: if (!&is_manager()) {
  381:     print STDERR  'Script needs to be run from a server designated as a "Manager" in the LON-CAPA cluster'."\n";
  382:     exit(-1);
  383: }
  384: 
  385: my $subcommand = shift(@ARGV);     # argv now the tail.
  386: 
  387: if (!&dispatch_command($subcommand, \@ARGV)) {
  388:     exit(0);
  389: } else {
  390:     exit(-1);
  391: }
  392: 

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