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>