new connect code

diff --git a/cmd/connect.pl b/cmd/connect.pl
index b3b001819b5067fe49bd0fceeff728f36f7f6cba..d80a468b97c84c929d4d81ec0ebdb2959e031e06 100644 (file)
--- 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 61ba3bf49ed59f22eacdf5f3cd33584cf11c7fc9..195cdf8c2ae043b9efdf7cb9391a8dc634d5b113 100644 (file)
--- 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 8fb0f4664489609be8a6f3f56c584d6b6956d1fd..d300779456931861463060bf80ed80779cb5bc58 100644 (file)
--- 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 ab43ca6489195ae63c7f3f8f87de45f3b4ff8cb8..42feb2ead469a3f9c343a87b661ca742b51d0027 100644 (file)
--- 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');