[LON-CAPA-cvs] cvs: loncom / lonc
www
lon-capa-cvs@mail.lon-capa.org
Mon, 25 Feb 2002 15:48:11 -0000
This is a MIME encoded message
--www1014652091
Content-Type: text/plain
www Mon Feb 25 10:48:11 2002 EDT
Modified files:
/loncom lonc
Log:
Attempt to be able to close connections from inside of lonnet UNTESTED
--www1014652091
Content-Type: text/plain
Content-Disposition: attachment; filename="www-20020225104811.txt"
Index: loncom/lonc
diff -u loncom/lonc:1.28 loncom/lonc:1.29
--- loncom/lonc:1.28 Tue Feb 19 17:51:13 2002
+++ loncom/lonc Mon Feb 25 10:48:11 2002
@@ -5,7 +5,7 @@
# provides persistent TCP connections to the other servers in the network
# through multiplexed domain sockets
#
-# $Id: lonc,v 1.28 2002/02/19 22:51:13 www Exp $
+# $Id: lonc,v 1.29 2002/02/25 15:48:11 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -44,7 +44,7 @@
# 03/14/01,03/15,06/12,11/26,11/27,11/28 Gerd Kortemeyer
# 12/20 Scott Harrison
# YEAR=2002
-# 2/19/02
+# 2/19/02,02/22/02,02/25/02 Gerd Kortemeyer
#
# based on nonforker from Perl Cookbook
# - server who multiplexes without forking
@@ -66,11 +66,12 @@
# grabs exception and records it to log before exiting
sub catchexception {
my ($signal)=@_;
- $SIG{'QUIT'}='DEFAULT';
+ $SIG{QUIT}='DEFAULT';
$SIG{__DIE__}='DEFAULT';
+ chomp($signal);
&logthis("<font color=red>CRITICAL: "
- ."ABNORMAL EXIT. Child $$ for server $wasserver died through "
- ."\"$signal\" with this parameter->[$@]</font>");
+ ."ABNORMAL EXIT. Child $$ for server [$wasserver] died through "
+ ."\"$signal\" with parameter [$@]</font>");
die($@);
}
@@ -80,6 +81,7 @@
sub online {
my $host=shift;
+ &status("Pinging ".$host);
my $p=Net::Ping->new("tcp",20);
my $online=$p->ping("$host");
$p->close();
@@ -89,6 +91,7 @@
sub connected {
my ($local,$remote)=@_;
+ &status("Checking connection $local to $remote");
$local=~s/\W//g;
$remote=~s/\W//g;
@@ -116,11 +119,12 @@
# -------------------------------- Set signal handlers to record abnormal exits
+&status("Init exception handlers");
$SIG{QUIT}=\&catchexception;
$SIG{__DIE__}=\&catchexception;
# ------------------------------------ Read httpd access.conf and get variables
-
+&status("Read access.conf");
open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf";
while ($configline=<CONFIG>) {
@@ -133,6 +137,7 @@
close(CONFIG);
# ----------------------------- Make sure this process is running from user=www
+&status("Check user ID");
my $wwwid=getpwnam('www');
if ($wwwid!=$<) {
$emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
@@ -224,7 +229,7 @@
foreach (sort keys %children) {
sleep 1;
unless (kill 'USR1' => $_) {
- &logthis ('Child '.$_.' is dead');
+ &logthis ('<font color=red>CRITICAL: Child '.$_.' is dead</font>');
&logstatus($$.' is dead');
}
}
@@ -273,7 +278,7 @@
my $now=time;
my $local=localtime($now);
$lastlog=$local.': '.$message;
- print $fh "$local ($$): $message\n";
+ print $fh "$local ($$) [$status]: $message\n";
}
@@ -312,7 +317,7 @@
# ---------------------------------------------------- Fork once and dissociate
-
+&status("Fork and dissociate");
$fpid=fork;
exit if $fpid;
die "Couldn't fork: $!" unless defined ($fpid);
@@ -320,7 +325,7 @@
POSIX::setsid() or die "Can't start new session: $!";
# ------------------------------------------------------- Write our PID on disk
-
+&status("Write PID");
$execdir=$perlvar{'lonDaemons'};
open (PIDSAVE,">$execdir/logs/lonc.pid");
print PIDSAVE "$$\n";
@@ -362,7 +367,8 @@
$childatt{$thisserver}++;
&logthis(
"<font color=yellow>INFO: Trying to reconnect for $thisserver "
- ."($childatt{$thisserver} of $childmaxattempts attempts)</font>");
+ ."(".($childatt{$thisserver}?$childatt{$thisserver}:'none').
+ " of $childmaxattempts attempts)</font>");
make_new_child($thisserver);
} else {
&logthis(
@@ -410,82 +416,9 @@
unlink($port);
-# ---------------------------------------------------- Client to network server
-
-&status("Opening TCP: $conserver");
-
-unless (
- $remotesock = IO::Socket::INET->new(PeerAddr => $hostip{$conserver},
- PeerPort => $perlvar{'londPort'},
- Proto => "tcp",
- Type => SOCK_STREAM)
- ) {
- my $st=120+int(rand(240));
- &logthis(
-"<font color=blue>WARNING: Couldn't connect $conserver ($st secs): $@</font>");
- sleep($st);
- exit;
- };
-# ----------------------------------------------------------------- Init dialog
-
-&status("Init dialogue: $conserver");
-
- $SIG{ALRM}=sub { die "timeout" };
- $SIG{__DIE__}='DEFAULT';
- eval {
- alarm(60);
-print $remotesock "init\n";
-$answer=<$remotesock>;
-print $remotesock "$answer";
-$answer=<$remotesock>;
-chomp($answer);
- alarm(0);
- };
- $SIG{ALRM}='DEFAULT';
- $SIG{__DIE__}=\&catchexception;
-
- if ($@=~/timeout/) {
- &logthis("Timed out during init: $conserver");
- exit;
- }
-
-
-&logthis("Init reply for $conserver: >$answer<");
-if ($answer ne 'ok') {
- my $st=120+int(rand(240));
- &logthis(
-"<font color=blue>WARNING: Init failed $conserver ($st secs)</font>");
- sleep($st);
- exit;
-}
-sleep 5;
-&status("Ponging $conserver");
-print $remotesock "pong\n";
-$answer=<$remotesock>;
-chomp($answer);
-&logthis("Pong reply for $conserver: >$answer<");
-# ----------------------------------------------------------- Initialize cipher
+# -------------------------------------------------------------- Open other end
-&status("Initialize cipher: $conserver");
-print $remotesock "ekey\n";
-my $buildkey=<$remotesock>;
-my $key=$conserver.$perlvar{'lonHostID'};
-$key=~tr/a-z/A-Z/;
-$key=~tr/G-P/0-9/;
-$key=~tr/Q-Z/0-9/;
-$key=$key.$buildkey.$key.$buildkey.$key.$buildkey;
-$key=substr($key,0,32);
-my $cipherkey=pack("H32",$key);
-if ($cipher=new IDEA $cipherkey) {
- &logthis("Secure connection initialized: $conserver");
-} else {
- my $st=120+int(rand(240));
- &logthis(
- "<font color=blue>WARNING: ".
- "Could not establish secure connection, $conserver ($st secs)!</font>");
- sleep($st);
- exit;
-}
+&openremote($conserver);
# ----------------------------------------- We're online, send delayed messages
&status("Checking for delayed messages");
@@ -498,7 +431,7 @@
foreach (@allbuffered) {
&status("Sending delayed $conserver $_");
$dfname="$path/$_";
- &logthis($dfname);
+ &logthis('Sending '.$dfname);
my $wcmd;
{
my $dfh=IO::File->new($dfname);
@@ -625,6 +558,8 @@
next unless exists $outbuffer{$client};
$rv = $client->send($outbuffer{$client}, 0);
+
+ unless ($outbuffer{$client}=~/con_lost\n$/) {
unless (defined $rv) {
# Whine, but move on.
&logthis("I was told I could write, but I can't.\n");
@@ -650,7 +585,17 @@
close($client);
next;
}
+ } else {
+# -------------------------------------------------------- Wow, connection lost
+ &logthis(
+ "<font color=red>CRITICAL: Closing connection $conserver</font>");
+ &status("Connection lost $conserver");
+ $remotesock->shutdown(2);
+ &logthis("Attempting to open new connection");
+ &openremote($conserver);
+ }
}
+
}
}
@@ -667,6 +612,15 @@
# ============================================================= Process request
# $request is the text of the request
# put text of reply into $outbuffer{$client}
+# ------------------------------------------------------------ Is this the end?
+ if ($request eq "close_connection_exit\n") {
+ &status("Request close connection: $conserver");
+ &logthis(
+ "<font color=red>CRITICAL: Request Close Connection $conserver</font>");
+ $remotesock->shutdown(2);
+ $server->close();
+ exit;
+ }
# -----------------------------------------------------------------------------
if ($request =~ /^encrypt\:/) {
my $cmd=$request;
@@ -739,6 +693,91 @@
or die "Can't get flags for socket: $!\n";
fcntl($socket, F_SETFL, $flags | O_NONBLOCK)
or die "Can't make socket nonblocking: $!\n";
+}
+
+
+sub openremote {
+# ---------------------------------------------------- Client to network server
+
+ my $conserver=shift;
+
+&status("Opening TCP: $conserver");
+
+unless (
+ $remotesock = IO::Socket::INET->new(PeerAddr => $hostip{$conserver},
+ PeerPort => $perlvar{'londPort'},
+ Proto => "tcp",
+ Type => SOCK_STREAM)
+ ) {
+ my $st=120+int(rand(240));
+ &logthis(
+"<font color=blue>WARNING: Couldn't connect $conserver ($st secs): $@</font>");
+ sleep($st);
+ exit;
+ };
+# ----------------------------------------------------------------- Init dialog
+
+&status("Init dialogue: $conserver");
+
+ $SIG{ALRM}=sub { die "timeout" };
+ $SIG{__DIE__}='DEFAULT';
+ eval {
+ alarm(60);
+print $remotesock "init\n";
+$answer=<$remotesock>;
+print $remotesock "$answer";
+$answer=<$remotesock>;
+chomp($answer);
+ alarm(0);
+ };
+ $SIG{ALRM}='DEFAULT';
+ $SIG{__DIE__}=\&catchexception;
+
+ if ($@=~/timeout/) {
+ &logthis("Timed out during init: $conserver");
+ exit;
+ }
+
+if ($answer ne 'ok') {
+ &logthis("Init reply for $conserver: >$answer<");
+ my $st=120+int(rand(240));
+ &logthis(
+"<font color=blue>WARNING: Init failed $conserver ($st secs)</font>");
+ sleep($st);
+ exit;
+}
+
+sleep 5;
+&status("Ponging $conserver");
+print $remotesock "pong\n";
+$answer=<$remotesock>;
+chomp($answer);
+if ($answer!~/^$converver/) {
+ &logthis("Pong reply for $conserver: >$answer<");
+}
+# ----------------------------------------------------------- Initialize cipher
+
+&status("Initialize cipher: $conserver");
+print $remotesock "ekey\n";
+my $buildkey=<$remotesock>;
+my $key=$conserver.$perlvar{'lonHostID'};
+$key=~tr/a-z/A-Z/;
+$key=~tr/G-P/0-9/;
+$key=~tr/Q-Z/0-9/;
+$key=$key.$buildkey.$key.$buildkey.$key.$buildkey;
+$key=substr($key,0,32);
+my $cipherkey=pack("H32",$key);
+if ($cipher=new IDEA $cipherkey) {
+ &logthis("Secure connection initialized: $conserver");
+} else {
+ my $st=120+int(rand(240));
+ &logthis(
+ "<font color=blue>WARNING: ".
+ "Could not establish secure connection, $conserver ($st secs)!</font>");
+ sleep($st);
+ exit;
+}
+
}
# ----------------------------------- POD (plain old documentation, CPAN style)
--www1014652091--