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>