version 1.1, 2009/02/02 11:58:59
|
version 1.7, 2018/08/20 22:31:49
|
Line 1
|
Line 1
|
#!/usr/bin/perl |
#!/usr/bin/perl |
|
# The LearningOnline Network with CAPA |
|
# Push admin files from cluster manager to cluster's "name servers". |
|
# |
|
# $Id$ |
|
# |
|
# 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 |
=pod |
|
|
Line 8
|
Line 33
|
|
|
=head1 DESCRIPTION |
=head1 DESCRIPTION |
|
|
Performs an adiminstrative action on all hosts in the current dns_hosts.tab |
Performs an adminstrative update on (a) "DNS" hosts or domains in the current |
file. For this to work, the current host must be the cluster administrator |
dns_hosts.tab or dns_domain.tab files, or (b) update of the Certificate |
on the target systems. That is this must be a host in managers.tab |
Revocation List (CRL) file for the cluster. |
|
|
|
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. |
Furthermore, lonc must be running on this system. |
|
|
The action is specified by the 'command' parameter which may have additional arguments. |
The action is specified by the 'command' parameter which may have additional arguments. |
Line 37 on this system. 'file' is the name of t
|
Line 65 on this system. 'file' is the name of t
|
|
|
=back |
=back |
|
|
|
=head1 ASSUMPTIONS |
|
|
|
Assume that loncapa is installed in /home/httpd/lib/perl so that we can use |
|
it's modules. If this is not the case, you must modify the |
|
use lib line in the program before you can use it. |
|
|
|
|
=cut |
=cut |
|
|
use strict; |
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; |
|
|
#---------------------------------------------------------------------------------- |
#---------------------------------------------------------------------------------- |
# |
# |
Line 103 sub dispatch_command {
|
Line 144 sub dispatch_command {
|
} |
} |
} |
} |
#----------------------------------------------------------------------------------- |
#----------------------------------------------------------------------------------- |
|
|
|
# |
|
# 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); |
|
} |
|
|