Annotation of loncom/clusteradmin, revision 1.8
1.1 foxr 1: #!/usr/bin/perl
1.6 raeburn 2: # The LearningOnline Network with CAPA
3: # Push admin files from cluster manager to cluster's "name servers".
4: #
1.8 ! raeburn 5: # $Id: clusteradmin,v 1.7 2018/08/20 22:31:49 raeburn Exp $
1.6 raeburn 6: #
7: # Copyright Michigan State University Board of Trustees
8: #
9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
1.1 foxr 27:
28: =pod
29:
30: =head1 SYNOPSIS
31:
32: clusteradmin command [args]
33:
34: =head1 DESCRIPTION
35:
1.7 raeburn 36: Performs an adminstrative update on (a) "DNS" hosts or domains in the current
37: dns_hosts.tab or dns_domain.tab files, or (b) update of the Certificate
38: Revocation List (CRL) file for the cluster.
39:
40: For this to work, the current host must be the cluster administrator
41: on the target systems. That is this must be a host in managers.tab.
1.1 foxr 42: Furthermore, lonc must be running on this system.
43:
44: The action is specified by the 'command' parameter which may have additional arguments.
45:
46: All communications with remote clients are made critical so that
1.4 raeburn 47: they will eventually happen even if the host we want to talk with
1.1 foxr 48: is dead.
49:
50:
51: =head1 ACTIONS
52:
53: =over 3
54:
55: =item help
56:
57: Outputs a brief description of the actions supported and what they do.
58:
59: =item update file
60:
61: Update the contents of an administrative file with the contents of that file
62: on this system. 'file' is the name of that file, not the path for example:
63:
64: clusteradmin update dns_hosts.tab
65:
66: =back
67:
1.2 foxr 68: =head1 ASSUMPTIONS
69:
1.7 raeburn 70: Assume that loncapa is installed in /home/httpd/lib/perl so that we can use
71: it's modules. If this is not the case, you must modify the
1.2 foxr 72: use lib line in the program before you can use it.
73:
1.1 foxr 74:
75: =cut
76:
77: use strict;
78:
1.2 foxr 79: # I'm not sure if there's a better way to establish the location of the libs:
80:
81: use lib ('/home/httpd/lib/perl');
82:
83: use LONCAPA::Configuration;
84: use File::Basename;
85: use Apache::lonnet;
1.1 foxr 86:
87: #----------------------------------------------------------------------------------
88: #
89: # Command dispatch handling:
90:
91: #
92: # Dispatch hash for the subcommands.
93: # indexed by the subcommand name, each item is
94: # a reference to the sub that handles the command:
95: #
96:
97: my %Dispatch;
98:
99: #
100: # Define a subcommand:
101: #
102: # Parameters:
103: # command - subcommand name string
104: # handler - reference to the handler sub.
105: # Notes:
106: # The handler is dispatched to with the tail of the command
107: # as an array reference parameter. Suppose the command is
108: #
109: # clusteradmin update dns_hosts.tab,
110: #
111: # the array will have a single element: 'dns_hosts.tab'.
112: #
113: sub define_command {
114: my ($command, $handler) = @_;
115:
116: $Dispatch{$command} = $handler;
117: }
118:
119: #
120: # Dispatch to a command:
121: # Parameters:
122: # command - Name of the command.
123: # tail - Reference to the command tail array.
124: # Returns:
125: # 1 - Success.
126: # 0 - Failure
127: # Notes:
128: # 1. The command handler is assumed to have output any error messages
129: # to stderr by now.
130: # 2. This function will indicate to stderr if the command isn't in the
131: # dispatch hash.
132: #
133: sub dispatch_command {
134: my ($command, $tail) = @_;
135: my $sub;
136:
137: if (exists($Dispatch{$command})) {
138: $sub = $Dispatch{$command};
139: return $sub->($tail);
140: } else {
141: print STDERR "Unrecognized subcommand keyword $command\n";
142: &usage();
143: return 0;
144: }
145: }
146: #-----------------------------------------------------------------------------------
1.2 foxr 147:
148: #
149: # Provide usage/help string:
150: #
151:
152: sub usage {
153: print STDERR "Usage:\n";
154: print STDERR " clusteradmin subcommand [args]\n";
155: print STDERR "Where:\n";
156: print STDERR " subcommand describes what to actually do:\n";
157: print STDERR " help - Prints this message (args ignored)\n";
158: print STDERR " update - Updates an administrative file\n";
1.8 ! raeburn 159: print STDERR " args is one of dns_hosts.tab, dns_domain.tab\n";
! 160: print STDERR " or loncapaCAcrl.pem\n";
1.2 foxr 161:
162: }
163:
164: &define_command("help", \&usage);
165:
166:
167: #--------------------------------------------------------------------------------
168: #
169: # File update subsystem:
170:
171:
172: # Given the basename of an administrative file, return the
173: # full path to that file.
174: # Pre-requisistes:
175: # Requires that LONCAPA::Configuration is in the use lib path.
176: # Parameters:
177: # $basename - Base name of the file to locate.
178: # Returns:
179: # Full path to that file.
180: #
181:
182: my $config_vars = LONCAPA::Configuration::read_conf('loncapa.conf');
183: my %config = %{$config_vars};
1.5 raeburn 184: my $logfile = $config{'lonDaemons'}.'/logs/dns_updates.log';
1.2 foxr 185:
186:
187: sub construct_table_path {
188: my ($basename) = @_;
1.8 ! raeburn 189: my $directory;
! 190: if ($basename eq 'managers.tab') {
! 191: $directory = $config{'lonTabDir'};
! 192: } elsif ($basename eq 'loncapaCAcrl.pem') {
! 193: $directory = $config{'lonCertificateDirectory'};
! 194: } elsif ($basename =~ /^(dns_|)(hosts|domain)\.tab$/) {
! 195: $directory = $config{'lonTabDir'};
! 196: }
1.2 foxr 197: return $directory . '/' . $basename;
198: }
199:
200: # Returns the set of hosts that are specified as DNS hosts in the hosts.tab file.
201: # Those are the ones with a ^ in column one.
202: #
203: # Returns:
204: # The list of host that are DNS hosts.
205: #
206: sub get_dns_hosts()
207: {
208: my @result;
209: my $hosts_tab = &construct_table_path('hosts.tab');
1.8 ! raeburn 210: if (open(HOSTS,'<',$hosts_tab)) {
! 211: while (my $line = <HOSTS>) {
! 212: chomp($line);
! 213: if ($line =~ /^\^/) {
! 214: if ($line =~ /^\^([\w.\-]+)/) {
! 215: push(@result,$1);
! 216: }
! 217: }
! 218: }
1.2 foxr 219: }
220: return (@result);
221: }
222:
223: # Actually push the new files to the systems to update. This is done as a critical
224: # transaction so that the files eventually get pushed, even if the target hosts
225: # are down about now.
226: #
227: # Parameters:
228: # specifier - The specifier to hand in the push transaction. This
229: # identifies the target file in the remote lond process.
230: # pushfile - Full path to the file to push.
231: # hosts - Reference to an array of hosts into which the file should be pushed.
232: #
233: # Returns:
234: # 1 - Success.
235: # 0 - Failure with appropriate output to stderr.
236: #
237: sub push_file {
1.5 raeburn 238: my ($specifier, $pushfile, $hosts, $fh) = @_;
1.2 foxr 239:
240: # Read in the entire file:
241:
242: my $contents;
243: my $line;
1.8 ! raeburn 244: open(FILE,'<',$pushfile);
1.2 foxr 245: while ($line = <FILE>) {
246: $contents .= $line;
247: }
248:
249:
250: # Construct the transaction for safety we encrypt the transaction
251: #
252: my $cmd = "encrypt:pushfile:$specifier:$contents";
253:
254: # Iterate over the hosts and run cmd as a critical
255: # operation:
256:
1.5 raeburn 257: my @ids=&Apache::lonnet::current_machine_ids();
1.2 foxr 258: foreach my $host (@$hosts) {
259: my $loncapa_name = &Apache::lonnet::host_from_dns($host);
1.5 raeburn 260: next if (grep(/^\Q$loncapa_name\E$/,@ids));
1.2 foxr 261: my $reply = &Apache::lonnet::critical($cmd, $loncapa_name);
1.5 raeburn 262: my $msg;
263: if ($reply eq 'ok') {
264: $msg = "$pushfile pushed to $host ($loncapa_name): $reply\n";
265: } else {
266: $msg = "Reply from $host ($loncapa_name) not 'ok' was: $reply\n";
267: }
268: print $fh $msg;
269: print STDERR $msg;
1.2 foxr 270: }
1.5 raeburn 271: return;
1.2 foxr 272: }
273:
274: #
275: # Controls the push of a file to the servers that deserve to get it.
276: # Parameters:
277: # args - Tail of the command line (array reference).
278: # Returns:
279: # 1 - Success.
280: # 0 - Failure (printing messages to stderr.
281: #
282: sub update_file {
283: my ($args) = @_;
284:
285: if (scalar(@$args) != 1) {
286: print STDERR "Incorrect number of command arguments\n";
287: &usage();
288: return 0;
289: } else {
290: my $filename = shift(@$args);
291:
292: # Validate the filename:
293:
1.5 raeburn 294: if (($filename eq 'dns_hosts.tab') || ($filename eq 'dns_domain.tab') ||
1.8 ! raeburn 295: ($filename eq 'hosts.tab') || ($filename eq 'domain.tab') ||
! 296: ($filename eq 'loncapaCAcrl.pem')) {
1.5 raeburn 297: my ($result,$fh);
298: if (!-e $logfile) {
299: system("touch $logfile");
300: system("chown www:www $logfile");
301: }
1.8 ! raeburn 302: if (open ($fh,'>>',$logfile)) {
1.5 raeburn 303: print $fh "clusteradmin update started: ".localtime(time)."\n";
304: my $pushfile = &construct_table_path($filename);
1.8 ! raeburn 305: my @hosts = (&get_dns_hosts());
! 306: my $ext = 'tab';
! 307: if ($filename eq 'loncapaCAcrl.pem') {
! 308: $ext = 'pem';
! 309: }
! 310: my $specifier = basename($filename, (".$ext"));
1.5 raeburn 311: my @hosts = (&get_dns_hosts());
312: $result = &push_file($specifier, $pushfile, \@hosts, $fh);
313: print $fh "ended: ".localtime(time)."\n";
314: close($fh);
315: } else {
316: print STDERR "Could not open $logfile to append. Exiting.\n";
317: }
318: return $result;
1.2 foxr 319: } else {
1.8 ! raeburn 320: print STDERR "Only dns_hosts.tab, dns_domain.tab or loncapaCAcrl.pem can be updated\n";
1.2 foxr 321: &usage();
322: return 0;
323: }
324: }
325: }
326: &define_command("update", \&update_file);
1.3 raeburn 327:
328: #
329: # Checks if current lonHostID is in managers.tab for the cluster, and is in the cluster.
330: # Parameters:
331: # args - none
332: # Returns:
333: # 1 - lonHostID is is managers.tab
334: # '' - Failure (printing messages to STDERR).
335: #
336: sub is_manager {
337: my $currhost = $config{'lonHostID'};
338: my $canmanage;
339: if ($currhost eq '') {
340: print STDERR "Could not determine LON-CAPA host ID\n";
341: return;
342: } elsif (!defined &Apache::lonnet::get_host_ip($currhost)) {
343: print STDERR "This LON-CAPA host is not part of the cluster.\n";
344: }
345: my $tablename = &construct_table_path('managers.tab');
346: if (!open (MANAGERS, $tablename)) {
347: print STDERR "No managers.tab table. Could not verify host is a manager\n";
348: return;
349: }
350: while(my $host = <MANAGERS>) {
351: chomp($host);
352: next if ($host =~ /^\#/);
353: if ($host eq $currhost) {
354: $canmanage = 1;
355: last;
356: }
357: }
358: close(MANAGERS);
359: return $canmanage;
360: }
1.2 foxr 361: #---------------------------------------------------------------------------------
362: #
363: # Program entry point. Decode the subcommand from the args array and
364: # dispatch to the appropriate command processor.
365: #
366:
1.5 raeburn 367: if ($< != 0) { # Am I root?
368: print('You must be root in order to run clusteradmin.'.
369: "\n");
370: exit(-1);
371: }
372:
1.2 foxr 373: my $argc = scalar(@ARGV);
374: if ($argc == 0) {
375: print STDERR "Missing subcommand\n";
376: &usage();
377: exit(-1);
378: }
379:
1.3 raeburn 380: if (!&is_manager()) {
381: print STDERR 'Script needs to be run from a server designated as a "Manager" in the LON-CAPA cluster'."\n";
382: exit(-1);
383: }
384:
1.2 foxr 385: my $subcommand = shift(@ARGV); # argv now the tail.
386:
387: if (!&dispatch_command($subcommand, \@ARGV)) {
388: exit(0);
389: } else {
390: exit(-1);
391: }
392:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>