) {
if ($configline =~ /PerlSetVar/) {
my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);
+ chomp($varvalue);
$perlvar{$varname}=$varvalue;
}
}
close(CONFIG);
+# ----------------------------- Make sure this process is running from user=www
+my $wwwid=getpwnam('www');
+if ($wwwid!=$<) {
+ $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
+ $subj="LON: $perlvar{'lonHostID'} User ID mismatch";
+ system("echo 'User ID mismatch. lonc must be run as user www.' |\
+ mailto $emailto -s '$subj' > /dev/null");
+ exit 1;
+}
+
+# --------------------------------------------- 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) { die "already running"; }
+}
+
# ------------------------------------------------------------- Read hosts file
open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file";
@@ -59,7 +106,8 @@ sub REAPER { # ta
$SIG{CHLD} = \&REAPER;
my $pid = wait;
my $wasserver=$children{$pid};
- &logthis("Child $pid for server $wasserver died");
+ &logthis("CRITICAL: "
+ ."Child $pid for server $wasserver died ($childatt{$wasserver})");
delete $children{$pid};
delete $childpid{$wasserver};
my $port = "$perlvar{'lonSockDir'}/$wasserver";
@@ -68,34 +116,45 @@ sub REAPER { # ta
sub HUNTSMAN { # signal handler for SIGINT
local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children
- kill 'INT' => keys %children;
+ map {
+ $wasserver=$children{$_};
+ &logthis('Closing '.$wasserver.': '.&subreply('exit',$wasserver));
+ kill ('INT',$_);
+ } keys %children;
my $execdir=$perlvar{'lonDaemons'};
unlink("$execdir/logs/lonc.pid");
- &logthis("Shutting down");
+ &logthis("CRITICAL: Shutting down");
exit; # clean up with dignity
}
sub HUPSMAN { # signal handler for SIGHUP
local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children
- kill 'INT' => keys %children;
- &logthis("Restarting");
+ map {
+ $wasserver=$children{$_};
+ &logthis('Closing '.$wasserver.': '.&subreply('exit',$wasserver));
+ kill ('INT',$_);
+ } keys %children;
+ &logthis("CRITICAL: Restarting");
+ unlink("$execdir/logs/lonc.pid");
my $execdir=$perlvar{'lonDaemons'};
exec("$execdir/lonc"); # here we go again
}
sub USRMAN {
- %childatt=();
&logthis("USR1: Trying to establish connections again");
foreach $thisserver (keys %hostip) {
$answer=subreply("ping",$thisserver);
- &logthis(
- "USR1: Ping $thisserver (pid >$childpid{$thisserver}<): >$answer<");
+ &logthis("USR1: Ping $thisserver "
+ ."(pid >$childpid{$thisserver}<, $childatt{thisserver} attempts): "
+ ." >$answer<");
}
+ %childatt=();
}
# -------------------------------------------------- Non-critical communication
sub subreply {
my ($cmd,$server)=@_;
+ my $answer='';
if ($server ne $perlvar{'lonHostID'}) {
my $peerfile="$perlvar{'lonSockDir'}/$server";
my $sclient=IO::Socket::UNIX->new(Peer =>"$peerfile",
@@ -121,6 +180,16 @@ sub logthis {
print $fh "$local ($$): $message\n";
}
+
+sub logperm {
+ my $message=shift;
+ my $execdir=$perlvar{'lonDaemons'};
+ my $now=time;
+ my $local=localtime($now);
+ my $fh=IO::File->new(">>$execdir/logs/lonnet.perm.log");
+ print $fh "$now:$message:$local\n";
+}
+
# ---------------------------------------------------- Fork once and dissociate
$fpid=fork;
@@ -135,7 +204,7 @@ $execdir=$perlvar{'lonDaemons'};
open (PIDSAVE,">$execdir/logs/lonc.pid");
print PIDSAVE "$$\n";
close(PIDSAVE);
-&logthis("---------- Starting ----------");
+&logthis("CRITICAL: ---------- Starting ----------");
# ----------------------------- Ignore signals generated during initial startup
$SIG{HUP}=$SIG{USR1}='IGNORE';
@@ -161,9 +230,12 @@ while (1) {
# See who died and start new one
foreach $thisserver (keys %hostip) {
if (!$childpid{$thisserver}) {
- if ($childatt{$thisserver}<5) {
+ if ($childatt{$thisserver}<$childmaxattempts) {
+ $childatt{$thisserver}++;
+ &logthis(
+ "INFO: Trying to reconnect for $thisserver "
+ ."($childatt{$thisserver} of $childmaxattempts attempts)");
make_new_child($thisserver);
- $childatt{$thisserver}++;
}
}
}
@@ -209,15 +281,27 @@ unless (
PeerPort => $perlvar{'londPort'},
Proto => "tcp",
Type => SOCK_STREAM)
- ) { &logthis("Couldn't connect $conserver: $@");
- sleep(5);
+ ) {
+ my $st=120+int(rand(240));
+ &logthis(
+"WARNING: Couldn't connect $conserver ($st secs): $@");
+ sleep($st);
exit;
};
# --------------------------------------- Send a ping to make other end do USR1
-print $remotesock "ping\n";
+print $remotesock "init\n";
+$answer=<$remotesock>;
+print $remotesock "$answer";
$answer=<$remotesock>;
chomp($answer);
-&logthis("Ping reply for $conserver: >$answer<");
+&logthis("Init reply for $conserver: >$answer<");
+if ($answer ne 'ok') {
+ my $st=120+int(rand(240));
+ &logthis(
+"WARNING: Init failed $conserver ($st secs)");
+ sleep($st);
+ exit;
+}
sleep 5;
print $remotesock "pong\n";
$answer=<$remotesock>;
@@ -235,24 +319,77 @@ $key=$key.$buildkey.$key.$buildkey.$key.
$key=substr($key,0,32);
my $cipherkey=pack("H32",$key);
if ($cipher=new IDEA $cipherkey) {
- &logthis("Secure connection inititalized: $conserver");
+ &logthis("Secure connection initialized: $conserver");
} else {
- &logthis("Error: Could not establish secure connection, $conserver!");
-}
+ my $st=120+int(rand(240));
+ &logthis(
+ "WARNING: ".
+ "Could not establish secure connection, $conserver ($st secs)!");
+ sleep($st);
+ exit;
+}
+
+# ----------------------------------------- We're online, send delayed messages
+
+ my @allbuffered;
+ my $path="$perlvar{'lonSockDir'}/delayed";
+ opendir(DIRHANDLE,$path);
+ @allbuffered=grep /\.$conserver$/, readdir DIRHANDLE;
+ closedir(DIRHANDLE);
+ my $dfname;
+ map {
+ $dfname="$path/$_";
+ &logthis($dfname);
+ my $wcmd;
+ {
+ my $dfh=IO::File->new($dfname);
+ $cmd=<$dfh>;
+ }
+ chomp($cmd);
+ my $bcmd=$cmd;
+ if ($cmd =~ /^encrypt\:/) {
+ my $rcmd=$cmd;
+ $rcmd =~ s/^encrypt\://;
+ chomp($rcmd);
+ my $cmdlength=length($rcmd);
+ $rcmd.=" ";
+ my $encrequest='';
+ for (my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {
+ $encrequest.=
+ unpack("H16",$cipher->encrypt(substr($rcmd,$encidx,8)));
+ }
+ $cmd="enc:$cmdlength:$encrequest\n";
+ }
+ print $remotesock "$cmd\n";
+ $answer=<$remotesock>;
+ chomp($answer);
+ if ($answer ne '') {
+ unlink("$dfname");
+ &logthis("Delayed $cmd to $conserver: >$answer<");
+ &logperm("S:$conserver:$bcmd");
+ }
+ } @allbuffered;
# ------------------------------------------------------- Listen to UNIX socket
unless (
$server = IO::Socket::UNIX->new(Local => $port,
Type => SOCK_STREAM,
Listen => 10 )
- ) { &logthis("Can't make server socket $conserver: $@");
- sleep(5);
+ ) {
+ my $st=120+int(rand(240));
+ &logthis(
+ "WARNING: ".
+ "Can't make server socket $conserver ($st secs): $@");
+ sleep($st);
exit;
};
# -----------------------------------------------------------------------------
+&logthis("$conserver online");
+
+# -----------------------------------------------------------------------------
# begin with empty buffers
%inbuffer = ();
%outbuffer = ();
@@ -272,7 +409,7 @@ while (1) {
# check for new information on the connections we have
# anything to read or accept?
- foreach $client ($select->can_read(1)) {
+ foreach $client ($select->can_read(0.1)) {
if ($client == $server) {
# accept a new connection
@@ -321,16 +458,21 @@ while (1) {
$rv = $client->send($outbuffer{$client}, 0);
unless (defined $rv) {
# Whine, but move on.
- warn "I was told I could write, but I can't.\n";
+ &logthis("I was told I could write, but I can't.\n");
next;
}
+ $errno=$!;
if (($rv == length $outbuffer{$client}) ||
- ($! == POSIX::EWOULDBLOCK)) {
+ ($errno == POSIX::EWOULDBLOCK) || ($errno == 0)) {
substr($outbuffer{$client}, 0, $rv) = '';
delete $outbuffer{$client} unless length $outbuffer{$client};
} else {
# Couldn't write all the data, and it wasn't because
# it would have blocked. Shutdown and move on.
+
+ &logthis("Dropping data with ".$errno.": ".
+ length($outbuffer{$client}).", $rv");
+
delete $inbuffer{$client};
delete $outbuffer{$client};
delete $ready{$client};
@@ -410,7 +552,3 @@ sub nonblock {
or die "Can't make socket nonblocking: $!\n";
}
-
-
-
-
500 Internal Server Error
Internal Server Error
The server encountered an internal error or
misconfiguration and was unable to complete
your request.
Please contact the server administrator at
root@localhost to inform them of the time this error occurred,
and the actions you performed just before this error.
More information about this error may be available
in the server error log.