version 1.18, 2001/11/26 22:20:26
|
version 1.21, 2001/11/28 21:19:58
|
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,11/28 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"; |
|
my $answer=<$sclient>; |
|
chomp($answer); |
$SIG{ALRM}=sub { die "timeout" }; |
if (!$answer) { $answer="con_lost"; } |
$SIG{__DIE__}='DEFAULT'; |
|
eval { |
|
alarm(10); |
|
print $sclient "$cmd\n"; |
|
$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 344 unless (
|
Line 354 unless (
|
sleep($st); |
sleep($st); |
exit; |
exit; |
}; |
}; |
# --------------------------------------- Send a ping to make other end do USR1 |
# ----------------------------------------------------------------- Init dialog |
|
|
&status("Init dialogue: $conserver"); |
&status("Init dialogue: $conserver"); |
|
|
|
$SIG{ALRM}=sub { die "timeout" }; |
|
$SIG{__DIE__}='DEFAULT'; |
|
eval { |
|
alarm(60); |
print $remotesock "init\n"; |
print $remotesock "init\n"; |
$answer=<$remotesock>; |
$answer=<$remotesock>; |
print $remotesock "$answer"; |
print $remotesock "$answer"; |
$answer=<$remotesock>; |
$answer=<$remotesock>; |
chomp($answer); |
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<"); |
&logthis("Init reply for $conserver: >$answer<"); |
if ($answer ne 'ok') { |
if ($answer ne 'ok') { |
my $st=120+int(rand(240)); |
my $st=120+int(rand(240)); |
Line 422 if ($cipher=new IDEA $cipherkey) {
|
Line 447 if ($cipher=new IDEA $cipherkey) {
|
} |
} |
$cmd="enc:$cmdlength:$encrequest\n"; |
$cmd="enc:$cmdlength:$encrequest\n"; |
} |
} |
|
$SIG{ALRM}=sub { die "timeout" }; |
|
$SIG{__DIE__}='DEFAULT'; |
|
eval { |
|
alarm(60); |
print $remotesock "$cmd\n"; |
print $remotesock "$cmd\n"; |
$answer=<$remotesock>; |
$answer=<$remotesock>; |
chomp($answer); |
chomp($answer); |
if ($answer ne '') { |
alarm(0); |
|
}; |
|
$SIG{ALRM}='DEFAULT'; |
|
$SIG{__DIE__}=\&catchexception; |
|
|
|
if (($answer ne '') && ($@!~/timeout/)) { |
unlink("$dfname"); |
unlink("$dfname"); |
&logthis("Delayed $cmd to $conserver: >$answer<"); |
&logthis("Delayed $cmd to $conserver: >$answer<"); |
&logperm("S:$conserver:$bcmd"); |
&logperm("S:$conserver:$bcmd"); |
Line 576 sub handle {
|
Line 609 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); |