Diff for /loncom/lond between versions 1.151 and 1.160

version 1.151, 2003/10/03 15:11:03 version 1.160, 2003/11/01 16:32:32
Line 26 Line 26
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 # 5/26/99,6/4,6/10,6/11,6/14,6/15,6/26,6/28,6/30,  
 # 7/8,7/9,7/10,7/12,7/17,7/19,9/21,  
 # 10/7,10/8,10/9,10/11,10/13,10/15,11/4,11/16,  
 # 12/7,12/15,01/06,01/11,01/12,01/14,2/8,  
 # 03/07,05/31 Gerd Kortemeyer  
 # 06/29,06/30,07/14,07/15,07/17,07/20,07/25,09/18 Gerd Kortemeyer  
 # 12/05,12/13,12/29 Gerd Kortemeyer  
 # YEAR=2001  
 # 02/12 Gerd Kortemeyer  
 # 03/24 Gerd Kortemeyer  
 # 05/11,05/28,08/30 Gerd Kortemeyer  
 # 11/26,11/27 Gerd Kortemeyer  
 # 12/22 Gerd Kortemeyer  
 # YEAR=2002  
 # 01/20/02,02/05 Gerd Kortemeyer  
 # 02/05 Guy Albertelli  
 # 02/12 Gerd Kortemeyer  
 # 02/19 Matthew Hall  
 # 02/25 Gerd Kortemeyer  
 # 01/xx/2003 Ron Fox.. Remove preforking.  This makes the general daemon  
 #      logic simpler (and there were problems maintaining the preforked  
 #      population).  Since the time averaged connection rate is close to zero  
 #      because lonc's purpose is to maintain near continuous connnections,  
 #      preforking is not really needed.  
 # 08/xx/2003 Ron Fox:  Add management requests.  Management requests  
 #      will be validated via a call to ValidateManager. At present, this  
 #      is done by simple host verification.  In the future we can modify  
 #      this function to do a certificate check.  
 #      Management functions supported include:  
 #       - pushing /home/httpd/lonTabs/hosts.tab  
 #       - pushing /home/httpd/lonTabs/domain.tab  
 # 09/08/2003 Ron Fox:  Told lond to take care of change logging so we  
 #      don't have to remember it:  
 # $Log$  
 # Revision 1.151  2003/10/03 15:11:03  albertel  
 # - if we fail to fetch an update to the file, don't blow away the old one  
 #   (this was the BUG that blew away that one default.sequence that Matthew  
 #    ended up restoring from data.)  
 #  
 # Revision 1.150  2003/09/30 10:16:06  foxr  
 # Added invocation of apachereload in ReloadApache sub.  
 # This completes the addtion of the reinit functionality.  
 #  
 # Revision 1.149  2003/09/30 09:44:13  foxr  
 # Tested UpdateHosts ability to  
 # - Remove live children for hosts that are no longer in the hosts.tab  
 # - Remove live children for hosts whose IPs have changed in the hosts.tab  
 #  
 # Revision 1.148  2003/09/29 10:09:18  foxr  
 # Put in logic to reinit lond itself (except for apache reload).  I don't believe  
 # this logic works correctly yet, however lond still does everything it used to doso I'll do the commit anyway.  
 #  
 # Revision 1.147  2003/09/23 11:23:31  foxr  
 # Comlplete implementation of reinit functionality.  Must still implement  
 # the actual initialization functionality, but the process can now  
 # receive the request and either invoke the appropriate internal function or  
 # signal the correct lonc.  
 #  
 # Revision 1.146  2003/09/16 10:28:14  foxr  
 # ReinitProcess - decode the process selector and produce the associated pid  
 # filename.  Note: While it is possible to test that valid process selectors are  
 # handled properly I am not able to test that invalid process selectors produce  
 # the appropriate error as lonManage also blocks the use of invalid process selectors.  
 #  
 # Revision 1.145  2003/09/16 10:13:20  foxr  
 # Added ReinitProcess function to oversee the parsing and processing of the  
 # reinit:<process> client request.  
 #  
 # Revision 1.144  2003/09/16 09:47:01  foxr  
 # Added skeletal support for SIGUSR2 (update hosts.tab)  
 #  
 # Revision 1.143  2003/09/15 10:03:52  foxr  
 # Completed and tested code for pushfile.  
 #  
 # Revision 1.142  2003/09/09 20:47:46  www  
 # Permanently store chatroom entries in chatroom.log  
 #  
 # Revision 1.141  2003/09/08 10:32:07  foxr  
 # Added PushFile sub This sub oversees the push of a new configuration table file  
 # Currently supported files are:  
 # - hosts.tab   (transaction pushfile:hosts:contents)  
 # - domain.tab  (transaction pushfile:domain:contents)  
 #  
   
   
 use strict;  use strict;
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
Line 148  my $thisserver; Line 64  my $thisserver;
 my %hostid;  my %hostid;
 my %hostdom;  my %hostdom;
 my %hostip;  my %hostip;
   my %managers; # If defined $managers{hostname} is a manager
 my %perlvar; # Will have the apache conf defined perl vars.  my %perlvar; # Will have the apache conf defined perl vars.
   
 #  #
