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

Diff for /loncom/lond between versions 1.23 and 1.27

version 1.23, 2000/12/05 16:51:41 version 1.27, 2000/12/05 19:45:36
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  # grabs exception and records it to log before exiting
 # NOTE: we must NOT use the regular (non-overrided) die function in  # NOTE: we must NOT use the regular (non-overrided) die function in
 # the code because a handler CANNOT be attached to it  # the code because a handler CANNOT be attached to it
 # (despite what some of the documentation says about SIG{__DIE__}.  # (despite what some of the documentation says about SIG{__DIE__}.
   
 sub catchdie {  sub catchdie {
     my ($message)=@_;      my ($message)=@_;
       $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 "
      ."\_\_DIE\_\_ with this parameter->[$message]</font>");       ."\_\_DIE\_\_ with this error msg->[$message]</font>");
       if ($client) { print $client "error: $message\n"; }
     die($message);      die($message);
 }  }
   
Line 550  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)");
Line 597  sub make_new_child { Line 606  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.27

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