Annotation of loncom/clusteradmin, revision 1.2
1.1 foxr 1: #!/usr/bin/perl
2:
3: =pod
4:
5: =head1 SYNOPSIS
6:
7: clusteradmin command [args]
8:
9: =head1 DESCRIPTION
10:
11: Performs an adiminstrative action on all hosts in the current dns_hosts.tab
12: file. For this to work, the current host must be the cluster administrator
13: on the target systems. That is this must be a host in managers.tab
14: Furthermore, lonc must be running on this system.
15:
16: The action is specified by the 'command' parameter which may have additional arguments.
17:
18: All communications with remote clients are made critical so that
1.2 ! foxr 19: they will eventually happen even if the147 host we want to talk with
1.1 foxr 20: is dead.
21:
22:
23: =head1 ACTIONS
24:
25: =over 3
26:
27: =item help
28:
29: Outputs a brief description of the actions supported and what they do.
30:
31: =item update file
32:
33: Update the contents of an administrative file with the contents of that file
34: on this system. 'file' is the name of that file, not the path for example:
35:
36: clusteradmin update dns_hosts.tab
37:
38: =back
39:
1.2 ! foxr 40: =head1 ASSUMPTIONS
! 41:
! 42: Assume that loncapa is installedin /home/httpd/lib/perl so that we can use
! 43: it's modules. If this is not the case, you mus modify the
! 44: use lib line in the program before you can use it.
! 45:
1.1 foxr 46:
47: =cut
48:
49: use strict;
50:
1.2 ! foxr 51: # I'm not sure if there's a better way to establish the location of the libs:
! 52:
! 53: use lib ('/home/httpd/lib/perl');
! 54:
! 55: use LONCAPA::Configuration;
! 56: use File::Basename;
! 57: use Apache::lonnet;
1.1 foxr 58:
59: #----------------------------------------------------------------------------------
60: #
61: # Command dispatch handling:
62:
63: #
64: # Dispatch hash for the subcommands.
65: # indexed by the subcommand name, each item is
66: # a reference to the sub that handles the command:
67: #
68:
69: my %Dispatch;
70:
71: #
72: # Define a subcommand:
73: #
74: # Parameters:
75: # command - subcommand name string
76: # handler - reference to the handler sub.
77: # Notes:
78: # The handler is dispatched to with the tail of the command
79: # as an array reference parameter. Suppose the command is
80: #
81: # clusteradmin update dns_hosts.tab,
82: #
83: # the array will have a single element: 'dns_hosts.tab'.
84: #
85: sub define_command {
86: my ($command, $handler) = @_;
87:
88: $Dispatch{$command} = $handler;
89: }
90:
91: #
92: # Dispatch to a command:
93: # Parameters:
94: # command - Name of the command.
95: # tail - Reference to the command tail array.
96: # Returns:
97: # 1 - Success.
98: # 0 - Failure
99: # Notes:
100: # 1. The command handler is assumed to have output any error messages
101: # to stderr by now.
102: # 2. This function will indicate to stderr if the command isn't in the
103: # dispatch hash.
104: #
105: sub dispatch_command {
106: my ($command, $tail) = @_;
107: my $sub;
108:
109: if (exists($Dispatch{$command})) {
110: $sub = $Dispatch{$command};
111: return $sub->($tail);
112: } else {
113: print STDERR "Unrecognized subcommand keyword $command\n";
114: &usage();
115: return 0;
116: }
117: }
118: #-----------------------------------------------------------------------------------
1.2 ! foxr 119:
! 120: #
! 121: # Provide usage/help string:
! 122: #
! 123:
! 124: sub usage {
! 125: print STDERR "Usage:\n";
! 126: print STDERR " clusteradmin subcommand [args]\n";
! 127: print STDERR "Where:\n";
! 128: print STDERR " subcommand describes what to actually do:\n";
! 129: print STDERR " help - Prints this message (args ignored)\n";
! 130: print STDERR " update - Updates an administrative file\n";
! 131: print STDERR " args is one of dns_hosts.tab or dns_domain.tab\n";
! 132:
! 133: }
! 134:
! 135: &define_command("help", \&usage);
! 136:
! 137:
! 138: #--------------------------------------------------------------------------------
! 139: #
! 140: # File update subsystem:
! 141:
! 142:
! 143: # Given the basename of an administrative file, return the
! 144: # full path to that file.
! 145: # Pre-requisistes:
! 146: # Requires that LONCAPA::Configuration is in the use lib path.
! 147: # Parameters:
! 148: # $basename - Base name of the file to locate.
! 149: # Returns:
! 150: # Full path to that file.
! 151: #
! 152:
! 153: my $config_vars = LONCAPA::Configuration::read_conf('loncapa.conf');
! 154: my %config = %{$config_vars};
! 155:
! 156:
! 157: sub construct_table_path {
! 158: my ($basename) = @_;
! 159: my $directory = $config{'lonTabDir'};
! 160:
! 161: return $directory . '/' . $basename;
! 162: }
! 163:
! 164: # Returns the set of hosts that are specified as DNS hosts in the hosts.tab file.
! 165: # Those are the ones with a ^ in column one.
! 166: #
! 167: # Returns:
! 168: # The list of host that are DNS hosts.
! 169: #
! 170: sub get_dns_hosts()
! 171: {
! 172: my @result;
! 173: my $hosts_tab = &construct_table_path('hosts.tab');
! 174: open(HOSTS, "<$hosts_tab");
! 175: while (my $line = <HOSTS>) {
! 176: chomp($line);
! 177: if ($line =~ /^\^/) {
! 178: $line =~ s/^\^//; # Get rid of leading ^
! 179: $line =~ s/\s*$//; # and any trailing whitespace.
! 180: push(@result, $line);
! 181: }
! 182: }
! 183: return (@result);
! 184: }
! 185:
! 186: # Actually push the new files to the systems to update. This is done as a critical
! 187: # transaction so that the files eventually get pushed, even if the target hosts
! 188: # are down about now.
! 189: #
! 190: # Parameters:
! 191: # specifier - The specifier to hand in the push transaction. This
! 192: # identifies the target file in the remote lond process.
! 193: # pushfile - Full path to the file to push.
! 194: # hosts - Reference to an array of hosts into which the file should be pushed.
! 195: #
! 196: # Returns:
! 197: # 1 - Success.
! 198: # 0 - Failure with appropriate output to stderr.
! 199: #
! 200: sub push_file {
! 201: my ($specifier, $pushfile, $hosts) = @_;
! 202:
! 203: # Read in the entire file:
! 204:
! 205: my $contents;
! 206: my $line;
! 207: open(FILE, "<$pushfile");
! 208: while ($line = <FILE>) {
! 209: $contents .= $line;
! 210: }
! 211:
! 212:
! 213: # Construct the transaction for safety we encrypt the transaction
! 214: #
! 215: my $cmd = "encrypt:pushfile:$specifier:$contents";
! 216:
! 217: # Iterate over the hosts and run cmd as a critical
! 218: # operation:
! 219:
! 220: foreach my $host (@$hosts) {
! 221: my $loncapa_name = &Apache::lonnet::host_from_dns($host);
! 222: my $reply = &Apache::lonnet::critical($cmd, $loncapa_name);
! 223: if ($reply ne 'ok') {
! 224: print STDERR "Reply from $host ($loncapa_name) not 'ok' was: $reply\n";
! 225: }
! 226: }
! 227:
! 228: }
! 229:
! 230: #
! 231: # Controls the push of a file to the servers that deserve to get it.
! 232: # Parameters:
! 233: # args - Tail of the command line (array reference).
! 234: # Returns:
! 235: # 1 - Success.
! 236: # 0 - Failure (printing messages to stderr.
! 237: #
! 238: sub update_file {
! 239: my ($args) = @_;
! 240:
! 241: if (scalar(@$args) != 1) {
! 242: print STDERR "Incorrect number of command arguments\n";
! 243: &usage();
! 244: return 0;
! 245: } else {
! 246: my $filename = shift(@$args);
! 247:
! 248: # Validate the filename:
! 249:
! 250: if ($filename eq 'dns_hosts.tab' || $filename eq 'dns_domain.tab') {
! 251: my $pushfile = &construct_table_path($filename);
! 252: my $specifier = basename($filename, ('.tab'));
! 253: my @hosts = (&get_dns_hosts());
! 254: return &push_file($specifier, $pushfile, \@hosts);
! 255: } else {
! 256: print STDERR "Only dns_hosts.tab or dns_domain.tab can be updated\n";
! 257: &usage();
! 258: return 0;
! 259: }
! 260: }
! 261: }
! 262: &define_command("update", \&update_file);
! 263: #---------------------------------------------------------------------------------
! 264: #
! 265: # Program entry point. Decode the subcommand from the args array and
! 266: # dispatch to the appropriate command processor.
! 267: #
! 268:
! 269: my $argc = scalar(@ARGV);
! 270: if ($argc == 0) {
! 271: print STDERR "Missing subcommand\n";
! 272: &usage();
! 273: exit(-1);
! 274: }
! 275:
! 276: my $subcommand = shift(@ARGV); # argv now the tail.
! 277:
! 278: if (!&dispatch_command($subcommand, \@ARGV)) {
! 279: exit(0);
! 280: } else {
! 281: exit(-1);
! 282: }
! 283:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>