version 1.23, 2000/12/05 16:51:41
|
version 1.25, 2000/12/05 19:03:13
|
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 28 use Authen::Krb4;
|
Line 30 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 ($signal)=@_; |
|
$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>"); |
."$signal with this parameter->[$@]</font>"); |
|
if ($client) { print $client "error: $@\n"; } |
die($@); |
die($@); |
} |
} |
|
|
Line 38 sub catchexception {
|
Line 43 sub catchexception {
|
# 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 parameter->[$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; |