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

Diff for /loncom/lond between versions 1.23 and 1.29

version 1.23, 2000/12/05 16:51:41 version 1.29, 2000/12/06 18:05:51
Line 8 Line 8
 # 03/07,05/31 Gerd Kortemeyer  # 03/07,05/31 Gerd Kortemeyer
 # 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 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 27  use Authen::Krb4; Line 29  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{__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>");
     die($@);      if ($client) { print $client "error: $error\n"; }
 }      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)=@_;  
     &logthis("<font color=red>CRITICAL: "  
      ."ABNORMAL EXIT. Child $$ for server $wasserver died through "  
      ."\_\_DIE\_\_ with this parameter->[$message]</font>");  
     die($message);  
 }  }
   
 # -------------------------------- Set signal handlers to record abnormal exits  # -------------------------------- Set signal handlers to record abnormal exits
Line 53  $SIG{__DIE__}=\&catchexception; Line 46  $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 73  if (-e $pidfile) { Line 65  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 98  $server = IO::Socket::INET->new(LocalPor Line 89  $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 281  sub ishome { Line 272  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 322  sub make_new_child { Line 313  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 339  sub make_new_child { Line 330  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 550  sub make_new_child { Line 541  sub make_new_child {
                              $response=$ua->request($request,$transname);                               $response=$ua->request($request,$transname);
       }        }
                              if ($response->is_error()) {                               if ($response->is_error()) {
  unline($transname);   unlink($transname);
                                  my $message=$response->status_line;                                   my $message=$response->status_line;
                                  &logthis(                                   &logthis(
                                   "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 597  sub make_new_child { Line 589  sub make_new_child {
                          } else {                           } else {
                            $now=time;                             $now=time;
                            {                              { 
                             my $sh=IO::File->new(">$fname.$hostid{$clientip}");      my $sh;
                             print $sh "$clientip:$now\n";                              if ($sh=
                                IO::File->new(">$fname.$hostid{$clientip}")) {
                                  print $sh "$clientip:$now\n";
       }
    }     }
                            $fname=~s/\/home\/httpd\/html\/res/raw/;                             $fname=~s/\/home\/httpd\/html\/res/raw/;
                            $fname="http://$thisserver/".$fname;                             $fname="http://$thisserver/".$fname;
Removed from v.1.23  
changed lines
  Added in v.1.29

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.