Annotation of loncom/clusteradmin, revision 1.5
1.1 foxr 1: #!/usr/bin/perl
2:
3: =pod
4:
5: =head1 SYNOPSIS
6:
7: clusteradmin command [args]
8:
9: =head1 DESCRIPTION
10:
1.4 raeburn 11: Performs an adminstrative action on DNS hosts in the current hosts.tab
1.1 foxr 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.4 raeburn 19: they will eventually happen even if the 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};
1.5 ! raeburn 155: my $logfile = $config{'lonDaemons'}.'/logs/dns_updates.log';
1.2 foxr 156:
157:
158: sub construct_table_path {
159: my ($basename) = @_;
160: my $directory = $config{'lonTabDir'};
161:
162: return $directory . '/' . $basename;
163: }
164:
165: # Returns the set of hosts that are specified as DNS hosts in the hosts.tab file.
166: # Those are the ones with a ^ in column one.
167: #
168: # Returns:
169: # The list of host that are DNS hosts.
170: #
171: sub get_dns_hosts()
172: {
173: my @result;
174: my $hosts_tab = &construct_table_path('hosts.tab');
175: open(HOSTS, "<$hosts_tab");
176: while (my $line = <HOSTS>) {
177: chomp($line);
178: if ($line =~ /^\^/) {
1.5 ! raeburn 179: if ($line =~ /^\^([\w.\-]+)/) {
! 180: push(@result,$1);
! 181: }
1.2 foxr 182: }
183: }
184: return (@result);
185: }
186:
187: # Actually push the new files to the systems to update. This is done as a critical
188: # transaction so that the files eventually get pushed, even if the target hosts
189: # are down about now.
190: #
191: # Parameters:
192: # specifier - The specifier to hand in the push transaction. This
193: # identifies the target file in the remote lond process.
194: # pushfile - Full path to the file to push.
195: # hosts - Reference to an array of hosts into which the file should be pushed.
196: #
197: # Returns:
198: # 1 - Success.
199: # 0 - Failure with appropriate output to stderr.
200: #
201: sub push_file {
1.5 ! raeburn 202: my ($specifier, $pushfile, $hosts, $fh) = @_;
1.2 foxr 203:
204: # Read in the entire file:
205:
206: my $contents;
207: my $line;
208: open(FILE, "<$pushfile");
209: while ($line = <FILE>) {
210: $contents .= $line;
211: }
212:
213:
214: # Construct the transaction for safety we encrypt the transaction
215: #
216: my $cmd = "encrypt:pushfile:$specifier:$contents";
217:
218: # Iterate over the hosts and run cmd as a critical
219: # operation:
220:
1.5 ! raeburn 221: my @ids=&Apache::lonnet::current_machine_ids();
1.2 foxr 222: foreach my $host (@$hosts) {
223: my $loncapa_name = &Apache::lonnet::host_from_dns($host);
1.5 ! raeburn 224: next if (grep(/^\Q$loncapa_name\E$/,@ids));
1.2 foxr 225: my $reply = &Apache::lonnet::critical($cmd, $loncapa_name);
1.5 ! raeburn 226: my $msg;
! 227: if ($reply eq 'ok') {
! 228: $msg = "$pushfile pushed to $host ($loncapa_name): $reply\n";
! 229: } else {
! 230: $msg = "Reply from $host ($loncapa_name) not 'ok' was: $reply\n";
! 231: }
! 232: print $fh $msg;
! 233: print STDERR $msg;
1.2 foxr 234: }
1.5 ! raeburn 235: return;
1.2 foxr 236: }
237:
238: #
239: # Controls the push of a file to the servers that deserve to get it.
240: # Parameters:
241: # args - Tail of the command line (array reference).
242: # Returns:
243: # 1 - Success.
244: # 0 - Failure (printing messages to stderr.
245: #
246: sub update_file {
247: my ($args) = @_;
248:
249: if (scalar(@$args) != 1) {
250: print STDERR "Incorrect number of command arguments\n";
251: &usage();
252: return 0;
253: } else {
254: my $filename = shift(@$args);
255:
256: # Validate the filename:
257:
1.5 ! raeburn 258: if (($filename eq 'dns_hosts.tab') || ($filename eq 'dns_domain.tab') ||
! 259: ($filename eq 'hosts.tab') || ($filename eq 'domain.tab')) {
! 260: my ($result,$fh);
! 261: if (!-e $logfile) {
! 262: system("touch $logfile");
! 263: system("chown www:www $logfile");
! 264: }
! 265: if (open ($fh,">>$logfile")) {
! 266: print $fh "clusteradmin update started: ".localtime(time)."\n";
! 267: my $pushfile = &construct_table_path($filename);
! 268: my $specifier = basename($filename, ('.tab'));
! 269: my @hosts = (&get_dns_hosts());
! 270: $result = &push_file($specifier, $pushfile, \@hosts, $fh);
! 271: print $fh "ended: ".localtime(time)."\n";
! 272: close($fh);
! 273: } else {
! 274: print STDERR "Could not open $logfile to append. Exiting.\n";
! 275: }
! 276: return $result;
1.2 foxr 277: } else {
278: print STDERR "Only dns_hosts.tab or dns_domain.tab can be updated\n";
279: &usage();
280: return 0;
281: }
282: }
283: }
284: &define_command("update", \&update_file);
1.3 raeburn 285:
286: #
287: # Checks if current lonHostID is in managers.tab for the cluster, and is in the cluster.
288: # Parameters:
289: # args - none
290: # Returns:
291: # 1 - lonHostID is is managers.tab
292: # '' - Failure (printing messages to STDERR).
293: #
294: sub is_manager {
295: my $currhost = $config{'lonHostID'};
296: my $canmanage;
297: if ($currhost eq '') {
298: print STDERR "Could not determine LON-CAPA host ID\n";
299: return;
300: } elsif (!defined &Apache::lonnet::get_host_ip($currhost)) {
301: print STDERR "This LON-CAPA host is not part of the cluster.\n";
302: }
303: my $tablename = &construct_table_path('managers.tab');
304: if (!open (MANAGERS, $tablename)) {
305: print STDERR "No managers.tab table. Could not verify host is a manager\n";
306: return;
307: }
308: while(my $host = <MANAGERS>) {
309: chomp($host);
310: next if ($host =~ /^\#/);
311: if ($host eq $currhost) {
312: $canmanage = 1;
313: last;
314: }
315: }
316: close(MANAGERS);
317: return $canmanage;
318: }
1.2 foxr 319: #---------------------------------------------------------------------------------
320: #
321: # Program entry point. Decode the subcommand from the args array and
322: # dispatch to the appropriate command processor.
323: #
324:
1.5 ! raeburn 325: if ($< != 0) { # Am I root?
! 326: print('You must be root in order to run clusteradmin.'.
! 327: "\n");
! 328: exit(-1);
! 329: }
! 330:
1.2 foxr 331: my $argc = scalar(@ARGV);
332: if ($argc == 0) {
333: print STDERR "Missing subcommand\n";
334: &usage();
335: exit(-1);
336: }
337:
1.3 raeburn 338: if (!&is_manager()) {
339: print STDERR 'Script needs to be run from a server designated as a "Manager" in the LON-CAPA cluster'."\n";
340: exit(-1);
341: }
342:
1.2 foxr 343: my $subcommand = shift(@ARGV); # argv now the tail.
344:
345: if (!&dispatch_command($subcommand, \@ARGV)) {
346: exit(0);
347: } else {
348: exit(-1);
349: }
350:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>