[BACK]Return to lond CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.144 and 1.158

version 1.144, 2003/09/16 09:47:01 version 1.158, 2003/10/21 09:14:31
Line 59 Line 59
 #       - pushing /home/httpd/lonTabs/domain.tab  #       - pushing /home/httpd/lonTabs/domain.tab
 # 09/08/2003 Ron Fox:  Told lond to take care of change logging so we  # 09/08/2003 Ron Fox:  Told lond to take care of change logging so we
 #      don't have to remember it:  #      don't have to remember it:
 # $Log$  #
 # Revision 1.144  2003/09/16 09:47:01  foxr  # Change Log:
 # Added skeletal support for SIGUSR2 (update hosts.tab)  #   $Log$
 #  #   Revision 1.158  2003/10/21 09:14:31  foxr
 # Revision 1.143  2003/09/15 10:03:52  foxr  #   Re-install $Log$ in comment header to support automatic change logging.
 # 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)  
 #  #
   
   
Line 114  my $thisserver; Line 105  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 144  my @adderrors    = ("ok", Line 136  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 170  sub GetCertificate { Line 162  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 182  sub GetCertificate { Line 204  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 241  sub CopyFile { Line 274  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 334  sub PushFile { Line 426  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)) {
  &logthis('<font color="red"> Pushfile: unable to install '   &logthis('<font color="red"> Pushfile: unable to install '
  .$tablefile." $! </font>");   .$tablefile." $! </font>");
  return "error:$!";   return "error:$!";
     }      }
     else {      else {
Line 353  sub PushFile { Line 455  sub PushFile {
     return "ok";      return "ok";
   
 }  }
   
   #
   #  Called to re-init either lonc or lond.
   #
   #  Parameters:
   #    request   - The full request by the client.  This is of the form
   #                reinit:<process>  
   #                where <process> is allowed to be either of 
   #                lonc or lond
   #
   #  Returns:
   #     The string to be sent back to the client either:
   #   ok         - Everything worked just fine.
   #   error:why  - There was a failure and why describes the reason.
   #
   #
   sub ReinitProcess {
       my $request = shift;
   
   
       # separate the request (reinit) from the process identifier and
       # validate it producing the name of the .pid file for the process.
       #
       #
       my ($junk, $process) = split(":", $request);
       my $processpidfile = $perlvar{'lonDaemons'}.'/logs/';
       if($process eq 'lonc') {
    $processpidfile = $processpidfile."lonc.pid";
    if (!open(PIDFILE, "< $processpidfile")) {
       return "error:Open failed for $processpidfile";
    }
    my $loncpid = <PIDFILE>;
    close(PIDFILE);
    logthis('<font color="red"> Reinitializing lonc pid='.$loncpid
    ."</font>");
    kill("USR2", $loncpid);
       } elsif ($process eq 'lond') {
    logthis('<font color="red"> Reinitializing self (lond) </font>');
    &UpdateHosts; # Lond is us!!
       } else {
    &logthis('<font color="yellow" Invalid reinit request for '.$process
    ."</font>");
    return "error:Invalid process identifier $process";
       }
       return 'ok';
   }
   
 #  #
 #  Convert an error return code from lcpasswd to a string value.  #  Convert an error return code from lcpasswd to a string value.
 #  #
Line 429  if (-e $pidfile) { Line 578  if (-e $pidfile) {
   
 # ------------------------------------------------------------- Read hosts file  # ------------------------------------------------------------- Read hosts file
   
 open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file";  
   
 while (my $configline=<CONFIG>) {  
     my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);  
     chomp($ip); $ip=~s/\D+$//;  
     $hostid{$ip}=$id;  
     $hostdom{$id}=$domain;  
     $hostip{$id}=$ip;  
     if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; }  
 }  
 close(CONFIG);  
   
 # establish SERVER socket, bind and listen.  # establish SERVER socket, bind and listen.
 $server = IO::Socket::INET->new(LocalPort => $perlvar{'londPort'},  $server = IO::Socket::INET->new(LocalPort => $perlvar{'londPort'},
Line 489  sub HUPSMAN {                      # sig Line 628  sub HUPSMAN {                      # sig
 }  }
   
 #  #
   #    Kill off hashes that describe the host table prior to re-reading it.
   #    Hashes affected are:
   #       %hostid, %hostdom %hostip
   #
   sub KillHostHashes {
       foreach my $key (keys %hostid) {
    delete $hostid{$key};
       }
       foreach my $key (keys %hostdom) {
    delete $hostdom{$key};
       }
       foreach my $key (keys %hostip) {
    delete $hostip{$key};
       }
   }
   #
   #   Read in the host table from file and distribute it into the various hashes:
   #
   #    - %hostid  -  Indexed by IP, the loncapa hostname.
   #    - %hostdom -  Indexed by  loncapa hostname, the domain.
   #    - %hostip  -  Indexed by hostid, the Ip address of the host.
   sub ReadHostTable {
   
       open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file";
       
       while (my $configline=<CONFIG>) {
    my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
    chomp($ip); $ip=~s/\D+$//;
    $hostid{$ip}=$id;
    $hostdom{$id}=$domain;
    $hostip{$id}=$ip;
    if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; }
       }
       close(CONFIG);
   }
   #
   #  Reload the Apache daemon's state.
   #  This is done by invoking /home/httpd/perl/apachereload
   #  a setuid perl script that can be root for us to do this job.
   #
   sub ReloadApache {
       my $execdir = $perlvar{'lonDaemons'};
       my $script  = $execdir."/apachereload";
       system($script);
   }
   
   #
 #   Called in response to a USR2 signal.  #   Called in response to a USR2 signal.
 #   - Reread hosts.tab  #   - Reread hosts.tab
 #   - All children connected to hosts that were removed from hosts.tab  #   - All children connected to hosts that were removed from hosts.tab
Line 499  sub HUPSMAN {                      # sig Line 685  sub HUPSMAN {                      # sig
 #     now be honored.  #     now be honored.
 #  #
 sub UpdateHosts {  sub UpdateHosts {
       logthis('<font color="blue"> Updating connections </font>');
       #
       #  The %children hash has the set of IP's we currently have children
       #  on.  These need to be matched against records in the hosts.tab
       #  Any ip's no longer in the table get killed off they correspond to
       #  either dropped or changed hosts.  Note that the re-read of the table
       #  will take care of new and changed hosts as connections come into being.
   
   
       KillHostHashes;
       ReadHostTable;
   
       foreach my $child (keys %children) {
    my $childip = $children{$child};
    if(!$hostid{$childip}) {
       logthis('<font color="blue"> UpdateHosts killing child '
       ." $child for ip $childip </font>");
       kill('INT', $child);
    } else {
       logthis('<font color="green"> keeping child for ip '
       ." $childip (pid=$child) </font>");
    }
       }
       ReloadApache;
 }  }
   
   
 sub checkchildren {  sub checkchildren {
     &initnewstatus();      &initnewstatus();
     &logstatus();      &logstatus();
Line 532  sub checkchildren { Line 743  sub checkchildren {
         }          }
     }      }
     $SIG{ALRM} = 'DEFAULT';      $SIG{ALRM} = 'DEFAULT';
     $SIG{__DIE__} = \&cathcexception;      $SIG{__DIE__} = \&catchexception;
 }  }
   
 # --------------------------------------------------------------------- Logging  # --------------------------------------------------------------------- Logging
Line 745  $SIG{HUP}  = \&HUPSMAN; Line 956  $SIG{HUP}  = \&HUPSMAN;
 $SIG{USR1} = \&checkchildren;  $SIG{USR1} = \&checkchildren;
 $SIG{USR2} = \&UpdateHosts;  $SIG{USR2} = \&UpdateHosts;
   
   #  Read the host hashes:
   
   ReadHostTable;
   
 # --------------------------------------------------------------  # --------------------------------------------------------------
 #   Accept connections.  When a connection comes in, it is validated  #   Accept connections.  When a connection comes in, it is validated
Line 769  sub make_new_child { Line 983  sub make_new_child {
         or die "Can't block SIGINT for fork: $!\n";          or die "Can't block SIGINT for fork: $!\n";
   
     die "fork: $!" unless defined ($pid = fork);      die "fork: $!" unless defined ($pid = fork);
   
       $client->sockopt(SO_KEEPALIVE, 1); # Enable monitoring of
                                  # connection liveness.
   
       #
       #  Figure out who we're talking to so we can record the peer in 
       #  the pid hash.
       #
       my $caller = getpeername($client);
       my ($port,$iaddr)=unpack_sockaddr_in($caller);
       $clientip=inet_ntoa($iaddr);
           
     if ($pid) {      if ($pid) {
         # Parent records the child's birth and returns.          # Parent records the child's birth and returns.
         sigprocmask(SIG_UNBLOCK, $sigset)          sigprocmask(SIG_UNBLOCK, $sigset)
             or die "Can't unblock SIGINT for fork: $!\n";              or die "Can't unblock SIGINT for fork: $!\n";
         $children{$pid} = 1;          $children{$pid} = $clientip;
         $children++;          $children++;
         &status('Started child '.$pid);          &status('Started child '.$pid);
         return;          return;
Line 801  sub make_new_child { Line 1026  sub make_new_child {
 # =============================================================================  # =============================================================================
             # do something with the connection              # do something with the connection
 # -----------------------------------------------------------------------------  # -----------------------------------------------------------------------------
     $client->sockopt(SO_KEEPALIVE, 1);# Enable monitoring of   # see if we know client and check for spoof IP by challenge
                                       # connection liveness.  
             # see if we know client and check for spoof IP by challenge  
  my $caller = getpeername($client);  
             my ($port,$iaddr)=unpack_sockaddr_in($caller);  
             $clientip=inet_ntoa($iaddr);  
             my $clientrec=($hostid{$clientip} ne undef);              my $clientrec=($hostid{$clientip} ne undef);
             &logthis(              &logthis(
 "<font color=yellow>INFO: Connection, $clientip ($hostid{$clientip})</font>"  "<font color=yellow>INFO: Connection, $clientip ($hostid{$clientip})</font>"
Line 952  sub make_new_child { Line 1173  sub make_new_child {
        if ($wasenc == 1) {         if ($wasenc == 1) {
    my $cert = GetCertificate($userinput);     my $cert = GetCertificate($userinput);
    if(ValidManager($cert)) {     if(ValidManager($cert)) {
        print $client "ok\n";         chomp($userinput);
          my $reply = ReinitProcess($userinput);
          print $client  "$reply\n";
    } else {     } else {
        print $client "refused\n";         print $client "refused\n";
    }     }
Line 1260  sub make_new_child { Line 1483  sub make_new_child {
                        }                         }
 # -------------------------------------- fetch a user file from a remote server  # -------------------------------------- fetch a user file from a remote server
                    } elsif ($userinput =~ /^fetchuserfile/) {                     } elsif ($userinput =~ /^fetchuserfile/) {
                       my ($cmd,$fname)=split(/:/,$userinput);         my ($cmd,$fname)=split(/:/,$userinput);
       my ($udom,$uname,$ufile)=split(/\//,$fname);         my ($udom,$uname,$ufile)=split(/\//,$fname);
                       my $udir=propath($udom,$uname).'/userfiles';         my $udir=propath($udom,$uname).'/userfiles';
                       unless (-e $udir) { mkdir($udir,0770); }         unless (-e $udir) { mkdir($udir,0770); }
                        if (-e $udir) {                         if (-e $udir) {
                        $ufile=~s/^[\.\~]+//;     $ufile=~s/^[\.\~]+//;
                        $ufile=~s/\///g;     $ufile=~s/\///g;
                        my $transname=$udir.'/'.$ufile;     my $destname=$udir.'/'.$ufile;
                        my $remoteurl='http://'.$clientip.'/userfiles/'.$fname;     my $transname=$udir.'/'.$ufile.'.in.transit';
                              my $response;     my $remoteurl='http://'.$clientip.'/userfiles/'.$fname;
                               {     my $response;
                              my $ua=new LWP::UserAgent;     {
                              my $request=new HTTP::Request('GET',"$remoteurl");         my $ua=new LWP::UserAgent;
                              $response=$ua->request($request,$transname);         my $request=new HTTP::Request('GET',"$remoteurl");
       }         $response=$ua->request($request,$transname);
                              if ($response->is_error()) {     }
  unlink($transname);     if ($response->is_error()) {
                                  my $message=$response->status_line;         unlink($transname);
                                  &logthis(         my $message=$response->status_line;
                                   "LWP GET: $message for $fname ($remoteurl)");         &logthis("LWP GET: $message for $fname ($remoteurl)");
  print $client "failed\n";         print $client "failed\n";
                              } else {     } else {
                                  print $client "ok\n";         if (!rename($transname,$destname)) {
                              }     &logthis("Unable to move $transname to $destname");
                      } else {     unlink($transname);
                        print $client "not_home\n";     print $client "failed\n";
                      }          } else {
      print $client "ok\n";
          }
      }
          } else {
      print $client "not_home\n";
          }
 # ------------------------------------------ authenticate access to a user file  # ------------------------------------------ authenticate access to a user file
                    } elsif ($userinput =~ /^tokenauthuserfile/) {                     } elsif ($userinput =~ /^tokenauthuserfile/) {
                        my ($cmd,$fname,$session)=split(/:/,$userinput);                         my ($cmd,$fname,$session)=split(/:/,$userinput);
Removed from v.1.144  
changed lines
  Added in v.1.158

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