version 1.1, 2009/02/02 11:58:59
|
version 1.2, 2009/03/16 09:43:00
|
Line 16 Furthermore, lonc must be running on thi
|
Line 16 Furthermore, lonc must be running on thi
|
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. |
|
|
All communications with remote clients are made critical so that |
All communications with remote clients are made critical so that |
they will eventually happen even if the host we want to talk with |
they will eventually happen even if the147 host we want to talk with |
is dead. |
is dead. |
|
|
|
|
Line 37 on this system. 'file' is the name of t
|
Line 37 on this system. 'file' is the name of t
|
|
|
=back |
=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 |
=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 116 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}; |
|
|
|
|
|
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 =~ /^\^/) { |
|
$line =~ s/^\^//; # Get rid of leading ^ |
|
$line =~ s/\s*$//; # and any trailing whitespace. |
|
push(@result, $line); |
|
} |
|
} |
|
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) = @_; |
|
|
|
# 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: |
|
|
|
foreach my $host (@$hosts) { |
|
my $loncapa_name = &Apache::lonnet::host_from_dns($host); |
|
my $reply = &Apache::lonnet::critical($cmd, $loncapa_name); |
|
if ($reply ne 'ok') { |
|
print STDERR "Reply from $host ($loncapa_name) not 'ok' was: $reply\n"; |
|
} |
|
} |
|
|
|
} |
|
|
|
# |
|
# 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') { |
|
my $pushfile = &construct_table_path($filename); |
|
my $specifier = basename($filename, ('.tab')); |
|
my @hosts = (&get_dns_hosts()); |
|
return &push_file($specifier, $pushfile, \@hosts); |
|
} else { |
|
print STDERR "Only dns_hosts.tab or dns_domain.tab can be updated\n"; |
|
&usage(); |
|
return 0; |
|
} |
|
} |
|
} |
|
&define_command("update", \&update_file); |
|
#--------------------------------------------------------------------------------- |
|
# |
|
# Program entry point. Decode the subcommand from the args array and |
|
# dispatch to the appropriate command processor. |
|
# |
|
|
|
my $argc = scalar(@ARGV); |
|
if ($argc == 0) { |
|
print STDERR "Missing subcommand\n"; |
|
&usage(); |
|
exit(-1); |
|
} |
|
|
|
my $subcommand = shift(@ARGV); # argv now the tail. |
|
|
|
if (!&dispatch_command($subcommand, \@ARGV)) { |
|
exit(0); |
|
} else { |
|
exit(-1); |
|
} |
|
|