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

Diff for /loncom/lond between versions 1.26 and 1.36

version 1.26, 2000/12/05 19:14:59 version 1.36, 2001/02/12 18:21:47
Line 9 Line 9
 # 06/26 Scott Harrison  # 06/26 Scott Harrison
 # 06/29,06/30,07/14,07/15,07/17,07/20,07/25,09/18 Gerd Kortemeyer  # 06/29,06/30,07/14,07/15,07/17,07/20,07/25,09/18 Gerd Kortemeyer
 # 12/05 Scott Harrison  # 12/05 Scott Harrison
 # 12/05 Gerd Kortemeyer  # 12/05,12/13,12/29 Gerd Kortemeyer
   # Jan 01 Scott Harrison
   # 02/12 Gerd Kortemeyer
 #  #
 # based on "Perl Cookbook" ISBN 1-56592-243-3  # based on "Perl Cookbook" ISBN 1-56592-243-3
 # preforker - server who forks first  # preforker - server who forks first
Line 29  use Authen::Krb4; Line 31  use Authen::Krb4;
   
 # grabs exception and records it to log before exiting  # grabs exception and records it to log before exiting
 sub catchexception {  sub catchexception {
     my ($signal)=@_;      my ($error)=@_;
     $SIG{'QUIT'}='DEFAULT';      $SIG{'QUIT'}='DEFAULT';
     $SIG{__DIE__}='DEFAULT';      $SIG{__DIE__}='DEFAULT';
     &logthis("<font color=red>CRITICAL: "      &logthis("<font color=red>CRITICAL: "
      ."ABNORMAL EXIT. Child $$ for server $wasserver died through "       ."ABNORMAL EXIT. Child $$ for server $wasserver died through "
      ."$signal with this parameter->[$@]</font>");       ."a crash with this error msg->[$error]</font>");
     if ($client) { print $client "error: $@\n"; }      if ($client) { print $client "error: $error\n"; }
     die($@);      die($error);
 }  
   
 # grabs exception and records it to log before exiting  
 # NOTE: we must NOT use the regular (non-overrided) die function in  
 # the code because a handler CANNOT be attached to it  
 # (despite what some of the documentation says about SIG{__DIE__}.  
   
 sub catchdie {  
     my ($message)=@_;  
     $SIG{'QUIT'}='DEFAULT';  
     $SIG{__DIE__}='DEFAULT';  
     &logthis("<font color=red>CRITICAL: "  
      ."ABNORMAL EXIT. Child $$ for server $wasserver died through "  
      ."\_\_DIE\_\_ with this parameter->[$message]</font>");  
     if ($client) { print $client "error: $message\n"; }  
     die($message);  
 }  }
   
 # -------------------------------- Set signal handlers to record abnormal exits  # -------------------------------- Set signal handlers to record abnormal exits
