From 85b6ea316f8da5cb0a9fe716bbb5cd17bd2f5fdb Mon Sep 17 00:00:00 2001 From: minima Date: Fri, 2 Mar 2001 16:48:16 +0000 Subject: [PATCH] new connect code --- cmd/connect.pl | 25 ++++--------------------- cmd/disconnect.pl | 6 ++++++ perl/DXCron.pm | 40 +++++++++++++++++----------------------- perl/DXVars.pm.issue | 2 +- 4 files changed, 28 insertions(+), 45 deletions(-) diff --git a/cmd/connect.pl b/cmd/connect.pl index b3b00181..d80a468b 100644 --- a/cmd/connect.pl +++ b/cmd/connect.pl @@ -11,28 +11,11 @@ return (1, $self->msg('already', $call)) if DXChannel->get($call); return (1, $self->msg('outconn', $call)) if grep {$_->{call} eq $call} @main::outstanding_connects; return (1, $self->msg('conscript', $lccall)) unless -e "$main::root/connect/$lccall"; -my $prog = "$main::root/local/client.pl"; -$prog = "$main::root/perl/client.pl" if ! -e $prog; +my @out; +push @out, $self->msg('constart', $call); +ExtMsg::start_connect($call, "$main::root/connect/$lccall"); +return (1, @out); -my $pid = fork(); -if (defined $pid) { - if (!$pid) { - # in child, unset warnings, disable debugging and general clean up from us - $^W = 0; - $SIG{HUP} = 'IGNORE'; - eval "{ package DB; sub DB {} }"; - alarm(0); - DXChannel::closeall(); - Msg::close_server(); - $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = $SIG{__WARN__} = 'DEFAULT'; - exec $prog, $call, 'connect'; - } else { - sleep(1); # do a coordination - push @main::outstanding_connects, {call => $call, pid => $pid}; - return(1, $self->msg('constart', $call)); - } -} -return (0, $self->msg('confail', $call, $!)) diff --git a/cmd/disconnect.pl b/cmd/disconnect.pl index 61ba3bf4..195cdf8c 100644 --- a/cmd/disconnect.pl +++ b/cmd/disconnect.pl @@ -23,6 +23,12 @@ foreach $call (@calls) { } $dxchan->disconnect; push @out, $self->msg('disc2', $call); + } elsif (my $out = grep {$_->{call} eq $call} @main::outstanding_connects) { + unless ($^O =~ /^MS/i) { + kill 'TERM', $out->{pid}; + } + @main::outstanding_connects = grep {$_->{call} ne $call} @main::outstanding_connects; + push @out, $self->msg('disc2', $call); } else { push @out, $self->msg('e10', $call); } diff --git a/perl/DXCron.pm b/perl/DXCron.pm index 8fb0f466..d3007794 100644 --- a/perl/DXCron.pm +++ b/perl/DXCron.pm @@ -225,6 +225,13 @@ sub disconnect } $dxchan->disconnect; } + my $out = grep {$_->{call} eq $call} @main::outstanding_connects; + if ($out) { + unless ($^O =~ /^MS/i) { + kill 'TERM', $out->{pid}; + } + @main::outstanding_connects = grep {$_->{call} ne $call} @main::outstanding_connects; + } } # start a connect process off @@ -237,29 +244,11 @@ sub start_connect dbg('cron', "Connect not started, outstanding connect to $call"); return; } - - my $prog = "$main::root/local/client.pl"; - $prog = "$main::root/perl/client.pl" if ! -e $prog; - - my $pid = fork(); - if (defined $pid) { - if (!$pid) { - # in child, unset warnings, disable debugging and general clean up from us - $^W = 0; - eval "{ package DB; sub DB {} }"; - $SIG{HUP} = 'IGNORE'; - alarm(0); - DXChannel::closeall(); - $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = $SIG{__WARN__} = 'DEFAULT'; - exec $prog, $call, 'connect' or dbg('cron', "exec '$prog' failed $!"); - } - dbg('cron', "connect to $call started"); + if (-e "$main::root/connect/$lccall") { + ExtMsg::start_connect($call, "$main::root/connect/$lccall"); } else { - dbg('cron', "can't fork for $prog $!"); + dbg('err', "Cannot find connect script for $lccall"); } - - # coordinate - sleep(1); } # spawn any old job off @@ -273,10 +262,15 @@ sub spawn # in child, unset warnings, disable debugging and general clean up from us $^W = 0; eval "{ package DB; sub DB {} }"; - $SIG{HUP} = 'IGNORE'; alarm(0); DXChannel::closeall(); - $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = $SIG{__WARN__} = 'DEFAULT'; + for (@main::listeners) { + $_->close_server; + } + unless ($^O =~ /^MS/) { + $SIG{HUP} = 'IGNORE'; + $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = $SIG{__WARN__} = 'DEFAULT'; + } exec "$line" or dbg('cron', "exec '$line' failed $!"); } dbg('cron', "spawn of $line started"); diff --git a/perl/DXVars.pm.issue b/perl/DXVars.pm.issue index ab43ca64..42feb2ea 100644 --- a/perl/DXVars.pm.issue +++ b/perl/DXVars.pm.issue @@ -87,4 +87,4 @@ $userfn = "$data/users"; $motd = "$data/motd"; # are we debugging ? -@debug = ('chan', 'state', 'msg', 'cron'); +@debug = ('chan', 'state', 'msg', 'cron', 'connect'); -- 2.43.0