+#
+# 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)));
+
+
+#
+# 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));
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',
);
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
{
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);
# 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);
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
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;
}
$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__
# generate pings
sub pc51
{
- my ($self, $to, $from, $val) = @_;
+ my ($to, $from, $val) = @_;
return "PC51^$to^$from^$val^";
}
1;
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]',
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',
dbg('connect', "CHAT \"$expect\" -> \"$send\"");
my $line;
- # alarm($timeout);
+ alarm($timeout);
if ($expect) {
if ($csort eq 'telnet') {
$sock->print("$send\n");
} elsif ($csort eq 'ax25') {
local $\ = "\r";
- $wfh->print("$send\r");
+ $wfh->print("$send");
}
dbg('connect', "sent \"$send\"");
}
@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