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