Annotation of loncom/clusteradmin, revision 1.8

1.1       foxr        1: #!/usr/bin/perl
1.6       raeburn     2: # The LearningOnline Network with CAPA
                      3: # Push admin files from cluster manager to cluster's "name servers".
                      4: #
1.8     ! raeburn     5: # $Id: clusteradmin,v 1.7 2018/08/20 22:31:49 raeburn Exp $
1.6       raeburn     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/
1.1       foxr       27: 
                     28: =pod
                     29: 
                     30: =head1 SYNOPSIS
                     31: 
                     32:  clusteradmin command [args]
                     33: 
                     34: =head1 DESCRIPTION
                     35: 
1.7       raeburn    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.
1.1       foxr       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
1.4       raeburn    47: they will eventually happen even if the host we want to talk with
1.1       foxr       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: 
1.2       foxr       68: =head1 ASSUMPTIONS
                     69: 
1.7       raeburn    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
1.2       foxr       72: use lib line in the program before you can use it.
                     73: 
1.1       foxr       74: 
                     75: =cut
                     76: 
                     77: use strict;
                     78: 
1.2       foxr       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;
1.1       foxr       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: #-----------------------------------------------------------------------------------
1.2       foxr      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";
1.8     ! raeburn   159:     print STDERR "              args is one of dns_hosts.tab, dns_domain.tab\n";
        !           160:     print STDERR "              or loncapaCAcrl.pem\n";
1.2       foxr      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};
1.5       raeburn   184: my $logfile = $config{'lonDaemons'}.'/logs/dns_updates.log';
1.2       foxr      185: 
                    186: 
                    187: sub construct_table_path {
                    188:     my ($basename) = @_;
1.8     ! raeburn   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:     }
1.2       foxr      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');
1.8     ! raeburn   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:         }
1.2       foxr      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 {
1.5       raeburn   238:     my ($specifier, $pushfile, $hosts, $fh) = @_;
1.2       foxr      239: 
                    240:     # Read in the entire file:
                    241: 
                    242:     my $contents;
                    243:     my $line;
1.8     ! raeburn   244:     open(FILE,'<',$pushfile);
1.2       foxr      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: 
1.5       raeburn   257:     my @ids=&Apache::lonnet::current_machine_ids();
1.2       foxr      258:     foreach my $host (@$hosts) {
                    259: 	my $loncapa_name = &Apache::lonnet::host_from_dns($host);
1.5       raeburn   260:         next if (grep(/^\Q$loncapa_name\E$/,@ids));
1.2       foxr      261: 	my $reply  = &Apache::lonnet::critical($cmd, $loncapa_name);
1.5       raeburn   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;
1.2       foxr      270:     }
1.5       raeburn   271:     return;   
1.2       foxr      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: 
1.5       raeburn   294: 	if (($filename eq 'dns_hosts.tab') || ($filename eq 'dns_domain.tab') || 
1.8     ! raeburn   295:             ($filename eq 'hosts.tab') || ($filename eq 'domain.tab') ||
        !           296:             ($filename eq 'loncapaCAcrl.pem')) {
1.5       raeburn   297:             my ($result,$fh);
                    298:             if (!-e $logfile) {
                    299:                 system("touch $logfile");
                    300:                 system("chown www:www $logfile");
                    301:             }
1.8     ! raeburn   302:             if (open ($fh,'>>',$logfile)) {
1.5       raeburn   303:                 print $fh "clusteradmin update started: ".localtime(time)."\n";
                    304: 	        my $pushfile   = &construct_table_path($filename);
1.8     ! raeburn   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"));
1.5       raeburn   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;
1.2       foxr      319: 	} else {
1.8     ! raeburn   320: 	    print STDERR "Only dns_hosts.tab, dns_domain.tab or loncapaCAcrl.pem can be updated\n";
1.2       foxr      321: 	    &usage();
                    322: 	    return 0;
                    323: 	}
                    324:     }
                    325: }
                    326: &define_command("update", \&update_file);
1.3       raeburn   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: }
1.2       foxr      361: #---------------------------------------------------------------------------------
                    362: #
                    363: #  Program entry point.  Decode the subcommand from the args array and
                    364: #  dispatch to the appropriate command processor.
                    365: #
                    366: 
1.5       raeburn   367: if ($< != 0) { # Am I root?
                    368:    print('You must be root in order to run clusteradmin.'.
                    369:          "\n");
                    370:    exit(-1);
                    371: }
                    372: 
1.2       foxr      373: my $argc = scalar(@ARGV);
                    374: if ($argc == 0) {
                    375:     print STDERR "Missing subcommand\n";
                    376:     &usage();
                    377:     exit(-1);
                    378: }
                    379: 
1.3       raeburn   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: 
1.2       foxr      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>