--- loncom/Attic/lonc 2002/03/08 03:56:19 1.32
+++ loncom/Attic/lonc 2002/03/20 03:42:45 1.33
@@ -5,7 +5,7 @@
# provides persistent TCP connections to the other servers in the network
# through multiplexed domain sockets
#
-# $Id: lonc,v 1.32 2002/03/08 03:56:19 foxr Exp $
+# $Id: lonc,v 1.33 2002/03/20 03:42:45 foxr Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -45,7 +45,7 @@
# 12/20 Scott Harrison
# YEAR=2002
# 2/19/02,02/22/02,02/25/02 Gerd Kortemeyer
-#
+# 3/07/02 Ron Fox
# based on nonforker from Perl Cookbook
# - server who multiplexes without forking
@@ -279,17 +279,8 @@ unlink($port);
}
$cmd="enc:$cmdlength:$encrequest\n";
}
- $SIG{ALRM}=sub { die "timeout" };
- $SIG{__DIE__}='DEFAULT';
- eval {
- alarm(60);
- print $remotesock "$cmd\n";
- $answer=<$remotesock>;
+ $answer = londtransaction($remotesock, $cmd, 60);
chomp($answer);
- alarm(0);
- };
- $SIG{ALRM}='DEFAULT';
- $SIG{__DIE__}=\&catchexception;
if (($answer ne '') && ($@!~/timeout/)) {
unlink("$dfname");
@@ -309,7 +300,7 @@ unless (
my $st=120+int(rand(240));
&logthis(
"WARNING: ".
- "Can't make server socket ($st secs): $@ .. exiting");
+ "Can't make server socket ($st secs): .. exiting");
sleep($st);
exit;
};
@@ -441,6 +432,7 @@ sub handle {
# $request is the text of the request
# put text of reply into $outbuffer{$client}
# ------------------------------------------------------------ Is this the end?
+ chomp($request);
if($DEBUG) {
&logthis(" Request $request processing starts");
}
@@ -464,30 +456,19 @@ sub handle {
$encrequest.=
unpack("H16",$cipher->encrypt(substr($cmd,$encidx,8)));
}
- $request="enc:$cmdlength:$encrequest\n";
+ $request="enc:$cmdlength:$encrequest";
}
# --------------------------------------------------------------- Main exchange
- $SIG{ALRM}=sub { die "timeout" };
- $SIG{__DIE__}='DEFAULT';
- eval {
- alarm(300);
- &status("Sending: $request");
- print $remotesock "$request";
- &status("Waiting for reply from $conserver: $request");
- $answer=<$remotesock>;
- &status("Received reply: $request");
- alarm(0);
- };
- if($DEBUG) {
- &logthis(" Request data exchange complete");
- }
- if ($@=~/timeout/) {
- $answer='';
- &logthis(
- "CRITICAL: Timeout: $request");
- }
- $SIG{ALRM}='DEFAULT';
- $SIG{__DIE__}=\&catchexception;
+ $answer = londtransaction($remotesock, $request, 300);
+
+ if($DEBUG) {
+ &logthis(" Request data exchange complete");
+ }
+ if ($@=~/timeout/) {
+ $answer='';
+ &logthis(
+ "CRITICAL: Timeout: $request");
+ }
if ($answer) {
@@ -503,6 +484,9 @@ sub handle {
$answer=substr($answer,0,$cmdlength);
$answer.="\n";
}
+ if($DEBUG) {
+ &logthis("sending $answer to client\n");
+ }
$outbuffer{$client} .= $answer;
} else {
$outbuffer{$client} .= "con_lost\n";
@@ -552,7 +536,7 @@ unless (
) {
&logthis(
-"WARNING: Couldn't connect to $conserver ($st secs): $@");
+"WARNING: Couldn't connect to $conserver ($st secs): ");
sleep($st);
exit;
};
@@ -561,19 +545,10 @@ unless (
&logthis("INFO Connected to $conserver, initing ");
&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;
+ $answer = londtransaction($remotesock, "init", 60);
+ chomp($answer);
+ $answer = londtransaction($remotesock, $answer, 60);
+ chomp($answer);
if ($@=~/timeout/) {
&logthis("Timed out during init.. exiting");
@@ -632,8 +607,8 @@ sub catchexception {
chomp($signal);
&logthis("CRITICAL: "
."ABNORMAL EXIT. Child $$ for server [$wasserver] died through "
- ."\"$signal\" with parameter [$@]");
- die($@);
+ ."\"$signal\" with parameter ");
+ die("Signal abend");
}
# -------------------------------------- Routines to see if other box available
@@ -736,15 +711,8 @@ sub subreply {
or return "con_lost";
- $SIG{ALRM}=sub { die "timeout" };
- $SIG{__DIE__}='DEFAULT';
- eval {
- alarm(10);
- print $sclient "$cmd\n";
- $answer=<$sclient>;
- chomp($answer);
- alarm(0);
- };
+ $answer = londtransaction($sclient, $cmd, 10);
+
if ((!$answer) || ($@=~/timeout/)) { $answer="con_lost"; }
$SIG{ALRM}='DEFAULT';
$SIG{__DIE__}=\&catchexception;
@@ -764,6 +732,83 @@ sub logthis {
print $fh "$local ($$) [$conserver] [$status]: $message\n";
}
+#-------------------------------------- londtransaction:
+#
+# Performs a transaction with lond with timeout support.
+# result = londtransaction(socket,request,timeout)
+#
+sub londtransaction {
+ my ($socket, $request, $tmo) = @_;
+
+ if($DEBUG) {
+ &logthis("londtransaction request: $request");
+ }
+
+ # Set the signal handlers: ALRM for timeout and disble the others.
+
+ $SIG{ALRM} = sub { die "timeout" };
+ $SIG{__DIE__} = 'DEFAULT';
+
+ # Disable all but alarm so that only that can interupt the
+ # send /receive.
+ #
+ my $sigset = POSIX::SigSet->new(QUIT, USR1, HUP, INT, TERM);
+ my $priorsigs = POSIX::SigSet->new;
+ unless (defined sigprocmask(SIG_BLOCK, $sigset, $priorsigs)) {
+ &logthis(" CRITICAL -- londtransaction ".
+ "failed to block signals ");
+ die "could not block signals in londtransaction";
+ }
+ $answer = '';
+ #
+ # Send request to lond.
+ #
+ eval {
+ alarm($tmo);
+ print $socket "$request\n";
+ alarm(0);
+ };
+ # If request didn't timeout, try for the response.
+ #
+
+ if ($@!~/timeout/) {
+ eval {
+ alarm($tmo);
+ $answer = <$socket>;
+ if($DEBUG) {
+ &logthis("Received $answer in londtransaction");
+ }
+ alarm(0);
+ };
+ } else {
+ if($DEBUG) {
+ &logthis("Timeout on send in londtransaction");
+ }
+ }
+ if( ($@ =~ /timeout/) && ($DEBUG)) {
+ &logthis("Timeout on receive in londtransaction");
+ }
+ #
+ # Restore the initial sigmask set.
+ #
+ unless (defined sigprocmask(SIG_UNBLOCK, $priorsigs)) {
+ &logthis(" CRITICAL -- londtransaction ".
+ "failed to re-enable signal processing. ");
+ die "londtransaction failed to re-enable signals";
+ }
+ #
+ # go back to the prior handler set.
+ #
+ $SIG{ALRM} = 'DEFAULT';
+ $SIG{__DIE__} = \&cathcexception;
+
+ # chomp $answer;
+ if ($DEBUG) {
+ &logthis("Returning $answer in londtransaction");
+ }
+ return $answer;
+
+}
sub logperm {
my $message=shift;
@@ -824,6 +869,11 @@ B forks off children processes tha
in the network. Management of these processes can be done at the
parent process level or the child process level.
+ After forking off the children, B the B
+executes a main loop which simply waits for processes to exit.
+As a process exits, a new process managing a link to the same
+peer as the exiting process is created.
+
B is the location of log messages.
The process management is now explained in terms of linux shell commands,
@@ -899,21 +949,6 @@ Subroutine B:
SIGUSR1 is sent to all the children, and the status of
each connection is logged.
-=item *
-
-SIGCHLD
-
-
-Child signal assignment:
- none
-
-Command-line invocations:
- B B<-s> SIGCHLD I
-
-Subroutine B:
- This is only invoked for the B parent I.
-Information pertaining to the child is removed.
-The socket port is cleaned up.
=back