+#
+# 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, ());
$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";
+#
+# 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);
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);
#
# The talk command
#
+# Copyright (c) 1998 Dirk Koopman G1TLH
+#
# $Id$
#
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);
}
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);
--- /dev/null
+#
+# 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, ());
%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',
$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;
}
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;
}
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;
}
}
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
# 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
# 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 {
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 '*';
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
}
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;
}
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;
}
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;
}
}
}
+# 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
#
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;
{
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;
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
{
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
{
use Fcntl;
use Carp;
+use strict;
+use vars qw(%u $dbm $filename %valid);
+
%u = undef;
$dbm = undef;
$filename = undef;
reg => '0,Registered?,yesno', # is this user registered?
);
+no strict;
sub AUTOLOAD
{
my $self = shift;
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
#
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
#
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};
projects / spider.git / commitdiff