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

Diff for /loncom/lond between versions 1.65 and 1.77

version 1.65, 2002/02/05 17:17:49 version 1.77, 2002/04/27 13:10:47
Line 48 Line 48
 # 12/22 Gerd Kortemeyer  # 12/22 Gerd Kortemeyer
 # YEAR=2002  # YEAR=2002
 # 01/20/02,02/05 Gerd Kortemeyer  # 01/20/02,02/05 Gerd Kortemeyer
   # 02/05 Guy Albertelli
   # 02/07 Scott Harrison
   # 02/12 Gerd Kortemeyer
   # 02/19 Matthew Hall
   # 02/25 Gerd Kortemeyer
 ###  ###
   
 # based on "Perl Cookbook" ISBN 1-56592-243-3  # based on "Perl Cookbook" ISBN 1-56592-243-3
Line 68  use Authen::Krb4; Line 73  use Authen::Krb4;
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
 use localauth;  use localauth;
   
   my $DEBUG = 0;       # Non zero to enable debug log entries.
   
 my $status='';  my $status='';
 my $lastlog='';  my $lastlog='';
   
Line 136  open (CONFIG,"$perlvar{'lonTabDir'}/host Line 143  open (CONFIG,"$perlvar{'lonTabDir'}/host
   
 while ($configline=<CONFIG>) {  while ($configline=<CONFIG>) {
     my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);      my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
     chomp($ip);      chomp($ip); $ip=~s/\D+$//;
     $hostid{$ip}=$id;      $hostid{$ip}=$id;
     if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; }      if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; }
     $PREFORK++;      $PREFORK++;
