added ping and rcmd commands DXSPIDER_1_6
authordjk <djk>
Thu, 3 Dec 1998 15:51:30 +0000 (15:51 +0000)
committerdjk <djk>
Thu, 3 Dec 1998 15:51:30 +0000 (15:51 +0000)
fixed a small prob with outgoing connects
upissued version no

cmd/ping.pl
cmd/rcmd.pl
perl/DXChannel.pm
perl/DXProt.pm
perl/DXProtout.pm
perl/Messages
perl/client.pl
perl/cluster.pl

index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..bf88cc5bdcd50a89ac91e8c814f056c3dc6dd7fa 100644 (file)
@@ -0,0 +1,28 @@
+#
+# ping command
+#
+# Copyright (c) 1998 Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+my $self = shift;
+my $line = uc shift;   # only one callsign allowed 
+my ($call) = $line =~ /^\s*(\S+)/;
+
+# are we permitted?
+return (1, $self->msg('e5')) if $self->priv < 1;
+
+# is there a call?
+return (1, $self->msg('e6')) if !$call;
+
+# can we see it? Is it a node?
+my $noderef = DXCluster->get_exact($call);
+return (1, $self->msg('e7', $call)) if !$noderef || !$noderef->pcversion;
+
+# ping it
+DXProt::addping($self->call, $call);
+
+return (1, $self->msg('pingo', $call, atime($main::systime)));
+
+
index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..caa9fb83ad445c13e770a7ff9b7aa61fcc93dacb 100644 (file)
@@ -0,0 +1,30 @@
+#
+# rcmd command
+#
+# Copyright (c) 1998 Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+my $self = shift;
+my $line = shift; 
+my ($call) = $line =~ /^\s*(\S+)/;
+
+# are we permitted?
+return (1, $self->msg('e5')) if $self->priv < 6;
+
+# is there a call?
+return (1, $self->msg('e6')) if !$call;
+
+# remove the callsign from the line
+$line =~ s/^\s*$call\s+//;
+
+# can we see it? Is it a node?
+$call = uc $call;
+my $noderef = DXCluster->get_exact($call);
+return (1, $self->msg('e7', $call)) if !$noderef || !$noderef->pcversion;
+
+# ping it
+DXProt::addrcmd($self->call, $call, $line);
+
+return (1, $self->msg('rcmdo', $line, $call));
index 58dc3b867741fcf13d5a105a901a4f150936dfde..98fa4c61921568c3b42d3e0702203d6d9da4909a 100644 (file)
@@ -63,9 +63,6 @@ use vars qw(%channels %valid);
   lastread => '9,Last Msg Read',
   outbound => '9,outbound?,yesno',
   remotecmd => '9,doing rcmd,yesno',
-  pc34to => '9,last rcmd call',
-  pc34t => '9,last rcmd time,atime',
-  pings => '9,out/st pings',
   pagelth => '0,Page Length',
   pagedata => '9,Page Data Store',
 );
index ed5e417150724e9c1bb91ce75efeee1a4de2cba8..ec49fedd3e61069b5921ab3b4e26c37603182b91 100644 (file)
@@ -24,13 +24,15 @@ use DXProtout;
 use Carp;
 
 use strict;
-use vars qw($me $pc11_max_age $pc11_dup_age %dup $last_hour);
+use vars qw($me $pc11_max_age $pc11_dup_age %dup $last_hour %pings %rcmds);
 
 $me = undef;                                   # the channel id for this cluster
 $pc11_max_age = 1*3600;                        # the maximum age for an incoming 'real-time' pc11
 $pc11_dup_age = 24*3600;               # the maximum time to keep the dup list for
 %dup = ();                                             # the pc11 and 26 dup hash 
 $last_hour = time;                             # last time I did an hourly periodic update
