--- loncom/Attic/lonc 2000/02/10 23:20:13 1.6
+++ loncom/Attic/lonc 2000/12/05 16:51:41 1.9
@@ -12,7 +12,7 @@
# 6/4/99,6/5,6/7,6/8,6/9,6/10,6/11,6/12,7/14,7/19,
# 10/8,10/9,10/15,11/18,12/22,
-# 2/8 Gerd Kortemeyer
+# 2/8,7/25 Gerd Kortemeyer
# based on nonforker from Perl Cookbook
# - server who multiplexes without forking
@@ -25,11 +25,38 @@ use Fcntl;
use Tie::RefHash;
use Crypt::IDEA;
+# grabs exception and records it to log before exiting
+sub catchexception {
+ my ($signal)=@_;
+ &logthis("CRITICAL: "
+ ."ABNORMAL EXIT. Child $$ for server $wasserver died through "
+ ."$signal with this parameter->[$@]");
+ die($@);
+}
+
+# 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("CRITICAL: "
+ ."ABNORMAL EXIT. Child $$ for server $wasserver died through "
+ ."\_\_DIE\_\_ with this parameter->[$message]");
+ die($message);
+}
+
$childmaxattempts=10;
+# -------------------------------- Set signal handlers to record abnormal exits
+
+$SIG{'QUIT'}=\&catchexception;
+$SIG{__DIE__}=\&catchexception;
+
# ------------------------------------ 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=) {
if ($configline =~ /PerlSetVar/) {
@@ -40,9 +67,21 @@ while ($configline=) {
}
close(CONFIG);
+# --------------------------------------------- Check if other instance running
+
+my $pidfile="$perlvar{'lonDaemons'}/logs/lonc.pid";
+
+if (-e $pidfile) {
+ my $lfh=IO::File->new("$pidfile");
+ my $pide=<$lfh>;
+ chomp($pide);
+ if (kill 0 => $pide) { catchdie "already running"; }
+}
+
# ------------------------------------------------------------- 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=) {
my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
@@ -143,9 +182,9 @@ sub logperm {
$fpid=fork;
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
@@ -200,14 +239,14 @@ sub make_new_child {
# block signal for fork
$sigset = POSIX::SigSet->new(SIGINT);
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) {
# Parent records the child's birth and returns.
sigprocmask(SIG_UNBLOCK, $sigset)
- or die "Can't unblock SIGINT for fork: $!\n";
+ or catchdie "Can't unblock SIGINT for fork: $!\n";
$children{$pid} = $conserver;
$childpid{$conserver} = $pid;
return;
@@ -217,7 +256,7 @@ sub make_new_child {
# unblock signals
sigprocmask(SIG_UNBLOCK, $sigset)
- or die "Can't unblock SIGINT for fork: $!\n";
+ or catchdie "Can't unblock SIGINT for fork: $!\n";
# ----------------------------- This is the modified main program of non-forker
@@ -484,12 +523,8 @@ sub nonblock {
$flags = fcntl($socket, F_GETFL, 0)
- or die "Can't get flags for socket: $!\n";
+ or catchdie "Can't get flags for socket: $!\n";
fcntl($socket, F_SETFL, $flags | O_NONBLOCK)
- or die "Can't make socket nonblocking: $!\n";
+ or catchdie "Can't make socket nonblocking: $!\n";
}
-
-
-
-