Line 62  $SIG{__DIE__}=\&catchexception; Line 48  $SIG{__DIE__}=\&catchexception;
   
 # ------------------------------------ Read httpd access.conf and get variables  # ------------------------------------ Read httpd access.conf and get variables
   
 open (CONFIG,"/etc/httpd/conf/access.conf")  open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf";
     || catchdie "Can't read access.conf";  
   
 while ($configline=<CONFIG>) {  while ($configline=<CONFIG>) {
     if ($configline =~ /PerlSetVar/) {      if ($configline =~ /PerlSetVar/) {
Line 74  while ($configline=<CONFIG>) { Line 59  while ($configline=<CONFIG>) {
 }  }
 close(CONFIG);  close(CONFIG);
   
   # ----------------------------- Make sure this process is running from user=www
   my $wwwid=getpwnam('www');
   if ($wwwid!=$<) {
      $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
      $subj="LON: $perlvar{'lonHostID'} User ID mismatch";
      system("echo 'User ID mismatch.  loncron must be run as user www.' |\
    mailto $emailto -s '$subj' > /dev/null");
      exit 1;
   }
   
 # --------------------------------------------- Check if other instance running  # --------------------------------------------- Check if other instance running
   
 my $pidfile="$perlvar{'lonDaemons'}/logs/lond.pid";  my $pidfile="$perlvar{'lonDaemons'}/logs/lond.pid";
Line 82  if (-e $pidfile) { Line 77  if (-e $pidfile) {
    my $lfh=IO::File->new("$pidfile");     my $lfh=IO::File->new("$pidfile");
    my $pide=<$lfh>;     my $pide=<$lfh>;
    chomp($pide);     chomp($pide);
    if (kill 0 => $pide) { catchdie "already running"; }     if (kill 0 => $pide) { die "already running"; }
 }  }
   
 $PREFORK=4; # number of children to maintain, at least four spare  $PREFORK=4; # number of children to maintain, at least four spare
   
 # ------------------------------------------------------------- Read hosts file  # ------------------------------------------------------------- Read hosts file
   
 open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab")  open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file";
     || catchdie "Can't read host file";  
   
 while ($configline=<CONFIG>) {  while ($configline=<CONFIG>) {
     my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);      my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
Line 107  $server = IO::Socket::INET->new(LocalPor Line 101  $server = IO::Socket::INET->new(LocalPor
                                 Proto     => 'tcp',                                  Proto     => 'tcp',
                                 Reuse     => 1,                                  Reuse     => 1,
                                 Listen    => 10 )                                  Listen    => 10 )
   or catchdie "making socket: $@\n";    or die "making socket: $@\n";
   
 # --------------------------------------------------------- Do global variables  # --------------------------------------------------------- Do global variables
   
Line 140  sub HUPSMAN {                      # sig Line 134  sub HUPSMAN {                      # sig
     kill 'INT' => keys %children;      kill 'INT' => keys %children;
     close($server);                # free up socket      close($server);                # free up socket
     &logthis("<font color=red>CRITICAL: Restarting</font>");      &logthis("<font color=red>CRITICAL: Restarting</font>");
       unlink("$execdir/logs/lond.pid");
     my $execdir=$perlvar{'lonDaemons'};      my $execdir=$perlvar{'lonDaemons'};
     exec("$execdir/lond");         # here we go again      exec("$execdir/lond");         # here we go again
 }  }
Line 290  sub ishome { Line 285  sub ishome {
   
 $fpid=fork;  $fpid=fork;
 exit if $fpid;  exit if $fpid;
 catchdie "Couldn't fork: $!" unless defined ($fpid);  die "Couldn't fork: $!" unless defined ($fpid);
   
 POSIX::setsid() or catchdie "Can't start new session: $!";  POSIX::setsid() or die "Can't start new session: $!";
   
 # ------------------------------------------------------- Write our PID on disk  # ------------------------------------------------------- Write our PID on disk
   
Line 331  sub make_new_child { Line 326  sub make_new_child {
     # block signal for fork      # block signal for fork
     $sigset = POSIX::SigSet->new(SIGINT);      $sigset = POSIX::SigSet->new(SIGINT);
     sigprocmask(SIG_BLOCK, $sigset)      sigprocmask(SIG_BLOCK, $sigset)
         or catchdie "Can't block SIGINT for fork: $!\n";          or die "Can't block SIGINT for fork: $!\n";
           
     catchdie "fork: $!" unless defined ($pid = fork);      die "fork: $!" unless defined ($pid = fork);
           
     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 catchdie "Can't unblock SIGINT for fork: $!\n";              or die "Can't unblock SIGINT for fork: $!\n";
         $children{$pid} = 1;          $children{$pid} = 1;
         $children++;          $children++;
         return;          return;
Line 348  sub make_new_child { Line 343  sub make_new_child {
           
         # unblock signals          # unblock signals
         sigprocmask(SIG_UNBLOCK, $sigset)          sigprocmask(SIG_UNBLOCK, $sigset)
             or catchdie "Can't unblock SIGINT for fork: $!\n";              or die "Can't unblock SIGINT for fork: $!\n";
   
         $tmpsnum=0;          $tmpsnum=0;
           
Line 494  sub make_new_child { Line 489  sub make_new_child {
                        my                          my 
                        ($cmd,$udom,$uname,$upass,$npass)=split(/:/,$userinput);                         ($cmd,$udom,$uname,$upass,$npass)=split(/:/,$userinput);
                        chomp($npass);                         chomp($npass);
                          $upass=&unescape($upass);
                          $npass=&unescape($npass);
                        my $proname=propath($udom,$uname);                         my $proname=propath($udom,$uname);
                        my $passfilename="$proname/passwd";                         my $passfilename="$proname/passwd";
                        if (-e $passfilename) {                         if (-e $passfilename) {
Line 508  sub make_new_child { Line 505  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");                               { my $pf = IO::File->new(">$passfilename");
           print $pf "internal:$ncpass\n";; }                         print $pf "internal:$ncpass\n"; }             
                              print $client "ok\n";                               print $client "ok\n";
                            } else {                             } else {
                              print $client "non_authorized\n";                               print $client "non_authorized\n";
Line 522  sub make_new_child { Line 519  sub make_new_child {
      } else {       } else {
        print $client "refused\n";         print $client "refused\n";
      }       }
   # -------------------------------------------------------------------- makeuser
                      } elsif ($userinput =~ /^makeuser/) {
        if ($wasenc==1) {
                          my 
                          ($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput);
                          chomp($npass);
                          $npass=&unescape($npass);
                          my $proname=propath($udom,$uname);
                          my $passfilename="$proname/passwd";
                          if (-e $passfilename) {
      print $client "already_exists\n";
                          } elsif ($udom ne $perlvar{'lonDefDomain'}) {
                              print $client "not_right_domain\n";
                          } else {
                              @fpparts=split(/\//,$proname);
                              $fpnow=$fpparts[0].'/'.$fpparts[1].'/'.$fpparts[2];
                              $fperror='';
                              for ($i=3;$i<=$#fpparts;$i++) {
                                  $fpnow.='/'.$fpparts[$i]; 
                                  unless (-e $fpnow) {
      unless (mkdir($fpnow,0777)) {
                                         $fperror="error:$!\n";
                                      }
                                  }
                              }
                              unless ($fperror) {
        if ($umode eq 'krb4') {
                                  { 
                                    my $pf = IO::File->new(">$passfilename");
               print $pf "krb4:$npass\n"; 
                                  }             
                                  print $client "ok\n";
                                } elsif ($umode eq 'internal') {
          my $salt=time;
                                  $salt=substr($salt,6,2);
          my $ncpass=crypt($npass,$salt);
                                  { 
                                    my $pf = IO::File->new(">$passfilename");
               print $pf "internal:$ncpass\n"; 
                                  }             
                                  print $client "ok\n";
                                } elsif ($umode eq 'none') {
                                  { 
                                    my $pf = IO::File->new(">$passfilename");
               print $pf "none:\n"; 
                                  }             
                                  print $client "ok\n";
                                } else {
                                  print $client "auth_mode_error\n";
                                }  
                              } else {
                                  print $client "$fperror\n";
                              }
                          }
        } else {
          print $client "refused\n";
        }
 # ------------------------------------------------------------------------ home  # ------------------------------------------------------------------------ home
                    } elsif ($userinput =~ /^home/) {                     } elsif ($userinput =~ /^home/) {
                        my ($cmd,$udom,$uname)=split(/:/,$userinput);                         my ($cmd,$udom,$uname)=split(/:/,$userinput);
Line 565  sub make_new_child { Line 619  sub make_new_child {
                                   "LWP GET: $message for $fname ($remoteurl)");                                    "LWP GET: $message for $fname ($remoteurl)");
                              } else {                               } else {
                          if ($remoteurl!~/\.meta$/) {                           if ($remoteurl!~/\.meta$/) {
                                     my $ua=new LWP::UserAgent;
                                   my $mrequest=                                    my $mrequest=
                                    new HTTP::Request('GET',$remoteurl.'.meta');                                     new HTTP::Request('GET',$remoteurl.'.meta');
                                   my $mresponse=                                    my $mresponse=
Line 862  sub make_new_child { Line 917  sub make_new_child {
                                $allkeys.=$key.':';                                 $allkeys.=$key.':';
                                $hash{"$version:$rid:$key"}=$value;                                 $hash{"$version:$rid:$key"}=$value;
                            }                             }
                            $allkeys=~s/:$//;                             $hash{"$version:$rid:timestamp"}=$now;
                              $allkeys.='timestamp';
                            $hash{"$version:keys:$rid"}=$allkeys;                             $hash{"$version:keys:$rid"}=$allkeys;
    if (untie(%hash)) {     if (untie(%hash)) {
                               print $client "ok\n";                                print $client "ok\n";
Removed from v.1.26  
changed lines
  Added in v.1.36

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.