Return to clusteradmin CVS log

Up to [LON-CAPA] / loncom

- Include LON-CAPA boilerplate text and $Id$ line for display of version.

#!/usr/bin/perl
# The LearningOnline Network with CAPA
# Push admin files from cluster manager to cluster's "name servers".
#
# $Id: clusteradmin,v 1.6 2018/08/20 22:27:16 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/

=pod

=head1 SYNOPSIS

 clusteradmin command [args]

=head1 DESCRIPTION

Performs an adminstrative action on DNS hosts in the current hosts.tab
file.  For this to work, the current host must be the cluster administrator
on the target systems.  That is this must be a host in managers.tab
Furthermore, lonc must be running on this system.

The action is specified by the 'command' parameter which may have additional arguments.

All communications with remote clients are made critical so that
they will eventually happen even if the host we want to talk with
is dead.


=head1 ACTIONS

=over 3

=item help 

Outputs a brief description of the actions supported and what they do.

=item update file

Update the contents of an administrative file with the contents of that file 
on this system.  'file' is the name of that file, not the path for example:

  clusteradmin update dns_hosts.tab

=back

=head1 ASSUMPTIONS

Assume that loncapa is installedin /home/httpd/lib/perl so that we can use
it's modules.  If this is not the case, you mus modify the
use lib line in the program before you can use it.


=cut

use strict;

# I'm not sure if there's a better way to establish the location of the libs:

use lib ('/home/httpd/lib/perl');

use LONCAPA::Configuration;
use File::Basename;
use Apache::lonnet;

#----------------------------------------------------------------------------------
#
#  Command dispatch handling:

#
#   Dispatch hash for the subcommands.  
#   indexed by the subcommand name, each item is 
#   a reference to the sub that handles the command:
#

my %Dispatch;

#
#  Define a subcommand:
#
# Parameters:
#    command   - subcommand name string
#    handler   - reference to the handler sub.
# Notes:
#   The handler is dispatched to with the tail of the command 
#   as an array reference parameter.  Suppose the command  is
#
#   clusteradmin update dns_hosts.tab, 
#
#   the array will have a single element:  'dns_hosts.tab'.
#
sub define_command {
    my ($command, $handler)  = @_;

    $Dispatch{$command} = $handler;
}

#
#   Dispatch to a command:
# Parameters:
#   command    - Name of the command.
#   tail       - Reference to the command tail array.
# Returns:
#   1          - Success.
#   0          - Failure
# Notes:
# 1.  The command handler is assumed to have output any error messages
#     to stderr by now.
# 2.  This function will indicate to stderr if the command isn't in the
#     dispatch hash.
#
sub dispatch_command {
    my ($command, $tail) = @_;
    my $sub;

    if (exists($Dispatch{$command})) {
	$sub = $Dispatch{$command};
	return $sub->($tail);
    } else {
	print STDERR "Unrecognized subcommand keyword $command\n";
	&usage();
	return 0;
    }
}
#-----------------------------------------------------------------------------------

#
#  Provide usage/help string:
#

sub usage {
    print STDERR "Usage:\n";
    print STDERR "   clusteradmin subcommand [args]\n";
    print STDERR "Where:\n";
    print STDERR "   subcommand describes what to actually do:\n";
    print STDERR "    help    - Prints this message (args ignored)\n";
    print STDERR "    update  - Updates an administrative file\n";
    print STDERR "              args is one of dns_hosts.tab or dns_domain.tab\n";

}

&define_command("help", \&usage);


#--------------------------------------------------------------------------------
#
#  File update subsystem:


# Given the basename of an administrative file, return the 
# full path to that file.
# Pre-requisistes:
#   Requires that LONCAPA::Configuration is in the use lib path.
# Parameters:
#   $basename   - Base name of the file to locate.
# Returns:
#   Full path to that file.
#

my $config_vars = LONCAPA::Configuration::read_conf('loncapa.conf');
my %config = %{$config_vars};
my $logfile = $config{'lonDaemons'}.'/logs/dns_updates.log';


sub construct_table_path {
    my ($basename) = @_;
    my $directory = $config{'lonTabDir'};

    return $directory . '/' . $basename;
}

#  Returns the set of hosts that are specified as DNS hosts in the hosts.tab file.
#  Those are the ones with a ^ in column one.
#
#  Returns:
#    The list of host that are DNS hosts.
#
sub get_dns_hosts()
{
    my @result;
    my $hosts_tab = &construct_table_path('hosts.tab');
    open(HOSTS, "<$hosts_tab");
    while (my $line = <HOSTS>) {
	chomp($line);
	if ($line =~ /^\^/) {
            if ($line =~ /^\^([\w.\-]+)/) {
                push(@result,$1);
            }
	}
    }
    return (@result);
}

