added rinit command

made MSWindows blocking again
moved sendfile AFTER the login to the channel
added generic $main::is_win flag

diff --git a/Changes b/Changes
index 166b28ea58d6a8bb5d68d2156bcc11b9aa2b4adc..4e5115106695a43593545a44155edeaa0fb003c5 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,6 +1,8 @@
 30Mar01=======================================================================
 1. fix errors on accept in ExtMsg and in Msg
 2. fix the non-blocking problems of connects (and other things in general).
+non-blocking only works for unix implementations at the moment.
+3. add rinit command (sends a PC20)
 29Mar01=======================================================================
 1. add better tracking of AGW circuits (possibly)
 2. add set and unset/agwmonitor (ing) [for all the notice it seems to take]

diff --git a/cmd/init.pl b/cmd/init.pl
index fd3c045b26771e2c4b36155048bc51b49536c1df..b88ed013352bcb4d0c396917332ad09a5a507b58 100644 (file)
--- a/cmd/init.pl
+++ b/cmd/init.pl
@@ -1,5 +1,5 @@
 #
-# reinit a cluster connection
+# init a cluster connection
 #
 # Copyright (c) 1999 Dirk Koopman G1TLH
 #
@@ -27,7 +27,7 @@ foreach $call (@calls) {
                                DXProt::broadcast_ak1a(DXProt::pc21($node->call, 'Gone, re-init') , $dxchan) unless $dxchan->{isolate}; 
                                $node->del();
                        }
-                       $dxchan->send(DXProt::pc38());
+#                      $dxchan->send(DXProt::pc38());
                        $dxchan->send(DXProt::pc18());
                        $dxchan->state('init');
                        push @out, $self->msg('init1', $call);

diff --git a/cmd/rinit.pl b/cmd/rinit.pl
new file mode 100644 (file)
index 0000000..93748ca
--- /dev/null
+++ b/cmd/rinit.pl
@@ -0,0 +1,41 @@
+#
+# reverse init a cluster connection
+#
+# Copyright (c) 1999 Dirk Koopman G1TLH
+#
+# $Id$
+#
+my ($self, $line) = @_;
+my @calls = split /\s+/, $line;
+my $call;
+my @out;
+
+return (1, $self->msg('e5')) if $self->priv < 5;
+
+foreach $call (@calls) {
+       $call = uc $call;
+       next if $call eq $main::mycall;
+       my $dxchan = DXChannel->get($call);
+       if ($dxchan) {
+               if ($dxchan->is_node) {
+                       
+                       # first clear out any nodes on this dxchannel
+                       my @gonenodes = grep { $_->dxchan == $dxchan } DXNode::get_all();
+                       foreach my $node (@gonenodes) {
+                               next if $node->dxchan == $DXProt::me;
+                               next unless $node->dxchan == $dxchan;
+                               DXProt::broadcast_ak1a(DXProt::pc21($node->call, 'Gone, re-init') , $dxchan) unless $dxchan->{isolate}; 
+                               $node->del();
+                       }
+#                      $dxchan->send(DXProt::pc38());
+                       $dxchan->send(DXProt::pc20());
+                       $dxchan->state('init');
+                       push @out, $self->msg('init1', $call);
+               } 
+       } else {
+               push @out, $self->msg('e10', $call);
+       }
+}
+
+return (1, @out);
+

diff --git a/perl/DXCron.pm b/perl/DXCron.pm
index 1c698f751e5b045808c1ead66791125a848924c2..42dbe2a5d6053d951db5cff878df0e8cae8e6652 100644 (file)
--- a/perl/DXCron.pm
+++ b/perl/DXCron.pm
@@ -252,7 +252,7 @@ sub spawn
                        for (@main::listeners) {
                                $_->close_server;
                        }
