--- loncom/Attic/lonc 2001/11/26 22:20:26 1.18 +++ loncom/Attic/lonc 2001/11/27 19:32:46 1.19 @@ -16,7 +16,7 @@ # 12/05 Scott Harrison # 12/05 Gerd Kortemeyer # 01/10/01 Scott Harrison -# 03/14/01,03/15,06/12,11/26 Gerd Kortemeyer +# 03/14/01,03/15,06/12,11/26,11/27 Gerd Kortemeyer # # based on nonforker from Perl Cookbook # - server who multiplexes without forking @@ -182,10 +182,18 @@ sub subreply { Type => SOCK_STREAM, Timeout => 10) or return "con_lost"; - print $sclient "$cmd\n"; - my $answer=<$sclient>; - chomp($answer); - if (!$answer) { $answer="con_lost"; } + $SIG{ALRM}=sub { die "timeout" }; + $SIG{__DIE__}='DEFAULT'; + eval { + alarm(10); + print $sclient "$cmd\n"; + my $answer=<$sclient>; + chomp($answer); + alarm(0); + }; + if ((!$answer) || ($@=~/timeout/)) { $answer="con_lost"; } + $SIG{ALRM}='DEFAULT'; + $SIG{__DIE__}=\&catchexception; } else { $answer='self_reply'; } return $answer; } @@ -576,11 +584,27 @@ sub handle { } $request="enc:$cmdlength:$encrequest\n"; } +# --------------------------------------------------------------- Main exchange + $SIG{ALRM}=sub { die "timeout" }; + $SIG{__DIE__}='DEFAULT'; + eval { + alarm(300); &status("Sending $conserver: $request"); print $remotesock "$request"; &status("Waiting for reply from $conserver: $request"); $answer=<$remotesock>; &status("Received reply: $request"); + alarm(0); + }; + if ($@=~/timeout/) { + $answer=''; + &logthis( + "CRITICAL: Timeout $conserver: $request"); + } + $SIG{ALRM}='DEFAULT'; + $SIG{__DIE__}=\&catchexception; + + if ($answer) { if ($answer =~ /^enc/) { my ($cmd,$cmdlength,$encinput)=split(/:/,$answer);