Annotation of loncom/clusteradmin, revision 1.4

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};
                    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);
1.4     ! raeburn   222:         next if ($loncapa_name eq $config{'lonHostID'});
1.2       foxr      223: 	my $reply  = &Apache::lonnet::critical($cmd, $loncapa_name);
                    224: 	if ($reply ne 'ok') {
                    225: 	    print STDERR "Reply from $host ($loncapa_name)  not 'ok' was: $reply\n";
                    226: 	}
                    227:     }
                    228:     
                    229: }
                    230: 
                    231: #
                    232: #   Controls the push of a file to the servers that deserve to get it.
                    233: # Parameters:
                    234: #    args   - Tail of the command line (array reference).
                    235: # Returns:
                    236: #    1      - Success.
                    237: #    0      - Failure (printing messages to stderr.
                    238: #
                    239: sub update_file {
                    240:     my ($args) = @_;
                    241: 
                    242:     if (scalar(@$args) != 1) {
                    243: 	print STDERR "Incorrect number of command arguments\n";
                    244: 	&usage();
                    245: 	return 0;
                    246:     } else {
                    247: 	my $filename = shift(@$args);
                    248: 	
                    249: 	# Validate the filename:
                    250: 
                    251: 	if ($filename eq 'dns_hosts.tab' || $filename eq 'dns_domain.tab') {
                    252: 	    my $pushfile   = &construct_table_path($filename);
                    253: 	    my $specifier  = basename($filename, ('.tab'));
                    254: 	    my @hosts         = (&get_dns_hosts());
                    255: 	    return &push_file($specifier, $pushfile,  \@hosts);
                    256: 	} else {
                    257: 	    print STDERR "Only dns_hosts.tab or dns_domain.tab can be updated\n";
                    258: 	    &usage();
                    259: 	    return 0;
                    260: 	}
                    261:     }
                    262: }
                    263: &define_command("update", \&update_file);
1.3       raeburn   264: 
                    265: #
                    266: # Checks if current lonHostID is in managers.tab for the cluster, and is in the cluster.
                    267: # Parameters:
                    268: #    args   - none
                    269: # Returns:
                    270: #    1      - lonHostID is is managers.tab
                    271: #    ''     - Failure (printing messages to STDERR).
                    272: #
                    273: sub is_manager {
                    274:     my $currhost = $config{'lonHostID'};
                    275:     my $canmanage;
                    276:     if ($currhost eq '') {
                    277:         print STDERR "Could not determine LON-CAPA host ID\n";
                    278:         return;
                    279:     } elsif (!defined &Apache::lonnet::get_host_ip($currhost)) {
                    280:         print STDERR "This LON-CAPA host is not part of the cluster.\n";
                    281:     }
                    282:     my $tablename = &construct_table_path('managers.tab');
                    283:     if (!open (MANAGERS, $tablename)) {
                    284:         print STDERR "No managers.tab table. Could not verify host is a manager\n";
                    285:         return;
                    286:     }
                    287:     while(my $host = <MANAGERS>) {
                    288:         chomp($host);
                    289:         next if ($host =~ /^\#/);
                    290:         if ($host eq $currhost) {
                    291:             $canmanage = 1;
                    292:             last;
                    293:         }
                    294:     }
                    295:     close(MANAGERS);
                    296:     return $canmanage;
                    297: }
1.2       foxr      298: #---------------------------------------------------------------------------------
                    299: #
                    300: #  Program entry point.  Decode the subcommand from the args array and
                    301: #  dispatch to the appropriate command processor.
                    302: #
                    303: 
                    304: my $argc = scalar(@ARGV);
                    305: if ($argc == 0) {
                    306:     print STDERR "Missing subcommand\n";
                    307:     &usage();
                    308:     exit(-1);
                    309: }
                    310: 
1.3       raeburn   311: if (!&is_manager()) {
                    312:     print STDERR  'Script needs to be run from a server designated as a "Manager" in the LON-CAPA cluster'."\n";
                    313:     exit(-1);
                    314: }
                    315: 
1.2       foxr      316: my $subcommand = shift(@ARGV);     # argv now the tail.
                    317: 
                    318: if (!&dispatch_command($subcommand, \@ARGV)) {
                    319:     exit(0);
                    320: } else {
                    321:     exit(-1);
                    322: }
                    323: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>