version 1.27, 2000/12/05 19:45:36
|
version 1.29, 2000/12/06 18:05:51
|
Line 39 sub catchexception {
|
Line 39 sub catchexception {
|
die($error); |
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 |
# -------------------------------- Set signal handlers to record abnormal exits |
|
|
$SIG{'QUIT'}=\&catchexception; |
$SIG{'QUIT'}=\&catchexception; |
Line 62 $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 82 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 107 $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 290 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 331 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 348 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 565 sub make_new_child {
|
Line 547 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= |