From 0824a94355e5fb2b4c379bb013d66466725629f5 Mon Sep 17 00:00:00 2001 From: djk Date: Mon, 28 Sep 1998 15:32:01 +0000 Subject: [PATCH] added announce added wx added set/here added unset/here added dx commands --- cmd/announce.pl | 45 +++++++++++++++++++++++++++++++ cmd/disconnect.pl | 6 ++++- cmd/dx.pl | 63 +++++++++++++++++++++++++++++++++++++++++++ cmd/set/here.pl | 8 +++--- cmd/talk.pl | 12 ++++----- cmd/unset/here.pl | 7 ++--- cmd/wx.pl | 46 +++++++++++++++++++++++++++++++ perl/Bands.pm | 2 +- perl/DXCluster.pm | 5 +++- perl/DXCommandmode.pm | 2 +- perl/DXProt.pm | 63 +++++++++++++++++++++++++++++++++++-------- perl/DXProtout.pm | 28 ++++++++++++++++--- perl/DXUser.pm | 26 +++++++++++++++--- 13 files changed, 278 insertions(+), 35 deletions(-) create mode 100644 cmd/wx.pl diff --git a/cmd/announce.pl b/cmd/announce.pl index e69de29b..cb2e325d 100644 --- a/cmd/announce.pl +++ b/cmd/announce.pl @@ -0,0 +1,45 @@ +# +# do an announce message +# +# handles announce +# announce full +# announce sysop +# +# at the moment these keywords are fixed, but I dare say a file containing valid ones +# will appear +# +# Copyright (c) 1998 Dirk Koopman G1TLH +# +# $Id$ +# + +my ($self, $line) = @_; +my @f = split /\s+/, $line; +my $sort = uc $f[0]; +my @locals = DXCommandmode->get_all(); +my $to; +my $from = $self->call; +my $t = ztime(time); +my $tonode; +my $sysopflag; + +if ($sort eq "FULL") { + $line =~ s/^$f[0]\s+//; # remove it + $to = "ALL"; +} elsif ($sort eq "SYSOP") { + $line =~ s/^$f[0]\s+//; # remove it + @locals = map { $_->priv >= 5 ? $_ : () } @locals; + $to = "SYSOP"; + $sysopflag = '*'; +} else { + $to = "LOCAL"; +} + +DXProt::broadcast_list("To $to de $from <$t>: $line", @locals); +if ($to ne "LOCAL") { + $line =~ s/\^//og; # remove ^ characters! + my $pc = DXProt::pc12($self, $line, $tonode, $sysopflag, 0); + DXProt::broadcast_ak1a($pc); +} + +return (1, ()); diff --git a/cmd/disconnect.pl b/cmd/disconnect.pl index bc357047..6154d3cc 100644 --- a/cmd/disconnect.pl +++ b/cmd/disconnect.pl @@ -14,7 +14,11 @@ foreach $call (@calls) { $call = uc $call; my $dxchan = DXChannel->get($call); if ($dxchan) { - $dxchan->disconnect; + if ($dxchan->is_ak1a) { + $dxchan->send_now("D", $self->pc39('Disconnected')); + } else { + $dxchan->disconnect; + } push @out, "disconnected $call"; } else { push @out, "$call not connected locally"; diff --git a/cmd/dx.pl b/cmd/dx.pl index e69de29b..cbf003c0 100644 --- a/cmd/dx.pl +++ b/cmd/dx.pl @@ -0,0 +1,63 @@ +# +# the DX command +# +# this is where the fun starts! +# +# Copyright (c) 1998 Dirk Koopman G1TLH +# +# $Id$ +# + +my ($self, $line) = @_; +my @f = split /\s+/, $line; +my $spotter = $self->call; +my $spotted; +my $freq; +my @out; + +# first lets see if we think we have a callsign as the first argument +if ($f[0] =~ /[A-Za-z]/) { + $spotter = uc $f[0]; + $freq = $f[1]; + $spotted = $f[2]; + $line =~ s/^$f[0]\s+$freq\s+$spotted\s*//; +} else { + $freq = $f[0]; + $spotted = $f[1]; + $line =~ s/^$f[0]\s+$f[1]\s*//; +} + +# check the freq, if the number is < 1800 it is in Mhz (probably) +$freq = $freq * 1000 if $freq < 1800; + +# bash down the list of bands until a valid one is reached +my $valid = 0; +my $bandref; +my @bb; +my $i; + +L1: +foreach $bandref (Bands::get_all()) { + @bb = @{$bandref->band}; + for ($i = 0; $i < @bb; $i += 2) { + if ($freq >= $bb[$i] && $freq <= $bb[$i+1]) { + $valid = 1; + last L1; + } + } +} + +push @out, "Frequency $freq not in band [usage: DX freq call comments]" if !$valid; +return (1, @out) if !$valid; + +# send orf to the users +my $buf = sprintf "DX de %-7.7s %13.1f %-12.12s %-30.30s %5.5s\a\a", $spotter, $freq, $spotted, $line, ztime(time); +DXProt::broadcast_users($buf); + +# Store it here +Spot::add($freq, $spotted, time, $line, $spotter); + +# send it orf to the cluster (hang onto your tin helmets)! +DXProt::broadcast_ak1a(DXProt::pc11($spotter, $freq, $spotted, $line)); + +return (1, @out); diff --git a/cmd/set/here.pl b/cmd/set/here.pl index b89d47d7..aad69d02 100644 --- a/cmd/set/here.pl +++ b/cmd/set/here.pl @@ -15,12 +15,14 @@ my @out; foreach $call (@args) { $call = uc $call; - my $chan = DXChannel->get($call); - if ($chan) { - $chan->here(1); + my $ref = DXCluster->get($call); + if ($ref) { + $ref->here(1); + DXProt::broadcast_ak1a(DXProt::pc24($ref)); push @out, DXM::msg('heres', $call); } else { push @out, DXM::msg('e3', "Set Here", $call); } } + return (1, @out); diff --git a/cmd/talk.pl b/cmd/talk.pl index 5b8cdaee..953d5f2d 100644 --- a/cmd/talk.pl +++ b/cmd/talk.pl @@ -1,6 +1,8 @@ # # The talk command # +# Copyright (c) 1998 Dirk Koopman G1TLH +# # $Id$ # @@ -12,21 +14,17 @@ 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; + $line =~ s/^$argv[0]\s+>\s+$argv[2]\s*//; } else { -# print "argv[0] $argv[0]\n"; - $line =~ s/^$argv[0]\s*//o; + $line =~ s/^$argv[0]\s*//; } -#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 { + $line =~ s/\^//og; # remove any ^ characters my $prot = DXProt::pc10($self, $to, $via, $line); -# print "prot=$prot\n"; - DXProt::route($via?$via:$to, $prot); } diff --git a/cmd/unset/here.pl b/cmd/unset/here.pl index 76adeeac..7311b5e8 100644 --- a/cmd/unset/here.pl +++ b/cmd/unset/here.pl @@ -15,9 +15,10 @@ my @out; foreach $call (@args) { $call = uc $call; - my $user = ($call eq $self->call) ? $self->user : DXUser->get($call); - if ($user) { - $user->here(0); + my $ref = DXCluster->get($call); + if ($ref) { + $ref->here(0); + DXProt::broadcast_ak1a(DXProt::pc24($ref)); push @out, DXM::msg('hereu', $call); } else { push @out, DXM::msg('e3', "Unset Here", $call); diff --git a/cmd/wx.pl b/cmd/wx.pl new file mode 100644 index 00000000..ad9f0d47 --- /dev/null +++ b/cmd/wx.pl @@ -0,0 +1,46 @@ +# +# do an wx message, this is identical to the announce except that it does WX +# instead +# +# handles wx +# wx full +# wx sysop +# +# at the moment these keywords are fixed, but I dare say a file containing valid ones +# will appear +# +# Copyright (c) 1998 Dirk Koopman G1TLH +# +# $Id$ +# + +my ($self, $line) = @_; +my @f = split /\s+/, $line; +my $sort = uc $f[0]; +my @locals = DXCommandmode->get_all(); +my $to; +my $from = $self->call; +my $t = ztime(time); +my $tonode; +my $sysopflag; + +if ($sort eq "FULL") { + $line =~ s/^$f[0]\s+//; # remove it + $to = "ALL"; +} elsif ($sort eq "SYSOP") { + $line =~ s/^$f[0]\s+//; # remove it + @locals = map { $_->priv >= 5 ? $_ : () } @locals; + $to = "SYSOP"; + $sysopflag = '*'; +} else { + $to = "LOCAL"; +} + +DXProt::broadcast_list("WX de $from <$t>: $line", @locals); +if ($to ne "LOCAL") { + $line =~ s/\^//og; # remove ^ characters! + my $pc = DXProt::pc12($self, $line, $tonode, $sysopflag, 1); + DXProt::broadcast_ak1a($pc); +} + +return (1, ()); diff --git a/perl/Bands.pm b/perl/Bands.pm index 99612693..3f3c9984 100644 --- a/perl/Bands.pm +++ b/perl/Bands.pm @@ -23,7 +23,7 @@ $bandsfn = "$main::data/bands.pl"; %valid = ( cw => '0,CW,parraypairs', ssb => '0,SSB,parraypairs', - data => '0,DATA,parraypairs,parraypairs', + data => '0,DATA,parraypairs', sstv => '0,SSTV,parraypairs', fstv => '0,FSTV,parraypairs', rtty => '0,RTTY,parraypairs', diff --git a/perl/DXCluster.pm b/perl/DXCluster.pm index 4e94f4af..3f2eda8e 100644 --- a/perl/DXCluster.pm +++ b/perl/DXCluster.pm @@ -137,6 +137,7 @@ sub new $node->{list}->{$call} = $self; # add this user to the list on this node $users++; dbg('cluster', "allocating user $call to $node->{call} in cluster\n"); + $node->update_users; return $self; } @@ -145,10 +146,11 @@ sub del my $self = shift; my $call = $self->{call}; my $node = $self->{mynode}; - + delete $node->{list}->{$call}; delete $DXCluster::cluster{$call}; # remove me from the cluster table dbg('cluster', "deleting user $call from $node->{call} in cluster\n"); + $node->update_users; $users-- if $users > 0; } @@ -206,6 +208,7 @@ sub del foreach $ref (values %{$self->{list}}) { $ref->del(); # this also takes them out of this list } + delete $DXCluster::cluster{$call}; # remove me from the cluster table dbg('cluster', "deleting node $call from cluster\n"); $nodes-- if $nodes > 0; } diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 928981ab..ddfefc6e 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -342,7 +342,7 @@ sub eval_file { } if ($@) { delete_package($package); - return (0, "Syserr: Eval err $@ on $package"); + return (1, "Syserr: Eval err $@ on $package"); } #cache it unless we're cleaning out each time diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 3a26ca77..e35031e6 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -119,7 +119,7 @@ sub normal # format and broadcast it to users my $spotter = $field[6]; - $spotter =~ s/^(\w+)-\d+/$1/; # strip off the ssid from the spotter + $spotter =~ s/-\d+$//o; # strip off the ssid from the spotter $spotter .= ':'; # add a colon # send orf to the users @@ -135,10 +135,25 @@ sub normal # strip leading and trailing stuff my $text = unpad($field[3]); - my $target = "To Sysops" if $field[4] eq '*'; - $target = "WX" if $field[6]; + my $target; + my @list; + + if ($field[4] eq '*') { # sysops + $target = "To Sysops"; + @list = map { $_->priv >= 5 ? $_ : () } get_all_users(); + } elsif ($field[4] gt ' ') { # speciality list handling + my ($name) = split /\./, $field[4]; + $target = "To $name"; # put the rest in later (if bothered) + } + + $target = "WX" if $field[6] eq '1'; $target = "To All" if !$target; - broadcast_users("$target de $field[1]: $text"); + + if (@list > 0) { + broadcast_list("$target de $field[1]: $text", @list); + } else { + broadcast_users("$target de $field[1]: $text"); + } return if $field[2] eq $main::mycall; # it's routed to me } else { @@ -162,7 +177,8 @@ sub normal my ($call, $confmode, $here) = $field[$i] =~ /^(\w+) (-) (\d)/o; next if length $call < 3; next if !$confmode; - $call =~ s/^(\w+)-\d+/$1/; # remove ssid + $call = uc $call; + $call =~ s/-\d+$//o; # remove ssid next if DXCluster->get($call); # we already have this (loop?) $confmode = $confmode eq '*'; @@ -194,10 +210,10 @@ sub normal my $i; for ($i = 1; $i < $#field-1; $i += 4) { my $here = $field[$i]; - my $call = $field[$i+1]; + my $call = uc $field[$i+1]; my $confmode = $field[$i+2] eq '*'; my $ver = $field[$i+3]; - + # now check the call over next if DXCluster->get($call); # we already have this @@ -216,7 +232,8 @@ sub normal } if ($pcno == 21) { # delete a cluster from the list - my $ref = DXCluster->get($field[1]); + my $call = uc $field[1]; + my $ref = DXCluster->get($call); $ref->del() if $ref; last SWITCH; } @@ -225,8 +242,10 @@ sub normal if ($pcno == 23) {last SWITCH;} if ($pcno == 24) { # set here status - my $user = DXCluster->get($field[1]); - $user->here($field[2]); + my $call = uc $field[1]; + $call =~ s/-\d+//o; + my $ref = DXCluster->get($call); + $ref->here($field[2]) if $ref; last SWITCH; } @@ -349,8 +368,19 @@ sub process sub finish { my $self = shift; - broadcast_ak1a($self->pc21('Gone.')); my $ref = DXCluster->get($self->call); + + # broadcast to all other nodes that all the nodes connected to via me are gone + my @nodes = map { $_->dxchan == $self ? $_ : () } DXNode::get_all(); + my $node; + + foreach $node (@nodes) { + next if $node->call eq $self->call; + broadcast_ak1a(DXProt::pc21($node, 'Gone'), $self); # done like this 'cos DXNodes don't have a pc21 method + } + + # now broadcast to all other ak1a nodes that I have gone + broadcast_ak1a($self->pc21('Gone.'), $self); $ref->del() if $ref; } @@ -429,6 +459,17 @@ sub broadcast_users } } +# broadcast to a list of users +sub broadcast_list +{ + my $s = shift; + my $chan; + + foreach $chan (@_) { + $chan->send($s); # send it + } +} + # # gimme all the ak1a nodes # diff --git a/perl/DXProtout.pm b/perl/DXProtout.pm index 0be5330d..7857daa2 100644 --- a/perl/DXProtout.pm +++ b/perl/DXProtout.pm @@ -34,11 +34,10 @@ sub pc10 return "PC10^$from^$user1^$text^*^$user2^$main::mycall^~"; } -# create a dx message (called $self->pc11(...) +# create a dx message (call, freq, dxcall, text) sub pc11 { - my ($self, $freq, $dxcall, $text) = @_; - my $mycall = $self->call; + my ($mycall, $freq, $dxcall, $text) = @_; my $hops = get_hops(11); my $t = time; $text = ' ' if !$text; @@ -50,7 +49,7 @@ sub pc12 { my ($self, $text, $tonode, $sysop, $wx) = @_; my $hops = get_hops(12); - $sysop = $sysop ? '*' : ' '; + $sysop = ' ' if !$sysop; $text = ' ' if !$text; $wx = '0' if !$wx; $tonode = '*' if !$tonode; @@ -143,6 +142,17 @@ sub pc22 return 'PC22^'; } +# here status +sub pc24 +{ + my $self = shift; + my $call = $self->call; + my $flag = $self->here ? '1' : '0'; + my $hops = get_hops(24); + + return "PC24^$call^$flag^$hops^"; +} + # send all the DX clusters I reckon are connected sub pc38 { @@ -156,6 +166,16 @@ sub pc38 return "PC38^" . join(',', @nodes) . "^~"; } +# tell the local node to discconnect +sub pc39 +{ + my ($ref, $reason) = @_; + my $call = $ref->call; + my $hops = get_hops(21); + $reason = "Gone." if !$reason; + return "PC39^$call^$reason^"; +} + # periodic update of users, plus keep link alive device (always H99) sub pc50 { diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 7ff5b226..08c5824a 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -15,6 +15,9 @@ use MLDBM qw(DB_File); use Fcntl; use Carp; +use strict; +use vars qw(%u $dbm $filename %valid); + %u = undef; $dbm = undef; $filename = undef; @@ -43,6 +46,7 @@ $filename = undef; reg => '0,Registered?,yesno', # is this user registered? ); +no strict; sub AUTOLOAD { my $self = shift; @@ -67,10 +71,12 @@ sub init my ($pkg, $fn) = @_; die "need a filename in User" if !$fn; - $dbm = tie %u, MLDBM, $fn, O_CREAT|O_RDWR, 0666 or die "can't open user file: $fn ($!)"; + $dbm = tie (%u, MLDBM, $fn, O_CREAT|O_RDWR, 0666) or die "can't open user file: $fn ($!)"; $filename = $fn; } +use strict; + # # close the system # @@ -106,10 +112,21 @@ sub new sub get { - my ($pkg, $call) = @_; + my $pkg = shift; + my $call = uc shift; + $call =~ s/-\d+//o; # strip ssid return $u{$call}; } +# +# get all callsigns in the database +# + +sub get_all_calls +{ + return keys %u; +} + # # get an existing either from the channel (if there is one) or from the database # @@ -120,7 +137,10 @@ sub get sub get_current { - my ($pkg, $call) = @_; + my $pkg = shift; + my $call = uc shift; + $call =~ s/-\d+//o; # strip ssid + my $dxchan = DXChannel->get($call); return $dxchan->user if $dxchan; return $u{$call}; -- 2.43.0