# Actually push the new files to the systems to update.  This is done as a critical
# transaction so that the files eventually get pushed, even if the target hosts
# are down about now.
#
# Parameters: 
#   specifier     - The specifier to hand in the push transaction. This
#                   identifies the target file in the remote lond process.
#   pushfile     - Full path to the file to push.
#   hosts         - Reference to an array of hosts into which the file should be pushed.
#
# Returns:
#    1     - Success.
#    0     - Failure with appropriate output to stderr.
#
sub push_file {
    my ($specifier, $pushfile, $hosts, $fh) = @_;

    # Read in the entire file:

    my $contents;
    my $line;
    open(FILE, "<$pushfile");
    while ($line = <FILE>) {
	$contents .= $line;
    }


    # Construct the transaction for safety we encrypt the transaction
    #
    my $cmd = "encrypt:pushfile:$specifier:$contents";

    # Iterate over the hosts and run cmd as a critical 
    # operation:

    my @ids=&Apache::lonnet::current_machine_ids();
    foreach my $host (@$hosts) {
	my $loncapa_name = &Apache::lonnet::host_from_dns($host);
        next if (grep(/^\Q$loncapa_name\E$/,@ids));
	my $reply  = &Apache::lonnet::critical($cmd, $loncapa_name);
        my $msg;
        if ($reply eq 'ok') {
            $msg = "$pushfile pushed to $host ($loncapa_name): $reply\n";
        } else {
            $msg = "Reply from $host ($loncapa_name)  not 'ok' was: $reply\n";
        }
        print $fh $msg;
        print STDERR $msg;
    }
    return;   
}

#
#   Controls the push of a file to the servers that deserve to get it.
# Parameters:
#    args   - Tail of the command line (array reference).
# Returns:
#    1      - Success.
#    0      - Failure (printing messages to stderr.
#
sub update_file {
    my ($args) = @_;

    if (scalar(@$args) != 1) {
	print STDERR "Incorrect number of command arguments\n";
	&usage();
	return 0;
    } else {
	my $filename = shift(@$args);
	
	# Validate the filename:

	if (($filename eq 'dns_hosts.tab') || ($filename eq 'dns_domain.tab') || 
            ($filename eq 'hosts.tab') || ($filename eq 'domain.tab')) {
            my ($result,$fh);
            if (!-e $logfile) {
                system("touch $logfile");
                system("chown www:www $logfile");
            }
            if (open ($fh,">>$logfile")) {
                print $fh "clusteradmin update started: ".localtime(time)."\n";
	        my $pushfile   = &construct_table_path($filename);
	        my $specifier  = basename($filename, ('.tab'));
	        my @hosts         = (&get_dns_hosts());
	        $result = &push_file($specifier, $pushfile,  \@hosts, $fh);
                print $fh "ended: ".localtime(time)."\n";                 
                close($fh);
            } else {
                print STDERR "Could not open $logfile to append. Exiting.\n";
            }
            return $result;
	} else {
	    print STDERR "Only dns_hosts.tab or dns_domain.tab can be updated\n";
	    &usage();
	    return 0;
	}
    }
}
&define_command("update", \&update_file);

#
# Checks if current lonHostID is in managers.tab for the cluster, and is in the cluster.
# Parameters:
#    args   - none
# Returns:
#    1      - lonHostID is is managers.tab
#    ''     - Failure (printing messages to STDERR).
#
sub is_manager {
    my $currhost = $config{'lonHostID'};
    my $canmanage;
    if ($currhost eq '') {
        print STDERR "Could not determine LON-CAPA host ID\n";
        return;
    } elsif (!defined &Apache::lonnet::get_host_ip($currhost)) {
        print STDERR "This LON-CAPA host is not part of the cluster.\n";
    }
    my $tablename = &construct_table_path('managers.tab');
    if (!open (MANAGERS, $tablename)) {
        print STDERR "No managers.tab table. Could not verify host is a manager\n";
        return;
    }
    while(my $host = <MANAGERS>) {
        chomp($host);
        next if ($host =~ /^\#/);
        if ($host eq $currhost) {
            $canmanage = 1;
            last;
        }
    }
    close(MANAGERS);
    return $canmanage;
}
#---------------------------------------------------------------------------------
#
#  Program entry point.  Decode the subcommand from the args array and
#  dispatch to the appropriate command processor.
#

if ($< != 0) { # Am I root?
   print('You must be root in order to run clusteradmin.'.
         "\n");
   exit(-1);
}

my $argc = scalar(@ARGV);
if ($argc == 0) {
    print STDERR "Missing subcommand\n";
    &usage();
    exit(-1);
}

if (!&is_manager()) {
    print STDERR  'Script needs to be run from a server designated as a "Manager" in the LON-CAPA cluster'."\n";
    exit(-1);
}

my $subcommand = shift(@ARGV);     # argv now the tail.

if (!&dispatch_command($subcommand, \@ARGV)) {
    exit(0);
} else {
    exit(-1);
}