Line 155  $server = IO::Socket::INET->new(LocalPor Line 162  $server = IO::Socket::INET->new(LocalPor
   
 # global variables  # global variables
   
 $MAX_CLIENTS_PER_CHILD  = 5;        # number of clients each child should   $MAX_CLIENTS_PER_CHILD  = 50;        # number of clients each child should 
                                     # process                                      # process
 %children               = ();       # keys are current child process IDs  %children               = ();       # keys are current child process IDs
 $children               = 0;        # current number of children  $children               = 0;        # current number of children
Line 163  $children               = 0;        # cu Line 170  $children               = 0;        # cu
 sub REAPER {                        # takes care of dead children  sub REAPER {                        # takes care of dead children
     $SIG{CHLD} = \&REAPER;      $SIG{CHLD} = \&REAPER;
     my $pid = wait;      my $pid = wait;
     $children --;      if (defined($children{$pid})) {
     &logthis("Child $pid died");   &logthis("Child $pid died");
     delete $children{$pid};   $children --;
    delete $children{$pid};
       } else {
    &logthis("Unknown Child $pid died");
       }
 }  }
   
 sub HUNTSMAN {                      # signal handler for SIGINT  sub HUNTSMAN {                      # signal handler for SIGINT
Line 204  sub checkchildren { Line 215  sub checkchildren {
     foreach (sort keys %children) {      foreach (sort keys %children) {
         unless (-e "$docdir/lon-status/londchld/$_.txt") {          unless (-e "$docdir/lon-status/londchld/$_.txt") {
     &logthis('Child '.$_.' did not respond');      &logthis('Child '.$_.' did not respond');
             kill 9 => $_;      kill 9 => $_;
       $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
       $subj="LON: $perlvar{'lonHostID'} killed lond process $_";
       my $result=`echo 'Killed lond process $_.' | mailto $emailto -s '$subj' > /dev/null`;
       $execdir=$perlvar{'lonDaemons'};
       $result=`/bin/cp $execdir/logs/lond.log $execdir/logs/lond.log.$_`
         }          }
     }      }
 }  }
Line 221  sub logthis { Line 237  sub logthis {
     print $fh "$local ($$): $message\n";      print $fh "$local ($$): $message\n";
 }  }
   
   # ------------------------- Conditional log if $DEBUG true.
   sub Debug {
       my $message = shift;
       if($DEBUG) {
    &logthis($message);
       }
   }
 # ------------------------------------------------------------------ Log status  # ------------------------------------------------------------------ Log status
   
 sub logstatus {  sub logstatus {
Line 287  sub reconlonc { Line 310  sub reconlonc {
         if (kill 0 => $loncpid) {          if (kill 0 => $loncpid) {
     &logthis("lonc at pid $loncpid responding, sending USR1");      &logthis("lonc at pid $loncpid responding, sending USR1");
             kill USR1 => $loncpid;              kill USR1 => $loncpid;
             sleep 1;              sleep 5;
             if (-e "$peerfile") { return; }              if (-e "$peerfile") { return; }
             &logthis("$peerfile still not there, give it another try");              &logthis("$peerfile still not there, give it another try");
             sleep 5;              sleep 10;
             if (-e "$peerfile") { return; }              if (-e "$peerfile") { return; }
             &logthis(              &logthis(
  "<font color=blue>WARNING: $peerfile still not there, giving up</font>");   "<font color=blue>WARNING: $peerfile still not there, giving up</font>");
Line 328  sub reply { Line 351  sub reply {
     if ($answer eq 'con_lost') {      if ($answer eq 'con_lost') {
  $answer=subreply("ping",$server);   $answer=subreply("ping",$server);
         if ($answer ne $server) {          if ($answer ne $server) {
       &logthis("sub reply: answer != server");
            &reconlonc("$perlvar{'lonSockDir'}/$server");             &reconlonc("$perlvar{'lonSockDir'}/$server");
         }          }
         $answer=subreply($cmd,$server);          $answer=subreply($cmd,$server);
Line 517  sub make_new_child { Line 541  sub make_new_child {
             }              }
             if ($clientok) {              if ($clientok) {
 # ---------------- New known client connecting, could mean machine online again  # ---------------- New known client connecting, could mean machine online again
   
       &reconlonc("$perlvar{'lonSockDir'}/$hostid{$clientip}");        &reconlonc("$perlvar{'lonSockDir'}/$hostid{$clientip}");
               &logthis(                &logthis(
        "<font color=green>Established connection: $hostid{$clientip}</font>");         "<font color=green>Established connection: $hostid{$clientip}</font>");
Line 540  sub make_new_child { Line 565  sub make_new_child {
     }      }
     $userinput=substr($userinput,0,$cmdlength);      $userinput=substr($userinput,0,$cmdlength);
                     $wasenc=1;                      $wasenc=1;
   }  
  }   }
         }
     
 # ------------------------------------------------------------- Normal commands  # ------------------------------------------------------------- Normal commands
 # ------------------------------------------------------------------------ ping  # ------------------------------------------------------------------------ ping
    if ($userinput =~ /^ping/) {     if ($userinput =~ /^ping/) {
Line 628  sub make_new_child { Line 654  sub make_new_child {
   $pwdcorrect=!$?;    $pwdcorrect=!$?;
       }        }
                           } elsif ($howpwd eq 'krb4') {                            } elsif ($howpwd eq 'krb4') {
                                $null=pack("C",0);
        unless ($upass=~/$null/) {
                               $pwdcorrect=(                                $pwdcorrect=(
                                  Authen::Krb4::get_pw_in_tkt($uname,"",                                   Authen::Krb4::get_pw_in_tkt($uname,"",
                                         $contentpwd,'krbtgt',$contentpwd,1,                                          $contentpwd,'krbtgt',$contentpwd,1,
      $upass) == 0);       $upass) == 0);
        } else { $pwdcorrect=0; }
                           } elsif ($howpwd eq 'localauth') {                            } elsif ($howpwd eq 'localauth') {
     $pwdcorrect=&localauth::localauth($uname,$upass,      $pwdcorrect=&localauth::localauth($uname,$upass,
       $contentpwd);        $contentpwd);
Line 655  sub make_new_child { Line 684  sub make_new_child {
                        chomp($npass);                         chomp($npass);
                        $upass=&unescape($upass);                         $upass=&unescape($upass);
                        $npass=&unescape($npass);                         $npass=&unescape($npass);
                        my $proname=propath($udom,$uname);         &logthis("Trying to change password for $uname");
          my $proname=propath($udom,$uname);
                        my $passfilename="$proname/passwd";                         my $passfilename="$proname/passwd";
                        if (-e $passfilename) {                         if (-e $passfilename) {
    my $realpasswd;     my $realpasswd;
Line 670  sub make_new_child { Line 700  sub make_new_child {
      my $ncpass=crypt($npass,$salt);       my $ncpass=crypt($npass,$salt);
                              { my $pf = IO::File->new(">$passfilename");                               { my $pf = IO::File->new(">$passfilename");
           print $pf "internal:$ncpass\n"; }                         print $pf "internal:$ncpass\n"; }             
        &logthis("Result of password change for $uname: pwchange_success");
                              print $client "ok\n";                               print $client "ok\n";
                            } else {                             } else {
                              print $client "non_authorized\n";                               print $client "non_authorized\n";
                            }                             }
                           } else {                            } elsif ($howpwd eq 'unix') {
         # Unix means we have to access /etc/password
         # one way or another.
         # First: Make sure the current password is
         #        correct
         $contentpwd=(getpwnam($uname))[1];
         my $pwdcorrect = "0";
         my $pwauth_path="/usr/local/sbin/pwauth";
         unless ($contentpwd eq 'x') {
     $pwdcorrect=
                                       (crypt($upass,$contentpwd) eq $contentpwd);
         } elsif (-e $pwauth_path) {
     open PWAUTH, "|$pwauth_path" or
         die "Cannot invoke authentication";
     print PWAUTH "$uname\n$upass\n";
     close PWAUTH;
     $pwdcorrect=!$?;
         }
        if ($pwdcorrect) {
    my $execdir=$perlvar{'lonDaemons'};
    my $pf = IO::File->new("|$execdir/lcpasswd");
    print $pf "$uname\n$npass\n$npass\n";
    close $pf;
    my $result = ($?>0 ? 'pwchange_failure' 
          : 'ok');
    &logthis("Result of password change for $uname: $result");
    print $client "$result\n";
        } else {
    print $client "non_authorized\n";
        }
     } else {
                             print $client "auth_mode_error\n";                              print $client "auth_mode_error\n";
                           }                              }  
        } else {         } else {
Line 685  sub make_new_child { Line 746  sub make_new_child {
      }       }
 # -------------------------------------------------------------------- makeuser  # -------------------------------------------------------------------- makeuser
                    } elsif ($userinput =~ /^makeuser/) {                     } elsif ($userinput =~ /^makeuser/) {
        Debug("Make user received");
                 my $oldumask=umask(0077);                  my $oldumask=umask(0077);
      if ($wasenc==1) {       if ($wasenc==1) {
                        my                          my 
                        ($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput);                         ($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput);
          &Debug("cmd =".$cmd." $udom =".$udom.
       " uname=".$uname);
                        chomp($npass);                         chomp($npass);
                        $npass=&unescape($npass);                         $npass=&unescape($npass);
                        my $proname=propath($udom,$uname);                         my $proname=propath($udom,$uname);
                        my $passfilename="$proname/passwd";                         my $passfilename="$proname/passwd";
          &Debug("Password file created will be:".
       $passfilename);
                        if (-e $passfilename) {                         if (-e $passfilename) {
    print $client "already_exists\n";     print $client "already_exists\n";
                        } elsif ($udom ne $perlvar{'lonDefDomain'}) {                         } elsif ($udom ne $perlvar{'lonDefDomain'}) {
Line 721  sub make_new_child { Line 787  sub make_new_child {
                                $salt=substr($salt,6,2);                                 $salt=substr($salt,6,2);
        my $ncpass=crypt($npass,$salt);         my $ncpass=crypt($npass,$salt);
                                {                                  { 
                                  my $pf = IO::File->new(">$passfilename");   &Debug("Creating internal auth");
    my $pf = IO::File->new(">$passfilename");
             print $pf "internal:$ncpass\n";               print $pf "internal:$ncpass\n"; 
                                }                                 }
                                print $client "ok\n";                                 print $client "ok\n";
Line 736  sub make_new_child { Line 803  sub make_new_child {
  my $execpath="$perlvar{'lonDaemons'}/".   my $execpath="$perlvar{'lonDaemons'}/".
               "lcuseradd";                "lcuseradd";
  {   {
        &Debug("Executing external: ".
     $execpath);
      my $se = IO::File->new("|$execpath");       my $se = IO::File->new("|$execpath");
      print $se "$uname\n";       print $se "$uname\n";
      print $se "$npass\n";       print $se "$npass\n";
Line 764  sub make_new_child { Line 833  sub make_new_child {
      umask($oldumask);       umask($oldumask);
 # -------------------------------------------------------------- changeuserauth  # -------------------------------------------------------------- changeuserauth
                    } elsif ($userinput =~ /^changeuserauth/) {                     } elsif ($userinput =~ /^changeuserauth/) {
      if ($wasenc==1) {         &Debug("Changing authorization");
         if ($wasenc==1) {
                        my                          my 
                        ($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput);                         ($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput);
                        chomp($npass);                         chomp($npass);
          &Debug("cmd = ".$cmd." domain= ".$udom.
         "uname =".$uname." umode= ".$umode);
                        $npass=&unescape($npass);                         $npass=&unescape($npass);
                        my $proname=propath($udom,$uname);                         my $proname=propath($udom,$uname);
                        my $passfilename="$proname/passwd";                         my $passfilename="$proname/passwd";
Line 976  sub make_new_child { Line 1048  sub make_new_child {
                       }                        }
 # -------------------------------------------------------------------- rolesput  # -------------------------------------------------------------------- rolesput
                    } elsif ($userinput =~ /^rolesput/) {                     } elsif ($userinput =~ /^rolesput/) {
          &Debug("rolesput");
     if ($wasenc==1) {      if ($wasenc==1) {
                        my ($cmd,$exedom,$exeuser,$udom,$uname,$what)                         my ($cmd,$exedom,$exeuser,$udom,$uname,$what)
                           =split(/:/,$userinput);                            =split(/:/,$userinput);
          &Debug("cmd = ".$cmd." exedom= ".$exedom.
       "user = ".$exeuser." udom=".$udom.
       "what = ".$what);
                        my $namespace='roles';                         my $namespace='roles';
                        chomp($what);                         chomp($what);
                        my $proname=propath($udom,$uname);                         my $proname=propath($udom,$uname);
Line 1372  sub make_new_child { Line 1448  sub make_new_child {
                 $client->close();                  $client->close();
                 &logthis("<font color=blue>WARNING: "                  &logthis("<font color=blue>WARNING: "
                 ."Rejected client $clientip, closing connection</font>");                  ."Rejected client $clientip, closing connection</font>");
             }                            }
             &logthis("<font color=red>CRITICAL: "   }              
                     ."Disconnect from $clientip ($hostid{$clientip})</font>");  
 # =============================================================================  # =============================================================================
         }         
        &logthis("<font color=red>CRITICAL: "
    ."Disconnect from $clientip ($hostid{$clientip})</font>");    
         # tidy up gracefully and finish          # tidy up gracefully and finish
           
         $client->close();  
         $server->close();          $server->close();
   
         # this exit is VERY important, otherwise the child will become          # this exit is VERY important, otherwise the child will become
Line 1398  lond - "LON Daemon" Server (port "LOND" Line 1474  lond - "LON Daemon" Server (port "LOND"
   
 =head1 SYNOPSIS  =head1 SYNOPSIS
   
 Should only be run as user=www.  Invoked by loncron.  Usage: B<lond>
   
   Should only be run as user=www.  This is a command-line script which
   is invoked by B<loncron>.  There is no expectation that a typical user
   will manually start B<lond> from the command-line.  (In other words,
   DO NOT START B<lond> YOURSELF.)
   
 =head1 DESCRIPTION  =head1 DESCRIPTION
   
   There are two characteristics associated with the running of B<lond>,
   PROCESS MANAGEMENT (starting, stopping, handling child processes)
   and SERVER-SIDE ACTIVITIES (password authentication, user creation,
   subscriptions, etc).  These are described in two large
   sections below.
   
   B<PROCESS MANAGEMENT>
   
 Preforker - server who forks first. Runs as a daemon. HUPs.  Preforker - server who forks first. Runs as a daemon. HUPs.
 Uses IDEA encryption  Uses IDEA encryption
   
 =head1 README  B<lond> forks off children processes that correspond to the other servers
   in the network.  Management of these processes can be done at the
   parent process level or the child process level.
   
   B<logs/lond.log> is the location of log messages.
   
   The process management is now explained in terms of linux shell commands,
   subroutines internal to this code, and signal assignments:
   
   =over 4
   
   =item *
   
   PID is stored in B<logs/lond.pid>
   
   This is the process id number of the parent B<lond> process.
   
   =item *
   
   SIGTERM and SIGINT
   
   Parent signal assignment:
    $SIG{INT}  = $SIG{TERM} = \&HUNTSMAN;
   
   Child signal assignment:
    $SIG{INT}  = 'DEFAULT'; (and SIGTERM is DEFAULT also)
   (The child dies and a SIGALRM is sent to parent, awaking parent from slumber
    to restart a new child.)
   
   Command-line invocations:
    B<kill> B<-s> SIGTERM I<PID>
    B<kill> B<-s> SIGINT I<PID>
   
   Subroutine B<HUNTSMAN>:
    This is only invoked for the B<lond> parent I<PID>.
   This kills all the children, and then the parent.
   The B<lonc.pid> file is cleared.
   
   =item *
   
   SIGHUP
   
   Current bug:
    This signal can only be processed the first time
   on the parent process.  Subsequent SIGHUP signals
   have no effect.
   
   Parent signal assignment:
    $SIG{HUP}  = \&HUPSMAN;
   
   Child signal assignment:
    none (nothing happens)
   
   Command-line invocations:
    B<kill> B<-s> SIGHUP I<PID>
   
   Subroutine B<HUPSMAN>:
    This is only invoked for the B<lond> parent I<PID>,
   This kills all the children, and then the parent.
   The B<lond.pid> file is cleared.
   
   =item *
   
   SIGUSR1
   
   Parent signal assignment:
    $SIG{USR1} = \&USRMAN;
   
   Child signal assignment:
    $SIG{USR1}= \&logstatus;
   
   Command-line invocations:
    B<kill> B<-s> SIGUSR1 I<PID>
   
   Subroutine B<USRMAN>:
    When invoked for the B<lond> parent I<PID>,
   SIGUSR1 is sent to all the children, and the status of
   each connection is logged.
   
   =item *
   
   SIGCHLD
   
   Parent signal assignment:
    $SIG{CHLD} = \&REAPER;
   
   Child signal assignment:
    none
   
   Command-line invocations:
    B<kill> B<-s> SIGCHLD I<PID>
   
   Subroutine B<REAPER>:
    This is only invoked for the B<lond> parent I<PID>.
   Information pertaining to the child is removed.
   The socket port is cleaned up.
   
   =back
   
   B<SERVER-SIDE ACTIVITIES>
   
   Server-side information can be accepted in an encrypted or non-encrypted
   method.
   
   =over 4
   
   =item ping
   
   Query a client in the hosts.tab table; "Are you there?"
   
   =item pong
   
 Not yet written.  Respond to a ping query.
   
   =item ekey
   
   Read in encrypted key, make cipher.  Respond with a buildkey.
   
   =item load
   
   Respond with CPU load based on a computation upon /proc/loadavg.
   
   =item currentauth
   
   Reply with current authentication information (only over an
   encrypted channel).
   
   =item auth
   
   Only over an encrypted channel, reply as to whether a user's
   authentication information can be validated.
   
   =item passwd
   
   Allow for a password to be set.
   
   =item makeuser
   
   Make a user.
   
   =item passwd
   
   Allow for authentication mechanism and password to be changed.
   
   =item home
   
   Respond to a question "are you the home for a given user?"
   
   =item update
   
   Update contents of a subscribed resource.
   
   =item unsubscribe
   
   The server is unsubscribing from a resource.
   
   =item subscribe
   
   The server is subscribing to a resource.
   
   =item log
   
   Place in B<logs/lond.log>
   
   =item put
   
   stores hash in namespace
   
   =item rolesput
   
   put a role into a user's environment
   
   =item get
   
   returns hash with keys from array
   reference filled in from namespace
   
   =item eget
   
   returns hash with keys from array
   reference filled in from namesp (encrypts the return communication)
   
   =item rolesget
   
   get a role from a user's environment
   
   =item del
   
   deletes keys out of array from namespace
   
   =item keys
   
   returns namespace keys
   
   =item dump
   
   dumps the complete (or key matching regexp) namespace into a hash
   
   =item store
   
   stores hash permanently
   for this url; hashref needs to be given and should be a \%hashname; the
   remaining args aren't required and if they aren't passed or are '' they will
   be derived from the ENV
   
   =item restore
   
   returns a hash for a given url
   
   =item querysend
   
   Tells client about the lonsql process that has been launched in response
   to a sent query.
   
   =item queryreply
   
   Accept information from lonsql and make appropriate storage in temporary
   file space.
   
   =item idput
   
   Defines usernames as corresponding to IDs.  (These "IDs" are unique identifiers
   for each student, defined perhaps by the institutional Registrar.)
   
   =item idget
   
   Returns usernames corresponding to IDs.  (These "IDs" are unique identifiers
   for each student, defined perhaps by the institutional Registrar.)
   
   =item tmpput
   
   Accept and store information in temporary space.
   
   =item tmpget
   
   Send along temporarily stored information.
   
   =item ls
   
   List part of a user's directory.
   
   =item Hanging up (exit or init)
   
   What to do when a client tells the server that they (the client)
   are leaving the network.
   
   =item unknown command
   
   If B<lond> is sent an unknown command (not in the list above),
   it replys to the client "unknown_cmd".
   
   =item UNKNOWN CLIENT
   
   If the anti-spoofing algorithm cannot verify the client,
   the client is rejected (with a "refused" message sent
   to the client, and the connection is closed.
   
   =back
   
 =head1 PREREQUISITES  =head1 PREREQUISITES
   
Line 1432  linux Line 1776  linux
 Server/Process  Server/Process
   
 =cut  =cut
   
   
   
   
Removed from v.1.65  
changed lines
  Added in v.1.77

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