Diff for /loncom/clusteradmin between versions 1.1 and 1.2

version 1.1, 2009/02/02 11:58:59 version 1.2, 2009/03/16 09:43:00
Line 16  Furthermore, lonc must be running on thi Line 16  Furthermore, lonc must be running on thi
 The action is specified by the 'command' parameter which may have additional arguments.  The action is specified by the 'command' parameter which may have additional arguments.
   
 All communications with remote clients are made critical so that  All communications with remote clients are made critical so that
 they will eventually happen even if the host we want to talk with  they will eventually happen even if the147 host we want to talk with
 is dead.  is dead.
   
   
Line 37  on this system.  'file' is the name of t Line 37  on this system.  'file' is the name of t
   
 =back  =back
   
   =head1 ASSUMPTIONS
   
   Assume that loncapa is installedin /home/httpd/lib/perl so that we can use
   it's modules.  If this is not the case, you mus modify the
   use lib line in the program before you can use it.
   
   
 =cut  =cut
   
 use strict;  use strict;
   
   # I'm not sure if there's a better way to establish the location of the libs:
   
   use lib ('/home/httpd/lib/perl');
   
   use LONCAPA::Configuration;
   use File::Basename;
   use Apache::lonnet;
   
 #----------------------------------------------------------------------------------  #----------------------------------------------------------------------------------
 #  #
Line 103  sub dispatch_command { Line 116  sub dispatch_command {
     }      }
 }  }
 #-----------------------------------------------------------------------------------  #-----------------------------------------------------------------------------------
   
   #
   #  Provide usage/help string:
   #
   
   sub usage {
       print STDERR "Usage:\n";
       print STDERR "   clusteradmin subcommand [args]\n";
       print STDERR "Where:\n";
       print STDERR "   subcommand describes what to actually do:\n";
       print STDERR "    help    - Prints this message (args ignored)\n";
       print STDERR "    update  - Updates an administrative file\n";
       print STDERR "              args is one of dns_hosts.tab or dns_domain.tab\n";
   
   }
   
   &define_command("help", \&usage);
   
   
   #--------------------------------------------------------------------------------
   #
   #  File update subsystem:
   
   
   # Given the basename of an administrative file, return the 
   # full path to that file.
   # Pre-requisistes:
   #   Requires that LONCAPA::Configuration is in the use lib path.
   # Parameters:
   #   $basename   - Base name of the file to locate.
   # Returns:
   #   Full path to that file.
   #
   
   my $config_vars = LONCAPA::Configuration::read_conf('loncapa.conf');
   my %config = %{$config_vars};
   
   
   sub construct_table_path {
       my ($basename) = @_;
       my $directory = $config{'lonTabDir'};
   
       return $directory . '/' . $basename;
   }
   
   #  Returns the set of hosts that are specified as DNS hosts in the hosts.tab file.
   #  Those are the ones with a ^ in column one.
   #
   #  Returns:
   #    The list of host that are DNS hosts.
   #
   sub get_dns_hosts()
   {
       my @result;
       my $hosts_tab = &construct_table_path('hosts.tab');
       open(HOSTS, "<$hosts_tab");
       while (my $line = <HOSTS>) {
    chomp($line);
    if ($line =~ /^\^/) {
       $line =~ s/^\^//;           # Get rid of leading ^
       $line =~ s/\s*$//;          # and any trailing whitespace.
       push(@result, $line);
    }
       }
       return (@result);
   }
   
   # Actually push the new files to the systems to update.  This is done as a critical
   # transaction so that the files eventually get pushed, even if the target hosts
   # are down about now.
   #
   # Parameters: 
   #   specifier     - The specifier to hand in the push transaction. This
   #                   identifies the target file in the remote lond process.
   #   pushfile     - Full path to the file to push.
   #   hosts         - Reference to an array of hosts into which the file should be pushed.
   #
   # Returns:
   #    1     - Success.
   #    0     - Failure with appropriate output to stderr.
   #
   sub push_file {
       my ($specifier, $pushfile, $hosts) = @_;
   
       # Read in the entire file:
   
       my $contents;
       my $line;
       open(FILE, "<$pushfile");
       while ($line = <FILE>) {
    $contents .= $line;
       }
   
   
       # Construct the transaction for safety we encrypt the transaction
       #
       my $cmd = "encrypt:pushfile:$specifier:$contents";
   
       # Iterate over the hosts and run cmd as a critical 
       # operation:
   
       foreach my $host (@$hosts) {
    my $loncapa_name = &Apache::lonnet::host_from_dns($host);
    my $reply  = &Apache::lonnet::critical($cmd, $loncapa_name);
    if ($reply ne 'ok') {
       print STDERR "Reply from $host ($loncapa_name)  not 'ok' was: $reply\n";
    }
       }
       
   }
   
   #
   #   Controls the push of a file to the servers that deserve to get it.
   # Parameters:
   #    args   - Tail of the command line (array reference).
   # Returns:
   #    1      - Success.
   #    0      - Failure (printing messages to stderr.
   #
   sub update_file {
       my ($args) = @_;
   
       if (scalar(@$args) != 1) {
    print STDERR "Incorrect number of command arguments\n";
    &usage();
    return 0;
       } else {
    my $filename = shift(@$args);
   
    # Validate the filename:
   
    if ($filename eq 'dns_hosts.tab' || $filename eq 'dns_domain.tab') {
       my $pushfile   = &construct_table_path($filename);
       my $specifier  = basename($filename, ('.tab'));
       my @hosts         = (&get_dns_hosts());
       return &push_file($specifier, $pushfile,  \@hosts);
    } else {
       print STDERR "Only dns_hosts.tab or dns_domain.tab can be updated\n";
       &usage();
       return 0;
    }
       }
   }
   &define_command("update", \&update_file);
   #---------------------------------------------------------------------------------
   #
   #  Program entry point.  Decode the subcommand from the args array and
   #  dispatch to the appropriate command processor.
   #
   
   my $argc = scalar(@ARGV);
   if ($argc == 0) {
       print STDERR "Missing subcommand\n";
       &usage();
       exit(-1);
   }
   
   my $subcommand = shift(@ARGV);     # argv now the tail.
   
   if (!&dispatch_command($subcommand, \@ARGV)) {
       exit(0);
   } else {
       exit(-1);
   }
   

Removed from v.1.1  
changed lines
  Added in v.1.2


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