Annotation of loncom/clusteradmin, revision 1.6

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

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