-                       unless ($^O =~ /^MS/) {
+                       unless ($main::is_win) {
                                $SIG{HUP} = 'IGNORE';
                                $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = $SIG{__WARN__} = 'DEFAULT';
                                alarm(0);

diff --git a/perl/ExtMsg.pm b/perl/ExtMsg.pm
index ae6c8a4c447a8d6bd5d56b528634589593f49b1b..d8e660b8fea045d23d865214b3a1528543291f52 100644 (file)
--- a/perl/ExtMsg.pm
+++ b/perl/ExtMsg.pm
@@ -115,9 +115,8 @@ sub to_connected
        delete $conn->{cmd};
        $conn->{timeout}->del if $conn->{timeout};
        delete $conn->{timeout};
-       $conn->_send_file("$main::data/connected");
-       Msg->sleep(1);
        &{$conn->{rproc}}($conn, "$dir$call|$sort");
+       $conn->_send_file("$main::data/connected");
 }
 
 sub new_client {
@@ -253,7 +252,7 @@ sub _doconnect
                                        *STDOUT = IO::File->new_from_fd($b, 'w') or die;
                                        *STDERR = IO::File->new_from_fd($b, 'w') or die;
                                        close $a;
-                                       unless ($^O =~ /^MS/) {
+                                       unless ($main::is_win) {
 #                                              $SIG{HUP} = 'IGNORE';
                                                $SIG{HUP} = $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = 'DEFAULT';
                                                alarm(0);
@@ -364,6 +363,7 @@ sub _send_file
                if ($f) {
                        while (<$f>) {
                                chomp;
+                               dbg('connll', $_);
                                $conn->send_raw($_ . $conn->{lineend});
                        }
                        $f->close;

diff --git a/perl/Msg.pm b/perl/Msg.pm
index aa5edc48bd4a8ba454005f3ff8c3e5df5f8fc7cf..3b9dbd36f2a4f546f4b25169f1360b0552bed40d 100644 (file)
--- a/perl/Msg.pm
+++ b/perl/Msg.pm
@@ -32,8 +32,9 @@ BEGIN {
     eval {
         require POSIX; POSIX->import(qw(O_NONBLOCK F_SETFL F_GETFL))
     };
-       if ($@) {
+       if ($@ || $main::is_win) {
                print STDERR "POSIX Blocking *** NOT *** supported $@\n";
+               $blocking_supported = 0;
        } else {
                $blocking_supported = 1;
                print STDERR "POSIX Blocking enabled\n";
@@ -195,7 +196,7 @@ sub disconnect {
        $call ||= 'unallocated';
        dbg('connll', "Connection $call disconnected");
        
-       unless ($^O =~ /^MS/i) {
+       unless ($main::is_win) {
                kill 'TERM', $conn->{pid} if exists $conn->{pid};
        }
 

diff --git a/perl/cluster.pl b/perl/cluster.pl
index 4816916c37c85a79f75ce21b582ad36ac567ffa6..291a751d0d166b24cd6c54f4f38fc8593bbb82b2 100755 (executable)
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -79,7 +79,7 @@ package main;
 use strict;
 use vars qw(@inqueue $systime $version $starttime $lockfn @outstanding_connects 
                        $zombies $root @listeners $lang $myalias @debug $userfn $clusteraddr 
-                       $clusterport $mycall $decease $build
+                       $clusterport $mycall $decease $build $is_win
                   );
 
 @inqueue = ();                                 # the main input queue, an array of hashes
@@ -89,6 +89,8 @@ $starttime = 0;                 # the starting time of the cluster
 $lockfn = "cluster.lock";       # lock file name
 #@outstanding_connects = ();     # list of outstanding connects
 @listeners = ();                               # list of listeners
+$is_win = $^O =~ /^MS/ || $^O =~ /^OS-2/; # is it Windows?
+
 
       
 # send a message to call on conn and disconnect
@@ -374,7 +376,7 @@ AGWMsg::init(\&new_channel);
 dbg('err', "load badwords: " . (BadWords::load or "Ok"));
 
 # prime some signals
-unless ($^O =~ /^MS/) {
+unless ($is_win) {
        unless ($DB::VERSION) {
                $SIG{INT} = \&cease;
                $SIG{TERM} = \&cease;