+%pings = ();                    # outstanding ping requests outbound
+%rcmds = ();                    # outstanding rcmd requests outbound
 
 sub init
 {
@@ -345,12 +347,11 @@ sub normal
                
                if ($pcno == 35) {              # remote command replies
                        if ($field[1] eq $main::mycall) {
-                               my $s = DXChannel::get($main::myalias); 
-                               my @ref = grep { $_->pc34to eq $field[2] } DXChannel::get_all(); # people that have rcmded someone
-                               push @ref, $s if $s;
-                               
-                               foreach (@ref) {
-                                       $_->send($field[3]);
+                               my $s = $rcmds{$field[2]};
+                               if ($s) {
+                                       my $dxchan = DXChannel->get($s->{call});
+                                       $dxchan->send($field[3]) if $dxchan;
+                                       delete $rcmds{$field[2]} if !$dxchan;
                                }
                        } else {
                                route($field[1], $line);
@@ -432,8 +433,18 @@ sub normal
                        # is it for us?
                        if ($field[1] eq $main::mycall) {
                                my $flag = $field[3];
-                               $flag ^= 1;
-                               $self->send($self->pc51($field[2], $field[1], $flag));
+                               if ($flag == 1) {
+                                       $self->send(pc51($field[2], $field[1], '0'));
+                               } else {
+                                       # it's a reply, look in the ping list for this one
+                                       my $ref = $pings{$field[2]};
+                                       if ($ref) {
+                                               my $r = shift @$ref;
+                                               my $dxchan = DXChannel->get($r->{call});
+                                               $dxchan->send($dxchan->msg('pingi', $field[2], atime($main::systime), $main::systime - $r->{t})) if $dxchan;
+                                       }
+                               }
+                               
                        } else {
                                # route down an appropriate thingy
                                route($field[1], $line);
@@ -498,10 +509,11 @@ sub process
 sub finish
 {
        my $self = shift;
-       my $ref = DXCluster->get_exact($self->call);
+       my $call = $self->call;
+       my $ref = DXCluster->get_exact($call);
        
        # unbusy and stop and outgoing mail
-       my $mref = DXMsg::get_busy($self->call);
+       my $mref = DXMsg::get_busy($call);
        $mref->stop_msg($self) if $mref;
        
        # broadcast to all other nodes that all the nodes connected to via me are gone
@@ -509,14 +521,17 @@ sub finish
        my $node;
        
        foreach $node (@gonenodes) {
-               next if $node->call eq $self->call; 
+               next if $node->call eq $call; 
                broadcast_ak1a(pc21($node->call, 'Gone'), $self); # done like this 'cos DXNodes don't have a pc21 method
                $node->del();
        }
+
+       # remove outstanding pings
+       delete $pings{$call};
        
        # now broadcast to all other ak1a nodes that I have gone
-       broadcast_ak1a(pc21($self->call, 'Gone.'), $self);
-       Log('DXProt', $self->call . " Disconnected");
+       broadcast_ak1a(pc21($call, 'Gone.'), $self);
+       Log('DXProt', $call . " Disconnected");
        $ref->del() if $ref;
 }
 
@@ -663,5 +678,30 @@ sub unpad
        $s =~ s/^\s+|\s+$//;
        return $s;
 }
+
+# add a ping request to the ping queues
+sub addping
+{
+       my ($from, $to) = @_;
+       my $ref = $pings{$to};
+       $ref = $pings{$to} = [] if !$ref;
+       my $r = {};
+       $r->{call} = $from;
+       $r->{t} = $main::systime;
+       route($to, pc51($to, $main::mycall, 1));
+       push @$ref, $r;
+}
+
+# add a rcmd request to the rcmd queues
+sub addrcmd
+{
+       my ($from, $to, $cmd) = @_;
+       my $r = {};
+       $r->{call} = $from;
+       $r->{t} = $main::systime;
+       $r->{cmd} = $cmd;
+       route($to, pc34($main::mycall, $to, $cmd));
+       $rcmds{$to} = $r;
+}
 1;
 __END__ 
index fb86ee2e67273d996176fa31b8ae4b4ac54981ad..a5d5250b161014a817ce5d0c334035600018a18b 100644 (file)
@@ -279,7 +279,7 @@ sub pc50
 # generate pings
 sub pc51
 {
-  my ($self, $to, $from, $val) = @_;
+  my ($to, $from, $val) = @_;
   return "PC51^$to^$from^$val^";
 }
 1;
index b8039a8f10dd002ead46ee419b3ea091f1a012e8..3709b2ddcab9cd96477ecc577e9d9fee7622e3ce 100644 (file)
@@ -27,6 +27,8 @@ package DXM;
                                e3 => '$_[0]: $_[1] not found',
                                e4 => 'Need at least a prefix or callsign',
                                e5 => 'Not Allowed',
+                               e6 => 'Need a callsign',
+                               e7 => 'callsign $_[0] not visible on the cluster',
                                email => 'E-mail address set to: $_[0]',
                                heres => 'Here set on $_[0]',
                                hereu => 'Here unset on $_[0]',
@@ -40,9 +42,12 @@ package DXM;
                                nodee1 => 'You cannot use this command whilst your target ($_[0]) is on-line',
                                ok => 'Operation successful',
                                page => 'Press Enter to continue, A to abort ($_[0] lines) >',
+                               pingo => 'Ping Started to $_[0]',
+                               pingi => 'Ping Returned from $_[0] ($_[2] secs)',
                                pr => '$_[0] de $main::mycall $main::cldate $main::ztime >',
                                priv => 'Privilege level changed on $_[0]',
                                prx => '$main::mycall >',
+                               rcmdo => 'RCMD \"$_[0]\" sent to $_[1]',
                                read1 => 'Sorry, no new messages for you',
                                read2 => 'Msg $_[0] not found',
                                read3 => 'Msg $_[0] not available',
index 9c4fc0f5088a9b39d76cfe51592a295d5701ccc9..b7bb5452f684becf01bc12273b1e89d37dd0ccef 100755 (executable)
@@ -221,7 +221,7 @@ sub dochat
        dbg('connect', "CHAT \"$expect\" -> \"$send\"");
     my $line;
        
-       #       alarm($timeout);
+       alarm($timeout);
        
     if ($expect) {
                if ($csort eq 'telnet') {
@@ -243,7 +243,7 @@ sub dochat
                        $sock->print("$send\n");
                } elsif ($csort eq 'ax25') {
                        local $\ = "\r";
-                       $wfh->print("$send\r");
+                       $wfh->print("$send");
                }
                dbg('connect', "sent \"$send\"");
        }
index c3f264bc7d76b456491b21288fddce812693cce8..4d6a0e1b9a22f3e481643f8a069620161af67634 100755 (executable)
@@ -48,7 +48,7 @@ package main;
 
 @inqueue = ();                                 # the main input queue, an array of hashes
 $systime = 0;                                  # the time now (in seconds)
-$version = 1.5;                                        # the version no of the software
+$version = 1.6;                                        # the version no of the software
 $starttime = 0;                 # the starting time of the cluster   
  
 # handle disconnections