--- /dev/null
+#
+# disconnect a local user
+#
+my ($self, $line) = @_;
+my @calls = split /\s+/, $line;
+my $call;
+my @out;
+
+if ($self->priv < 9) {
+ return (1, "not allowed");
+}
+
+foreach $call (@calls) {
+ $call = uc $call;
+ my $dxchan = DXChannel->get($call);
+ if ($dxchan) {
+ $dxchan->disconnect;
+ push @out, "disconnected $call";
+ } else {
+ push @out, "$call not connected locally";
+ }
+}
+
+return (1, @out);
#
# $Id$
#
+
+my ($self, $line) = @_;
+my @out;
+
+
+
+++ /dev/null
-#
-# show the channel status
-#
-# $Id$
-#
-
-use strict;
-my ($self, $line) = @_;
-my @list = split /\s+/, $line; # generate a list of callsigns
-@list = ($self->call) if !@list || $self->priv < 9; # my channel if no callsigns
-
-my $call;
-my @out;
-foreach $call (@list) {
- $call = uc $call;
- my $ref = DXChannel->get($call);
- if ($ref) {
- @out = print_all_fields($self, $ref, "Channe Information $call");
- } else {
- return (0, "Channel: $call not found") if !$ref;
- }
- push @out, "" if @list > 1;
-}
-
-return (1, @out);
-
-
--- /dev/null
+#
+# show the cluster routing tables to the user
+#
+# Copyright (c) 1998 Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+my ($self, $line) = @_;
+my @list = map { uc } split /\s+/, $line; # list of callsigns of nodes
+my @out;
+my @nodes = (DXNode::get_all());
+my $node;
+
+push @out, "Node Callsigns";
+foreach $node (@nodes) {
+ if (@list) {
+ next if !grep $node->call eq $_, @list;
+ }
+ my $i = 0;
+ my @l;
+ my $call = $node->call;
+ $call = "($call)" if $node->here == 0;
+ push @l, $call;
+ my $nlist = $node->list;
+ my @val = values %{$nlist};
+ foreach $call (@val) {
+ if ($i >= 5) {
+ push @out, sprintf "%-12s %-12s %-12s %-12s %-12s %-12s", @l;
+ @l = ();
+ push @l, "";
+ $i = 0;
+ }
+ my $s = $call->{call};
+ $s = sprintf "(%s)", $s if $call->{here} == 0;
+ push @l, $s;
+ $i++;
+ }
+ push @out, sprintf "%-12s %-12s %-12s %-12s %-12s %-12s", @l;
+}
+
+
+return (1, @out);
$expr .= ($expr) ? " && (" : "(";
my $i;
for ($i; $i < @freq; $i += 2) {
- $expr .= "(\$f0 >= $freq[0] && \$f0 <= $freq[1]) ||";
+ $expr .= "(\$f0 >= $freq[$i] && \$f0 <= $freq[$i+1]) ||";
}
chop $expr;
chop $expr;
$expr .= " && (";
my $i;
for ($i; $i < @freq; $i += 2) {
- $expr .= "(\$f0 >= $freq[0] && \$f0 <= $freq[1]) ||";
+ $expr .= "(\$f0 >= $freq[$i] && \$f0 <= $freq[$i+1]) ||";
}
chop $expr;
chop $expr;
+++ /dev/null
-#
-# show either the current user or a nominated set
-#
-# $Id$
-#
-
-my ($self, $line) = @_;
-my @list = split /\s+/, $line; # generate a list of callsigns
-@list = ($self->call) if !@list; # my channel if no callsigns
-
-my $call;
-my @out;
-foreach $call (@list) {
- $call = uc $call;
- my $ref = DXUser->get_current($call);
- if ($ref) {
- @out = print_all_fields($self, $ref, "User Information $call");
- } else {
- push @out, "User: $call not found";
- }
- push @out, "" if @list > 1;
-}
-
-return (1, @out);
#
-# show either the current user or a nominated set
+# show the users on this cluster from the routing tables
+#
+# Copyright (c) 1998 Dirk Koopman G1TLH
#
# $Id$
#
my ($self, $line) = @_;
-my @list = DXChannel->get_all();
-my $chan;
+my @list = map { uc } split /\s+/, $line; # list of callsigns of nodes
my @out;
-foreach $chan (@list) {
- push @out, "Callsign: $chan->{call}";
+my $node = (DXNode->get($main::mycall));
+
+push @out, "Callsigns connected to $main::mycall";
+my $call;
+my $i = 0;
+my @l;
+my $nlist = $node->list;
+my @val = values %{$nlist};
+foreach $call (@val) {
+ if (@list) {
+ next if !grep $call->call eq $_, @list;
+ }
+ if ($i >= 5) {
+ push @out, sprintf "%-12s %-12s %-12s %-12s %-12s %-12s", @l;
+ @l = ();
+ $i = 0;
+ }
+ my $s = $call->{call};
+ $s = sprintf "(%s)", $s if $call->{here} == 0;
+ push @l, $s;
+ $i++;
}
+push @out, sprintf "%-12s %-12s %-12s %-12s %-12s %-12s", @l;
+
return (1, @out);
+
+#
+# show the version number of the software + copyright info
+#
+# Copyright (c) 1998 Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+my @out;
+
+push @out, "DX Spider Cluster version $main::version";
+push @out, "written in perl for unix";
+push @out, "Copyright (c) 1998 Dirk Koopman G1TLH";
+
+return (1, @out);
--- /dev/null
+#
+# show the channel status
+#
+# $Id$
+#
+
+use strict;
+my ($self, $line) = @_;
+my @list = split /\s+/, $line; # generate a list of callsigns
+@list = ($self->call) if !@list || $self->priv < 9; # my channel if no callsigns
+
+my $call;
+my @out;
+foreach $call (@list) {
+ $call = uc $call;
+ my $ref = DXChannel->get($call);
+ if ($ref) {
+ @out = print_all_fields($self, $ref, "Channe Information $call");
+ } else {
+ return (0, "Channel: $call not found") if !$ref;
+ }
+ push @out, "" if @list > 1;
+}
+
+return (1, @out);
+
+
--- /dev/null
+#
+# show either the current user or a nominated set
+#
+# $Id$
+#
+
+my ($self, $line) = @_;
+my @list = split /\s+/, $line; # generate a list of callsigns
+@list = ($self->call) if !@list; # my channel if no callsigns
+
+my $call;
+my @out;
+foreach $call (@list) {
+ $call = uc $call;
+ my $ref = DXUser->get_current($call);
+ if ($ref) {
+ @out = print_all_fields($self, $ref, "User Information $call");
+ } else {
+ push @out, "User: $call not found";
+ }
+ push @out, "" if @list > 1;
+}
+
+return (1, @out);
+#
+# The talk command
+#
+# $Id$
+#
+
+my ($self, $line) = @_;
+my @argv = split /\s+/, $line; # generate an argv
+my $to = uc $argv[0];
+my $via;
+my $from = $self->call();
+
+if ($argv[1] eq '>') {
+ $via = uc $argv[2];
+# print "argv[0] $argv[0] argv[2] $argv[2]\n";
+ $line =~ s/^$argv[0]\s+>\s+$argv[2]\s*//o;
+} else {
+# print "argv[0] $argv[0]\n";
+ $line =~ s/^$argv[0]\s*//o;
+}
+
+#print "to=$to via=$via line=$line\n";
+my $dxchan = DXCommandmode->get($to); # is it for us?
+if ($dxchan && $dxchan->is_user) {
+ $dxchan->send("$to de $from $line");
+} else {
+ my $prot = DXProt::pc10($self, $to, $via, $line);
+# print "prot=$prot\n";
+
+ DXProt::route($via?$via:$to, $prot);
+}
+
+return (1, ());
+
Indonesia: OC: 54: 28: YB: 7A=7B=7C=7D=7E=7F=7G=7H=7I=8A=8B=8C=8D=8E=8F=8G=8H=8I=JZ=PK=PL=PM=PN=PO=YB=YC=YD=YE=YF=YG=YH;
Iraq: AS: 39: 21: YI: HN=YI;
Vanuatu: OC: 56: 32: YJ: YJ;
-Syria: AS: 39: 20: YK: 4U=6C=YK;
+Syria: AS: 39: 20: YK: 6C=YK;
Latvia: EU: 29: 15: YL: YL;
Nicaragua: NA: 11: 07: YN: H6=H7=HT=YN;
Romania: EU: 28: 20: YO: YO=YP=YQ=YR;
dbg('state', "$self->{call} channel state $self->{oldstate} -> $self->{state}\n");
}
+# disconnect this channel
+sub disconnect
+{
+ my $self = shift;
+ my $user = $self->{user};
+ my $conn = $self->{conn};
+ $self->finish();
+ $user->close() if defined $user;
+ $conn->disconnect() if defined $conn;
+ $self->del();
+}
+
# various access routines
#
use DXDebug;
use strict;
-my $users = 0;
+use vars qw($users);
+
+$users = 0;
sub new
{
use DXDebug;
use strict;
-my $nodes = 0;
+use vars qw($nodes);
+
+$nodes = 0;
sub new
{
my ($pkg, $dxchan, $call, $confmode, $here, $pcversion) = @_;
my $self = $pkg->alloc($dxchan, $call, $confmode, $here);
- $self->{version} = $pcversion;
+ $self->{pcversion} = $pcversion;
$self->{list} = { } ;
$nodes++;
dbg('cluster', "allocating node $call to cluster\n");
my @r;
my $c = qq{ \@r = \$self->$package(\@_); };
dbg('eval', "cluster cmd = $c\n");
- eval $c; ;
+ eval $c;
if ($@) {
delete_package($package);
- return (0, "Syserr: Eval err $@ on cached $package");
+ return (1, "Syserr: Eval err $@ on cached $package");
}
#take a look if you want
$confmode = $confmode eq '*';
DXNodeuser->new($self, $node, $call, $confmode, $here);
+
+ # add this station to the user database, if required
+ my $user = DXUser->get_current($call);
+ $user = DXUser->new($call) if !$user;
+ $user->node($node->call) if !$user->node;
+ $user->put;
}
last SWITCH;
}
if ($pcno == 18) { # link request
- # send our nodes
- my $hops = get_hops(19);
- $self->send($me->pc19(get_all_ak1a()));
-
- # get all the local users and send them out
- $self->send($me->pc16(get_all_users()));
+ $self->send_local_config();
$self->send(pc20());
last SWITCH;
}
}
if ($pcno == 20) { # send local configuration
-
- # send our nodes
- my $hops = get_hops(19);
- $self->send($me->pc19(get_all_ak1a()));
-
- # get all the local users and send them out
- $self->send($me->pc16(get_all_users()));
+ $self->send_local_config();
$self->send(pc22());
return;
}
if ($pcno == 22) {last SWITCH;}
if ($pcno == 23) {last SWITCH;}
- if ($pcno == 24) {last SWITCH;}
+
+ if ($pcno == 24) { # set here status
+ my $user = DXCluster->get($field[1]);
+ $user->here($field[2]);
+ last SWITCH;
+ }
+
if ($pcno == 25) {last SWITCH;}
if ($pcno == 26) {last SWITCH;}
if ($pcno == 27) {last SWITCH;}
if ($pcno == 36) {last SWITCH;}
if ($pcno == 37) {last SWITCH;}
if ($pcno == 38) {last SWITCH;}
- if ($pcno == 39) {last SWITCH;}
+
+ if ($pcno == 39) { # incoming disconnect
+ $self->disconnect();
+ return;
+ }
+
if ($pcno == 40) {last SWITCH;}
- if ($pcno == 41) {last SWITCH;}
+ if ($pcno == 41) { # user info
+ # add this station to the user database, if required
+ my $user = DXUser->get_current($field[1]);
+ $user = DXUser->new($field[1]) if !$user;
+
+ if ($field[2] == 1) {
+ $user->name($field[3]);
+ } elsif ($field[2] == 2) {
+ $user->qth($field[3]);
+ } elsif ($field[2] == 3) {
+ my ($latd, $latm, $latl, $longd, $longm, $longl) = split /\s+/, $field[3];
+ $longd += ($longm/60);
+ $longd = 0-$longd if (uc $longl) eq 'W';
+ $user->long($longd);
+ $latd += ($latm/60);
+ $latd = 0-$latd if (uc $latl) eq 'S';
+ $user->lat($latd);
+ } elsif ($field[2] == 4) {
+ $user->node($field[3]);
+ }
+ $user->put;
+ last SWITCH;
+ }
if ($pcno == 42) {last SWITCH;}
if ($pcno == 43) {last SWITCH;}
if ($pcno == 44) {last SWITCH;}
# REBROADCAST!!!!
#
- my $hopfield = pop @field;
- push @field, $hopfield;
-
my $hops;
- if (($hops) = $hopfield =~ /H(\d+)\^\~?$/o) {
+ if (($hops) = $line =~ /H(\d+)\^\~?$/o) {
my $newhops = $hops - 1;
if ($newhops > 0) {
$line =~ s/\^H$hops(\^\~?)$/\^H$newhops$1/; # change the hop count
# some active measures
#
+sub send_local_config
+{
+ my $self = shift;
+ my $n;
+
+ # send our nodes
+ my @nodes = DXNode::get_all();
+
+ # create a list of all the nodes that are not connected to this connection
+ @nodes = map { $_->dxchan != $self ? $_ : () } @nodes;
+ $self->send($me->pc19(@nodes));
+
+ # get all the users connected on the above nodes and send them out
+ foreach $n (@nodes) {
+ my @users = values %{$n->list};
+ $self->send(DXProt::pc16($n, @users));
+ }
+}
+
#
# route a message down an appropriate interface for a callsign
#
my ($call, $line) = @_;
my $cl = DXCluster->get($call);
if ($cl) {
- my $dxchan = $cl->{dxchan};
- $cl->send($line) if $dxchan;
+ my $hops;
+ my $dxchan = $cl->{dxchan};
+ if (($hops) = $line =~ /H(\d+)\^\~?$/o) {
+ my $newhops = $hops - 1;
+ if ($newhops > 0) {
+ $line =~ s/\^H$hops(\^\~?)$/\^H$newhops$1/; # change the hop count
+ $dxchan->send($line) if $dxchan;
+ }
+ } else {
+ $dxchan->send($line) if $dxchan; # for them wot don't have Hops
+ }
}
}
my $chan;
foreach $chan (@chan) {
- $chan->send($s) if !grep $chan, @except; # send it if it isn't the except list
+ next if grep $chan == $_, @except;
+ $chan->send($s); # send it if it isn't the except list
}
}
my $chan;
foreach $chan (@chan) {
- $chan->send($s) if !grep $chan, @except; # send it if it isn't the except list
+ next if grep $chan == $_, @except;
+ $chan->send($s); # send it if it isn't the except list
}
}
my ($self, $to, $via, $text) = @_;
my $user2 = $via ? $to : ' ';
my $user1 = $via ? $via : $to;
- my $mycall = $self->call;
+ my $from = $self->call();
$text = unpad($text);
$text = ' ' if !$text;
- return "PC10^$mycall^$user1^$text^*^$user2^$main::mycall^~";
+ return "PC10^$from^$user1^$text^*^$user2^$main::mycall^~";
}
# create a dx message (called $self->pc11(...)
my @out;
while (@_) {
- my $str = "PC19^$self->{call}";
+ my $str = "PC19";
my $i;
for ($i = 0; @_ && $i < $DXProt::pc19_max_nodes; $i++) {
my $ref = shift;
- $str .= "^$ref->{here}^$ref->{call}^$ref->{confmode}^$ref->{pcversion}";
+ my $here = $ref->{here} ? '1' : '0';
+ my $confmode = $ref->{confmode} ? '1' : '0';
+ $str .= "^$here^$ref->{call}^$confmode^$ref->{pcversion}";
}
$str .= sprintf "^%s^", get_hops(19);
push @out, $str;
# periodic update of users, plus keep link alive device (always H99)
sub pc50
{
- my $n = DXNodeuser->count;
+ my $me = DXCluster->get($main::mycall);
+ my $n = $me->users ? $me->users : '0';
return "PC50^$main::mycall^$n^H99^";
}
@EXPORT_OK = qw($mycall $myname $myalias $mylatitude $mylongtitude $mylocator
$myqth $myemail $myprot_version
$clusterport $clusteraddr $debugfn
- $def_hopcount $root $data $system $cmd
+ $def_hopcount $data $system $cmd
$userfn $motd $local_cmd $mybbsaddr
$pc50_interval, $user_interval
);
# the interval between unsolicited prompts if not traffic
$user_interval = 11*60;
-# root of directory tree for this system
-$root = "/spider";
-
# data files live in
$data = "$root/data";
# make sure that modules are searched in the order local then perl
BEGIN {
- unshift @INC, '/spider/perl'; # this IS the right way round!
- unshift @INC, '/spider/local';
+ # root of directory tree for this system
+ $root = "/spider";
+ $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
+
+ unshift @INC, '$root/perl'; # this IS the right way round!
+ unshift @INC, '$root/local';
}
use Msg;
@inqueue = (); # the main input queue, an array of hashes
$systime = 0; # the time now (in seconds)
+$version = 1.1; # the version no of the software
# handle disconnections
sub disconnect
{
my $dxchan = shift;
return if !defined $dxchan;
- my $user = $dxchan->{user};
- my $conn = $dxchan->{conn};
- $dxchan->finish();
- $user->close() if defined $user;
- $conn->disconnect() if defined $conn;
- $dxchan->del();
+ $dxchan->disconnect();
}
# handle incoming messages
DXProt->init();
# put in a DXCluster node for us here so we can add users and take them away
-DXNode->new(0, $mycall, 0, 1, $DXProtvars::myprot_version);
+DXNode->new(0, $mycall, 0, 1, $DXProt::myprot_version);
# this, such as it is, is the main loop!
print "orft we jolly well go ...\n";