Line 178  my @adderrors    = ("ok", Line 95  my @adderrors    = ("ok",
     "lcuseradd Incorrect number of stdinput lines, must be 3",      "lcuseradd Incorrect number of stdinput lines, must be 3",
     "lcuseradd Too many other simultaneous pwd changes in progress",      "lcuseradd Too many other simultaneous pwd changes in progress",
     "lcuseradd User does not exist",      "lcuseradd User does not exist",
     "lcuseradd Unabel to mak ewww member of users's group",      "lcuseradd Unable to make www member of users's group",
     "lcuseradd Unable to su to root",      "lcuseradd Unable to su to root",
     "lcuseradd Unable to set password",      "lcuseradd Unable to set password",
     "lcuseradd Usrname has invbalid charcters",      "lcuseradd Usrname has invalid characters",
     "lcuseradd Password has an invalid character",      "lcuseradd Password has an invalid character",
     "lcuseradd User already exists",      "lcuseradd User already exists",
     "lcuseradd Could not add user.",      "lcuseradd Could not add user.",
Line 204  sub GetCertificate { Line 121  sub GetCertificate {
   
     return $clientip;      return $clientip;
 }  }
   #
   #   ReadManagerTable: Reads in the current manager table. For now this is
   #                     done on each manager authentication because:
   #                     - These authentications are not frequent
   #                     - This allows dynamic changes to the manager table
   #                       without the need to signal to the lond.
   #
   
   sub ReadManagerTable {
   
       #   Clean out the old table first..
   
       foreach my $key (keys %managers) {
    delete $managers{$key};
       }
   
       my $tablename = $perlvar{'lonTabDir'}."/managers.tab";
       if (!open (MANAGERS, $tablename)) {
    logthis('<font color="red">No manager table.  Nobody can manage!!</font>');
    return;
       }
       while(my $host = <MANAGERS>) {
    chomp($host);
    if (!defined $hostip{$host}) {
       logthis('<font color="red"> manager '.$host.
       " not in hosts.tab, rejected as manager</font>");
    } else {
       $managers{$host} = $hostip{$host}; # Whatever for now.
    }
       }
   }
   
 #  #
 #  ValidManager: Determines if a given certificate represents a valid manager.  #  ValidManager: Determines if a given certificate represents a valid manager.
Line 216  sub GetCertificate { Line 163  sub GetCertificate {
 sub ValidManager {  sub ValidManager {
     my $certificate = shift;       my $certificate = shift; 
   
     my $hostentry   = $hostid{$certificate};      ReadManagerTable;
     if ($hostentry ne undef) {  
  &logthis('<font color="yellow">Authenticating manager'.      my $hostname   = $hostid{$certificate};
  " $hostentry</font>");  
  return 1;  
       if ($hostname ne undef) {
    if($managers{$hostname} ne undef) {
       &logthis('<font color="yellow">Authenticating manager'.
        " $hostname</font>");
       return 1;
    } else {
       &logthis('<font color="red" failed manager authentication '.
        $hostname." is not a valid manager host</font>");
       return 0;
    }
     } else {      } else {
  &logthis('<font color="red"> Failed manager authentication '.   &logthis('<font color="red"> Failed manager authentication '.
  "$certificate </font>");   "$certificate </font>");
    return 0;
     }      }
 }  }
 #  #
Line 275  sub CopyFile { Line 233  sub CopyFile {
  return 0;   return 0;
     }      }
 }  }
   #
   #  Host files are passed out with externally visible host IPs.
   #  If, for example, we are behind a fire-wall or NAT host, our 
   #  internally visible IP may be different than the externally
   #  visible IP.  Therefore, we always adjust the contents of the
   #  host file so that the entry for ME is the IP that we believe
   #  we have.  At present, this is defined as the entry that
   #  DNS has for us.  If by some chance we are not able to get a
   #  DNS translation for us, then we assume that the host.tab file
   #  is correct.  
   #    BUGBUGBUG - in the future, we really should see if we can
   #       easily query the interface(s) instead.
   # Parameter(s):
   #     contents    - The contents of the host.tab to check.
   # Returns:
   #     newcontents - The adjusted contents.
   #
   #
   sub AdjustHostContents {
       my $contents  = shift;
       my $adjusted;
       my $me        = $perlvar{'lonHostID'};
   
       foreach my $line (split(/\n/,$contents)) {
    if(!(($line eq "") || ($line =~ /^ *\#/) || ($line =~ /^ *$/))) {
       chomp($line);
       my ($id,$domain,$role,$name,$ip,$maxcon,$idleto,$mincon)=split(/:/,$line);
       if ($id eq $me) {
    open(PIPE, " /usr/bin/host $name |") || die "Cant' make host pipeline";
    my $hostinfo = <PIPE>;
    close PIPE;
   
    my ($hostname, $has, $address, $ipnew) = split(/ /,$hostinfo);
    &logthis('<font color="green">'.
    "hostname = $hostname me = $me, name = $name   actual ip = $ipnew </font>");
   
    if ($hostname eq $name) { # Lookup succeeded..
       &logthis('<font color="green"> look up ok <font>');
       $ip = $ipnew;
    } else {
       &logthis('<font color="green"> Lookup failed: '
        .$hostname." ne $name </font>");
    }
    #  Reconstruct the host line and append to adjusted:
   
    my $newline = "$id:$domain:$role:$name:$ip";
    if($maxcon ne "") { # Not all hosts have loncnew tuning params
       $newline .= ":$maxcon:$idleto:$mincon";
    }
    $adjusted .= $newline."\n";
   
       } else { # Not me, pass unmodified.
    $adjusted .= $line."\n";
       }
    } else {                  # Blank or comment never re-written.
       $adjusted .= $line."\n"; # Pass blanks and comments as is.
    }
       }
       return $adjusted;
   }
 #  #
 #   InstallFile: Called to install an administrative file:  #   InstallFile: Called to install an administrative file:
 #       - The file is created with <name>.tmp  #       - The file is created with <name>.tmp
Line 368  sub PushFile { Line 385  sub PushFile {
     &logthis('<font color="green"> Pushfile: backed up '      &logthis('<font color="green"> Pushfile: backed up '
     .$tablefile." to $backupfile</font>");      .$tablefile." to $backupfile</font>");
           
       #  If the file being pushed is the host file, we adjust the entry for ourself so that the
       #  IP will be our current IP as looked up in dns.  Note this is only 99% good as it's possible
       #  to conceive of conditions where we don't have a DNS entry locally.  This is possible in a 
       #  network sense but it doesn't make much sense in a LonCAPA sense so we ignore (for now)
       #  that possibilty.
   
       if($filename eq "host") {
    $contents = AdjustHostContents($contents);
       }
   
     #  Install the new file:      #  Install the new file:
   
     if(!InstallFile($tablefile, $contents)) {      if(!InstallFile($tablefile, $contents)) {
Line 675  sub checkchildren { Line 702  sub checkchildren {
         }          }
     }      }
     $SIG{ALRM} = 'DEFAULT';      $SIG{ALRM} = 'DEFAULT';
     $SIG{__DIE__} = \&cathcexception;      $SIG{__DIE__} = \&catchexception;
 }  }
   
 # --------------------------------------------------------------------- Logging  # --------------------------------------------------------------------- Logging
Line 2403  sub currentversion { Line 2430  sub currentversion {
 # see if this is a regular file (ignore links produced earlier)  # see if this is a regular file (ignore links produced earlier)
     my $thisfile=$ulsdir.'/'.$ulsfn;      my $thisfile=$ulsdir.'/'.$ulsfn;
     unless (-l $thisfile) {      unless (-l $thisfile) {
  if ($thisfile=~/\Q$fnamere1\E(\d+)\Q$fnamere2\E/) {   if ($thisfile=~/\Q$fnamere1\E(\d+)\Q$fnamere2\E$/) {
     if ($1>$version) { $version=$1; }      if ($1>$version) { $version=$1; }
  }   }
     }      }
Line 2556  sub userload { Line 2583  sub userload {
  while ($filename=readdir(LONIDS)) {   while ($filename=readdir(LONIDS)) {
     if ($filename eq '.' || $filename eq '..') {next;}      if ($filename eq '.' || $filename eq '..') {next;}
     my ($mtime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[9];      my ($mtime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[9];
     if ($curtime-$mtime < 3600) { $numusers++; }      if ($curtime-$mtime < 1800) { $numusers++; }
  }   }
  closedir(LONIDS);   closedir(LONIDS);
     }      }

Removed from v.1.151  
changed lines
  Added in v.1.160


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