From: djk Date: Thu, 3 Dec 1998 15:51:30 +0000 (+0000) Subject: added ping and rcmd commands X-Git-Tag: DXSPIDER_1_6 X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=commitdiff_plain;h=8171e6fc724e776db91117e7456447fb48be3209;p=spider.git added ping and rcmd commands fixed a small prob with outgoing connects upissued version no --- diff --git a/cmd/ping.pl b/cmd/ping.pl index e69de29b..bf88cc5b 100644 --- a/cmd/ping.pl +++ b/cmd/ping.pl @@ -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))); + + diff --git a/cmd/rcmd.pl b/cmd/rcmd.pl index e69de29b..caa9fb83 100644 --- a/cmd/rcmd.pl +++ b/cmd/rcmd.pl @@ -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)); diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 58dc3b86..98fa4c61 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -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', ); diff --git a/perl/DXProt.pm b/perl/DXProt.pm index ed5e4171..ec49fedd 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -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__ diff --git a/perl/DXProtout.pm b/perl/DXProtout.pm index fb86ee2e..a5d5250b 100644 --- a/perl/DXProtout.pm +++ b/perl/DXProtout.pm @@ -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; diff --git a/perl/Messages b/perl/Messages index b8039a8f..3709b2dd 100644 --- a/perl/Messages +++ b/perl/Messages @@ -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', diff --git a/perl/client.pl b/perl/client.pl index 9c4fc0f5..b7bb5452 100755 --- a/perl/client.pl +++ b/perl/client.pl @@ -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\""); } diff --git a/perl/cluster.pl b/perl/cluster.pl index c3f264bc..4d6a0e1b 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -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