From: djk Date: Mon, 21 Sep 1998 22:36:04 +0000 (+0000) Subject: got routing essentially working X-Git-Tag: SPIDER_1_5~38 X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=2546ef0cfaaca39e65985e414258071a636979af;p=spider.git got routing essentially working got inter cluster linking working added talk, sh/c and sh/u commands changed sh/channel and sh/user to stat/channel and stat/user PC41 data and users should now be being stored --- diff --git a/cmd/disconnect.pl b/cmd/disconnect.pl new file mode 100644 index 00000000..bc357047 --- /dev/null +++ b/cmd/disconnect.pl @@ -0,0 +1,24 @@ +# +# 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); diff --git a/cmd/help.pl b/cmd/help.pl index 1c1fae28..60eef059 100644 --- a/cmd/help.pl +++ b/cmd/help.pl @@ -11,3 +11,9 @@ # # $Id$ # + +my ($self, $line) = @_; +my @out; + + + diff --git a/cmd/show/ann.pl b/cmd/show/ann.pl deleted file mode 100644 index e69de29b..00000000 diff --git a/cmd/show/announce.pl b/cmd/show/announce.pl new file mode 100644 index 00000000..e69de29b diff --git a/cmd/show/channel.pl b/cmd/show/channel.pl deleted file mode 100644 index 147c150a..00000000 --- a/cmd/show/channel.pl +++ /dev/null @@ -1,27 +0,0 @@ -# -# 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); - - diff --git a/cmd/show/conf.pl b/cmd/show/conf.pl deleted file mode 100644 index e69de29b..00000000 diff --git a/cmd/show/configuration.pl b/cmd/show/configuration.pl new file mode 100644 index 00000000..62beea66 --- /dev/null +++ b/cmd/show/configuration.pl @@ -0,0 +1,43 @@ +# +# 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); diff --git a/cmd/show/dx.pl b/cmd/show/dx.pl index e3d3aed2..74b4c0a9 100644 --- a/cmd/show/dx.pl +++ b/cmd/show/dx.pl @@ -79,7 +79,7 @@ if (@freq) { $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; diff --git a/cmd/show/dxcc.pl b/cmd/show/dxcc.pl index b95bb7fe..615aac04 100644 --- a/cmd/show/dxcc.pl +++ b/cmd/show/dxcc.pl @@ -75,7 +75,7 @@ if (@ans) { # we have a valid prefix! $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; diff --git a/cmd/show/user.pl b/cmd/show/user.pl deleted file mode 100644 index 997ae542..00000000 --- a/cmd/show/user.pl +++ /dev/null @@ -1,24 +0,0 @@ -# -# 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); diff --git a/cmd/show/users.pl b/cmd/show/users.pl index 2e69786b..8cbe8577 100644 --- a/cmd/show/users.pl +++ b/cmd/show/users.pl @@ -1,15 +1,38 @@ # -# 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); + diff --git a/cmd/show/version.pl b/cmd/show/version.pl index e69de29b..2bf3a7fe 100644 --- a/cmd/show/version.pl +++ b/cmd/show/version.pl @@ -0,0 +1,15 @@ +# +# 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); diff --git a/cmd/stat/channel.pl b/cmd/stat/channel.pl new file mode 100644 index 00000000..147c150a --- /dev/null +++ b/cmd/stat/channel.pl @@ -0,0 +1,27 @@ +# +# 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); + + diff --git a/cmd/stat/user.pl b/cmd/stat/user.pl new file mode 100644 index 00000000..997ae542 --- /dev/null +++ b/cmd/stat/user.pl @@ -0,0 +1,24 @@ +# +# 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); diff --git a/cmd/talk.pl b/cmd/talk.pl index e69de29b..5b8cdaee 100644 --- a/cmd/talk.pl +++ b/cmd/talk.pl @@ -0,0 +1,34 @@ +# +# 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, ()); + diff --git a/data/rsgb.cty b/data/rsgb.cty index 2e737a93..0313c050 100644 --- a/data/rsgb.cty +++ b/data/rsgb.cty @@ -319,7 +319,7 @@ Afghanistan: AS: 40: 21: YA: T6=YA; 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; diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 7d835171..970832d5 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -189,6 +189,18 @@ sub state 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 # diff --git a/perl/DXCluster.pm b/perl/DXCluster.pm index 2ddd2358..4e94f4af 100644 --- a/perl/DXCluster.pm +++ b/perl/DXCluster.pm @@ -122,7 +122,9 @@ package DXNodeuser; use DXDebug; use strict; -my $users = 0; +use vars qw($users); + +$users = 0; sub new { @@ -168,13 +170,15 @@ package DXNode; 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"); diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 18dbf2ac..928981ab 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -352,10 +352,10 @@ sub eval_file { 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 diff --git a/perl/DXProt.pm b/perl/DXProt.pm index d75dd46c..3a26ca77 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -167,6 +167,12 @@ sub normal $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; } @@ -179,12 +185,7 @@ sub normal 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; } @@ -209,13 +210,7 @@ sub normal } 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; } @@ -228,7 +223,13 @@ sub normal 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;} @@ -243,9 +244,36 @@ sub normal 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;} @@ -284,11 +312,8 @@ sub normal # 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 @@ -333,6 +358,25 @@ sub finish # 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 # @@ -343,8 +387,17 @@ sub route 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 + } } } @@ -357,7 +410,8 @@ sub broadcast_ak1a 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 } } @@ -370,7 +424,8 @@ sub broadcast_users 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 } } diff --git a/perl/DXProtout.pm b/perl/DXProtout.pm index 9fb0b711..0be5330d 100644 --- a/perl/DXProtout.pm +++ b/perl/DXProtout.pm @@ -28,10 +28,10 @@ sub pc10 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(...) @@ -106,12 +106,14 @@ sub pc19 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; @@ -157,7 +159,8 @@ sub pc38 # 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^"; } diff --git a/perl/DXVars.pm b/perl/DXVars.pm index 8cc17e6c..b46d2e3e 100644 --- a/perl/DXVars.pm +++ b/perl/DXVars.pm @@ -15,7 +15,7 @@ require Exporter; @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 ); @@ -66,9 +66,6 @@ $no = 'No'; # 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"; diff --git a/perl/cluster.pl b/perl/cluster.pl index e3309a15..36b3c8bb 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -12,8 +12,12 @@ # 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; @@ -33,18 +37,14 @@ package main; @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 @@ -186,7 +186,7 @@ $SIG{'HUP'} = 'IGNORE'; 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";