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

Diff for /loncom/lond between versions 1.21 and 1.28

version 1.21, 2000/09/25 20:22:58 version 1.28, 2000/12/05 20:19:46
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 25  use LWP::UserAgent(); Line 27  use LWP::UserAgent();
 use GDBM_File;  use GDBM_File;
 use Authen::Krb4;  use Authen::Krb4;
   
   # grabs exception and records it to log before exiting
   sub catchexception {
       my ($error)=@_;
       $SIG{'QUIT'}='DEFAULT';
       $SIG{__DIE__}='DEFAULT';
       &logthis("<font color=red>CRITICAL: "
        ."ABNORMAL EXIT. Child $$ for server $wasserver died through "
        ."a crash with this error msg->[$error]</font>");
       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)=@_;
       $SIG{'QUIT'}='DEFAULT';
       $SIG{__DIE__}='DEFAULT';
       &logthis("<font color=red>CRITICAL: "
        ."ABNORMAL EXIT. Child $$ for server $wasserver died through "
        ."\_\_DIE\_\_ with this error msg->[$message]</font>");
       if ($client) { print $client "error: $message\n"; }
       die($message);
   }
   
   # -------------------------------- Set signal handlers to record abnormal exits
   
   $SIG{'QUIT'}=\&catchexception;
   $SIG{__DIE__}=\&catchexception;
   
 # ------------------------------------ Read httpd access.conf and get variables  # ------------------------------------ Read httpd access.conf and get variables
   
 open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf";  open (CONFIG,"/etc/httpd/conf/access.conf")
       || catchdie "Can't read access.conf";
   
 while ($configline=<CONFIG>) {  while ($configline=<CONFIG>) {
     if ($configline =~ /PerlSetVar/) {      if ($configline =~ /PerlSetVar/) {
Line 46  if (-e $pidfile) { Line 82  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) { die "already running"; }     if (kill 0 => $pide) { catchdie "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") || die "Can't read host file";  open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab")
       || 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 70  $server = IO::Socket::INET->new(LocalPor Line 107  $server = IO::Socket::INET->new(LocalPor
                                 Proto     => 'tcp',                                  Proto     => 'tcp',
                                 Reuse     => 1,                                  Reuse     => 1,
                                 Listen    => 10 )                                  Listen    => 10 )
   or die "making socket: $@\n";    or catchdie "making socket: $@\n";
   
 # --------------------------------------------------------- Do global variables  # --------------------------------------------------------- Do global variables
   
Line 253  sub ishome { Line 290  sub ishome {
   
 $fpid=fork;  $fpid=fork;
 exit if $fpid;  exit if $fpid;
 die "Couldn't fork: $!" unless defined ($fpid);  catchdie "Couldn't fork: $!" unless defined ($fpid);
   
 POSIX::setsid() or die "Can't start new session: $!";  POSIX::setsid() or catchdie "Can't start new session: $!";
   
 # ------------------------------------------------------- Write our PID on disk  # ------------------------------------------------------- Write our PID on disk
   
Line 294  sub make_new_child { Line 331  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 die "Can't block SIGINT for fork: $!\n";          or catchdie "Can't block SIGINT for fork: $!\n";
           
     die "fork: $!" unless defined ($pid = fork);      catchdie "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 die "Can't unblock SIGINT for fork: $!\n";              or catchdie "Can't unblock SIGINT for fork: $!\n";
         $children{$pid} = 1;          $children{$pid} = 1;
         $children++;          $children++;
         return;          return;
Line 311  sub make_new_child { Line 348  sub make_new_child {
           
         # unblock signals          # unblock signals
         sigprocmask(SIG_UNBLOCK, $sigset)          sigprocmask(SIG_UNBLOCK, $sigset)
             or die "Can't unblock SIGINT for fork: $!\n";              or catchdie "Can't unblock SIGINT for fork: $!\n";
   
         $tmpsnum=0;          $tmpsnum=0;
           
Line 522  sub make_new_child { Line 559  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 569  sub make_new_child { Line 607  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.21  
changed lines
  Added in v.1.28

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