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

Diff for /loncom/lond between versions 1.143 and 1.154

version 1.143, 2003/09/15 10:03:52 version 1.154, 2003/10/08 20:29:46
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.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)  
 #  #
   
   
Line 141  my @adderrors    = ("ok", Line 129  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 335  sub PushFile { Line 323  sub PushFile {
   
     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 350  sub PushFile { Line 338  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 426  if (-e $pidfile) { Line 461  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 485  sub HUPSMAN {                      # sig Line 510  sub HUPSMAN {                      # sig
     exec("$execdir/lond");         # here we go again      exec("$execdir/lond");         # here we go again
 }  }
   
   #
   #    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.
   #   - Reread hosts.tab
   #   - All children connected to hosts that were removed from hosts.tab
   #     are killed via SIGINT
   #   - All children connected to previously existing hosts are sent SIGUSR1
   #   - Our internal hosts hash is updated to reflect the new contents of
   #     hosts.tab causing connections from hosts added to hosts.tab to
   #     now be honored.
   #
   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 516  sub checkchildren { Line 626  sub checkchildren {
         }          }
     }      }
     $SIG{ALRM} = 'DEFAULT';      $SIG{ALRM} = 'DEFAULT';
     $SIG{__DIE__} = \&cathcexception;      $SIG{__DIE__} = \&catchcexception;
 }  }
   
 # --------------------------------------------------------------------- Logging  # --------------------------------------------------------------------- Logging
Line 727  $SIG{CHLD} = \&REAPER; Line 837  $SIG{CHLD} = \&REAPER;
 $SIG{INT}  = $SIG{TERM} = \&HUNTSMAN;  $SIG{INT}  = $SIG{TERM} = \&HUNTSMAN;
 $SIG{HUP}  = \&HUPSMAN;  $SIG{HUP}  = \&HUPSMAN;
 $SIG{USR1} = \&checkchildren;  $SIG{USR1} = \&checkchildren;
   $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 753  sub make_new_child { Line 866  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 785  sub make_new_child { Line 909  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 936  sub make_new_child { Line 1056  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 1244  sub make_new_child { Line 1366  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);
Line 2501  each connection is logged. Line 2629  each connection is logged.
   
 =item *  =item *
   
   SIGUSR2
   
   Parent Signal assignment:
       $SIG{USR2} = \&UpdateHosts
   
   Child signal assignment:
       NONE
   
   
   =item *
   
 SIGCHLD  SIGCHLD
   
 Parent signal assignment:  Parent signal assignment:
Removed from v.1.143  
changed lines
  Added in v.1.154

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