From 50f6466ca2dff82ca470a4abe327d741cffef61a Mon Sep 17 00:00:00 2001
From: minima
Date: Thu, 20 Sep 2001 14:13:11 +0000
Subject: [PATCH] 1. fix set/lockout so that it is possible to lock out all
SSIDs except those specifically unlocked and so that you don't need to lock
the non-SSID call in order to lock an SSID call. So set/lock g1tlh will lock
out all instances of g1tlh, g1tlh-1, g1tlh-15 etc except (for instance)
unset/lock g1tlh-9. 2. show/lock allows partial callsign matching so sh/lock
gb7 will only show GB7* calls that are locked. 3. Had a grand shift around
for the start of NP.
---
Changes | 8 +++
cmd/announce.pl | 4 +-
cmd/forward/opername.pl | 12 ++--
cmd/kill.pl | 2 +-
cmd/links.pl | 2 +-
cmd/set/here.pl | 2 +-
cmd/set/homenode.pl | 2 +-
cmd/set/location.pl | 4 +-
cmd/set/name.pl | 2 +-
cmd/set/qra.pl | 4 +-
cmd/set/qth.pl | 2 +-
cmd/set/sys_location.pl | 2 +-
cmd/show/lockout.pl | 15 +++--
cmd/unset/here.pl | 2 +-
cmd/who.pl | 2 +-
cmd/wx.pl | 4 +-
html/newprot.html | 76 +++++++++++++++++-------
perl/DXChannel.pm | 93 +++++++++++++++++++++++++++++
perl/DXCommandmode.pm | 6 +-
perl/DXCron.pm | 4 +-
perl/DXMsg.pm | 4 +-
perl/DXProt.pm | 127 +++++++---------------------------------
perl/QXProt.pm | 116 ++++++++++++++++++++++++++++++++++++
perl/cluster.pl | 33 +++++++----
24 files changed, 355 insertions(+), 173 deletions(-)
create mode 100644 perl/QXProt.pm
diff --git a/Changes b/Changes
index 4ad8dd8a..8363ca58 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,11 @@
+21Sep01=======================================================================
+1. fix set/lockout so that it is possible to lock out all SSIDs except those
+specifically unlocked and so that you don't need to lock the non-SSID call in
+order to lock an SSID call. So set/lock g1tlh will lock out all instances of
+g1tlh, g1tlh-1, g1tlh-15 etc except (for instance) unset/lock g1tlh-9.
+2. show/lock allows partial callsign matching so sh/lock gb7 will only show
+GB7* calls that are locked.
+3. Had a grand shift around for the start of NP.
19Sep01=======================================================================
1. put in some rudimentory rsfp checking for various things
2. tried to do some fixes on console.pl - YOU WILL REQUIRE Curses 1.06 from
diff --git a/cmd/announce.pl b/cmd/announce.pl
index df7b91d0..0ea2e12f 100644
--- a/cmd/announce.pl
+++ b/cmd/announce.pl
@@ -54,10 +54,10 @@ if (@bad = BadWords::check($line)) {
return (1, $self->msg('dup')) if AnnTalk::dup($from, $toflag, $line);
Log('ann', $to, $from, $line);
-DXProt::broadcast_list("To $to de $from <$t>: $line", 'ann', undef, @locals);
+DXChannel::broadcast_list("To $to de $from <$t>: $line", 'ann', undef, @locals);
if ($to ne "LOCAL") {
my $pc = DXProt::pc12($from, $line, $tonode, $sysopflag, 0);
- DXProt::broadcast_ak1a($pc);
+ DXChannel::broadcast_nodes($pc);
}
return (1, ());
diff --git a/cmd/forward/opername.pl b/cmd/forward/opername.pl
index 1daaa1c3..91acc8b4 100644
--- a/cmd/forward/opername.pl
+++ b/cmd/forward/opername.pl
@@ -32,29 +32,29 @@ foreach $call (@f) {
my $qra = $ref->qra;
my $latlong = DXBearing::lltos($lat, $long) if $lat && $long;
if ($name) {
- my $l = DXProt::pc41($DXProt::me, $call, 1, $name);
+ my $l = DXProt::pc41($main::me, $call, 1, $name);
DXProt::eph_dup($l);
- DXProt::broadcast_all_ak1a($l, $DXProt::me) ;
+ DXChannel::broadcast_all_nodes($l, $main::me) ;
}
if ($qth) {
my $l = DXProt::pc41($call, 2, $qth);
DXProt::eph_dup($l);
- DXProt::broadcast_all_ak1a($l, $DXProt::me) ;
+ DXChannel::broadcast_all_nodes($l, $main::me) ;
}
if ($latlong) {
my $l = DXProt::pc41($call, 3, $latlong);
DXProt::eph_dup($l);
- DXProt::broadcast_all_ak1a($l, $DXProt::me) ;
+ DXChannel::broadcast_all_nodes($l, $main::me) ;
}
if ($node) {
my $l = DXProt::pc41($call, 4, $node);
DXProt::eph_dup($l);
- DXProt::broadcast_all_ak1a($l, $DXProt::me) ;
+ DXChannel::broadcast_all_nodes($l, $main::me) ;
}
if ($qra) {
my $l = DXProt::pc41($call, 5, $qra);
DXProt::eph_dup($l);
- DXProt::broadcast_all_ak1a($l, $DXProt::me) ;
+ DXChannel::broadcast_all_nodes($l, $main::me) ;
}
}
}
diff --git a/cmd/kill.pl b/cmd/kill.pl
index ab7bb511..de533bdc 100644
--- a/cmd/kill.pl
+++ b/cmd/kill.pl
@@ -64,7 +64,7 @@ while (@f) {
foreach $ref ( @refs) {
Log('msg', "Message $ref->{msgno} from $ref->{from} to $ref->{to} deleted by $call");
if ($full) {
- DXProt::broadcast_ak1a(DXProt::pc49($ref->{from}, $ref->{subject}), $DXProt::me);
+ DXChannel::broadcast_nodes(DXProt::pc49($ref->{from}, $ref->{subject}), $main::me);
}
my $tonode = $ref->tonode;
$ref->stop_msg($tonode) if $tonode;
diff --git a/cmd/links.pl b/cmd/links.pl
index 648ebba4..463a4e4f 100644
--- a/cmd/links.pl
+++ b/cmd/links.pl
@@ -20,7 +20,7 @@ foreach $dxchan ( sort {$a->call cmp $b->call} DXChannel::get_all_nodes ) {
my $t = cldatetime($dxchan->startt);
my $sort;
my $name = $dxchan->user->name || " ";
- my $ping = $dxchan->is_node && $dxchan != $DXProt::me ? sprintf("%8.2f",
+ my $ping = $dxchan->is_node && $dxchan != $main::me ? sprintf("%8.2f",
$dxchan->pingave) : "";
$sort = "DXSP" if $dxchan->is_spider;
$sort = "CLX " if $dxchan->is_clx;
diff --git a/cmd/set/here.pl b/cmd/set/here.pl
index 44fc4d4b..1c4b167c 100644
--- a/cmd/set/here.pl
+++ b/cmd/set/here.pl
@@ -25,7 +25,7 @@ foreach $call (@args) {
$ref->here(1);
my $s = DXProt::pc24($ref);
DXProt::eph_dup($s);
- DXProt::broadcast_all_ak1a($s, $DXProt::me) ;
+ DXChannel::broadcast_all_nodes($s, $main::me) ;
}
} else {
push @out, $self->msg('e3', "Set Here", $call);
diff --git a/cmd/set/homenode.pl b/cmd/set/homenode.pl
index cf8d9715..b2d7d342 100644
--- a/cmd/set/homenode.pl
+++ b/cmd/set/homenode.pl
@@ -24,7 +24,7 @@ if ($user) {
$user->put();
my $s = DXProt::pc41($call, 4, $line);
DXProt::eph_dup($s);
- DXProt::broadcast_all_ak1a($s, $DXProt::me) ;
+ DXChannel::broadcast_all_nodes($s, $main::me) ;
return (1, $self->msg('hnode', $line));
} else {
return (1, $self->msg('namee2', $call));
diff --git a/cmd/set/location.pl b/cmd/set/location.pl
index f4ee0358..9d31dcf5 100644
--- a/cmd/set/location.pl
+++ b/cmd/set/location.pl
@@ -30,7 +30,7 @@ if ($user) {
my $l = DXBearing::lltos($lat, $long);
my $s = DXProt::pc41($call, 3, $l);
DXProt::eph_dup($s);
- DXProt::broadcast_all_ak1a($s, $DXProt::me) ;
+ DXChannel::broadcast_all_nodes($s, $main::me) ;
}
my $qra = DXBearing::lltoqra($lat, $long);
my $oldqra = $user->qra || "";
@@ -38,7 +38,7 @@ if ($user) {
$user->qra($qra);
my $s = DXProt::pc41($call, 5, $qra);
DXProt::eph_dup($s);
- DXProt::broadcast_all_ak1a($s, $DXProt::me);
+ DXChannel::broadcast_all_nodes($s, $main::me);
}
$user->put();
diff --git a/cmd/set/name.pl b/cmd/set/name.pl
index 32917574..4bffef41 100644
--- a/cmd/set/name.pl
+++ b/cmd/set/name.pl
@@ -23,7 +23,7 @@ if ($user) {
$user->put();
my $s = DXProt::pc41($call, 1, $line);
DXProt::eph_dup($s);
- DXProt::broadcast_all_ak1a($s, $DXProt::me) ;
+ DXChannel::broadcast_all_nodes($s, $main::me) ;
return (1, $self->msg('name', $line));
} else {
return (1, $self->msg('namee2', $call));
diff --git a/cmd/set/qra.pl b/cmd/set/qra.pl
index 60c6dc16..4bae21c3 100644
--- a/cmd/set/qra.pl
+++ b/cmd/set/qra.pl
@@ -25,7 +25,7 @@ if ($user) {
$user->qra($qra);
my $s = DXProt::pc41($call, 5, $qra);
DXProt::eph_dup($s);
- DXProt::broadcast_all_ak1a($s, $DXProt::me);
+ DXChannel::broadcast_all_nodes($s, $main::me);
}
my ($lat, $long) = DXBearing::qratoll($qra);
my $oldlat = $user->lat || 0;
@@ -36,7 +36,7 @@ if ($user) {
my $l = DXBearing::lltos($lat, $long);
my $s = DXProt::pc41($call, 3, $l);
DXProt::eph_dup($s);
- DXProt::broadcast_all_ak1a($s, $DXProt::me) ;
+ DXChannel::broadcast_all_nodes($s, $main::me) ;
}
$user->put();
diff --git a/cmd/set/qth.pl b/cmd/set/qth.pl
index 2b696f94..4a5a881f 100644
--- a/cmd/set/qth.pl
+++ b/cmd/set/qth.pl
@@ -23,7 +23,7 @@ if ($user) {
$user->put();
my $s = DXProt::pc41($call, 2, $line);
DXProt::eph_dup($s);
- DXProt::broadcast_all_ak1a($s, $DXProt::me) ;
+ DXChannel::broadcast_all_nodes($s, $main::me) ;
return (1, $self->msg('qth', $line));
} else {
return (1, $self->msg('namee2', $call));
diff --git a/cmd/set/sys_location.pl b/cmd/set/sys_location.pl
index 903a5796..aac91823 100644
--- a/cmd/set/sys_location.pl
+++ b/cmd/set/sys_location.pl
@@ -25,7 +25,7 @@ if ($user) {
my ($lat, $long) = DXBearing::stoll($line);
$user->lat($lat);
$user->long($long);
- DXProt::broadcast_all_ak1a(DXProt::pc41($call, 3, $line), $DXProt::me);
+ DXChannel::broadcast_all_nodes(DXProt::pc41($call, 3, $line), $main::me);
if (!$user->qra) {
my $qra = DXBearing::lltos($lat, $long);
$user->qra($qra);
diff --git a/cmd/show/lockout.pl b/cmd/show/lockout.pl
index 04d1ef12..f4c87a87 100644
--- a/cmd/show/lockout.pl
+++ b/cmd/show/lockout.pl
@@ -15,13 +15,20 @@ my @out;
use DB_File;
+if ($line) {
+ $line =~ s/[^\w-\/]+//g;
+ $line = "^\U\Q$line";
+}
+
my ($action, $count, $key, $data) = (0,0,0,0);
for ($action = DXUser::R_FIRST, $count = 0; !$DXUser::dbm->seq($key, $data, $action); $action = DXUser::R_NEXT) {
if ($data =~ m{lockout =>}) {
- my $u = DXUser->get_current($key);
- if ($u && $u->lockout) {
- push @out, $key;
- ++$count;
+ if ($line && $key =~ /$line/) {
+ my $u = DXUser->get_current($key);
+ if ($u && $u->lockout) {
+ push @out, $key;
+ ++$count;
+ }
}
}
}
diff --git a/cmd/unset/here.pl b/cmd/unset/here.pl
index 4da517c1..19db8dbd 100644
--- a/cmd/unset/here.pl
+++ b/cmd/unset/here.pl
@@ -25,7 +25,7 @@ foreach $call (@args) {
$ref->here(0);
my $s = DXProt::pc24($ref);
DXProt::eph_dup($s);
- DXProt::broadcast_all_ak1a($s, $DXProt::me) ;
+ DXChannel::broadcast_all_nodes($s, $main::me) ;
}
} else {
push @out, $self->msg('e3', "Unset Here", $call);
diff --git a/cmd/who.pl b/cmd/who.pl
index ecb45d70..6ec7dba3 100644
--- a/cmd/who.pl
+++ b/cmd/who.pl
@@ -26,7 +26,7 @@ foreach $dxchan ( sort {$a->call cmp $b->call} DXChannel::get_all ) {
$sort = "AK1A" if $dxchan->is_ak1a;
}
my $name = $dxchan->user->name || " ";
- my $ping = $dxchan->is_node && $dxchan != $DXProt::me ? sprintf("%5.2f", $dxchan->pingave) : " ";
+ my $ping = $dxchan->is_node && $dxchan != $main::me ? sprintf("%5.2f", $dxchan->pingave) : " ";
my $conn = $dxchan->conn;
my $ip = '';
$ip = $conn->{peerhost} if $conn && $conn->{peerhost};
diff --git a/cmd/wx.pl b/cmd/wx.pl
index cec70f4e..af7cd0ab 100644
--- a/cmd/wx.pl
+++ b/cmd/wx.pl
@@ -36,11 +36,11 @@ if ($sort eq "FULL") {
$to = "LOCAL";
}
-DXProt::broadcast_list("WX de $from <$t>: $line", 'wx', undef, @locals);
+DXChannel::broadcast_list("WX de $from <$t>: $line", 'wx', undef, @locals);
if ($to ne "LOCAL") {
$line =~ s/\^//og; # remove ^ characters!
my $pc = DXProt::pc12($from, $line, $tonode, $sysopflag, 1);
- DXProt::broadcast_ak1a($pc, $DXProt::me);
+ DXChannel::broadcast_nodes($pc, $main::me);
}
return (1, ());
diff --git a/html/newprot.html b/html/newprot.html
index c34a5354..1bb84fe2 100644
--- a/html/newprot.html
+++ b/html/newprot.html
@@ -32,7 +32,8 @@ become stretched to beyond breaking point. Some attempts have been made to
extend it, but none have done what is actually required: which is to throw it
away completely and start from scratch.
-This is an attempt at starting again.
+This is an attempt at starting again. In fit of originality I am calling
+it "New Protocol" or "NP" for short
Design Criteria
@@ -111,12 +112,12 @@ away completely and start from scratch.
-Each protocol line is separate and distinct. This is a "datagram" style
-protocol. Each protocol line is called a "sentence" and begins with the
-string "DX" in upper case, followed by two digits. The sentence is terminated
-by a <cr> or a <lf> character or both. Internally, the
-terminating characters should be discarded completely and the sentence
-processed without.
+Each protocol line is separate and distinct and is called a "sentence".
+This is a "datagram" style protocol. Each protocol line is called a
+"sentence" and begins with the string "QX" in upper case, followed by two
+digits. The sentence is terminated by a <cr> or a <lf> character
+or both. Internally, the terminating characters should be discarded
+completely and the sentence processed without.
The character set used shall be ISO-Latin-1, with only the characters 0x20
-> 0x7e permitted within a sentence. All other characters shall be "HTML
@@ -140,34 +141,69 @@ digits> of the checksum itself. The purpose of the checksum is to check
that no intermediate node has changed the sentence. It is assumed that the
underlying transport mechanisms will deal with communications errors.
-All sentences shall have an <origin>, a <serial> and a
-<destination> number. The <destination> can be empty which implies
-that this sentence is to be broadcast. The <serial> number is a global
-number, which is used for all sentences originating at a node, that is
-incremented modulo 10000, and is used to determine duplicate or out of date
-sentences.
+All sentences shall have an <origin> and a <destination>
+number. The <destination> can be empty which implies that this sentence
+is to be broadcast.
So the generic form of a sentence is:-
- DX99|<origin>|<serial>|<destination>|...|<cs>
+ QX99|<destination>|<origin>|...|<cs>
Some examples:-
- DX01|GB7TLH|0|GB7DJK|DXSpider 1.48/53.287|DE450A30|F4
- DX01|GB7DJK|345|GB7TLH|DXSpider 1.49/60.45|4532DA56|A1
- DX11|GB7TLH|1||G1TLH|FR0G|164563|14001.1|Easy|53
- DX10|GB7TLH|2||G1TLH|SYSOP|GB7TLH rebooting|4A
- DX02|GB7TLH|3|GB7MBC|1|98012349|5D
- DX02|GB7MBC|9356|GB7TLH|0|GB7DJK/0.76,GB7BAA/1.2|AE
+ QX01|GB7TLH|GB7DJK|1|DXSpider:1.48:53.287|90001FFF|5234FE12|DE450A30|F4
+ QX01|GB7DJK|GB7TLH|1|DXSpider:1.49:60.45|90002010|AD412458|4532DA56|A1
+ QX11||GB7TLH|1|G1TLH|FR0G|164563|14001.1|Easy|53
+ QX10||GB7TLH|2|G1TLH|SYSOP|GB7TLH rebooting|4A
+
+Some fields are split further into subfields. The separator character
+shall be ' :' .
+
+Some sentences will have serial numbers associated with them which
+functions both as a generation number and as an aid to deduplication. The
+particular usage for each type of sentence is discussed later, but the
+general form will be as a modulo 10000 number (0-9999).
+
+
+
+Initialisation
+
+When a node wishes to speak NP it shall send a "QX01" initialisation
+sentence to the other node on connection. It does not wait, it connects and
+sends. Both sides of the connection send simultaniously and symetrically. The
+fields currently in this sentence are:-
+
+QX01|<destination>|<origin>|<protocol
+version>|<software
+info>|<time>|<random>|<challange>|<cs>
+
+All NP nodes shall use a cryptographic challenge to
+determine that the node that they are talking to is correct. In this
+protocol, wherever a challenge is mandated, the challenge field will be the
+last field before the checksum and shall include the whole of the sentence
+upto that point as the "salt" to that challenge.
+
+Because we are not yet sufficiently paranoid to include full crytography,
+we will use the standard 32 bit CCITT CRC algorithm on a shared secret
+phrase, each side shall have a different phrase each known to both sides.
+Each connection shall have a different pair of phrases. Each phrase shall be
+at least 40 characters long.
+
+Each sentence that uses a challenge shall include some random element of
+at least 8 characters. The <time> field (if included) is not
+sufficient!
+
+Getting back to the initialisation sentence
Copyright © 2001 by Dirk Koopman G1TLH. All Rights
Reserved
diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index c4a81c7f..01d2135e 100644
--- a/perl/DXChannel.pm
+++ b/perl/DXChannel.pm
@@ -105,6 +105,7 @@ $count = 0;
width => '0,Column Width',
disconnecting => '9,Disconnecting,yesno',
ann_talk => '0,Suppress Talk Anns,yesno',
+ metric => '1,Route metric',
);
use vars qw($VERSION $BRANCH);
@@ -521,6 +522,98 @@ sub rspfcheck
return 0;
}
+# broadcast a message to all clusters taking into account isolation
+# [except those mentioned after buffer]
+sub broadcast_nodes
+{
+ my $s = shift; # the line to be rebroadcast
+ my @except = @_; # to all channels EXCEPT these (dxchannel refs)
+ my @dxchan = DXChannel::get_all_nodes();
+ my $dxchan;
+
+ # send it if it isn't the except list and isn't isolated and still has a hop count
+ foreach $dxchan (@dxchan) {
+ next if grep $dxchan == $_, @except;
+ next if $dxchan == $main::me;
+
+ my $routeit = $dxchan->can('adjust_hops') ? $dxchan->adjust_hops($s) : $s; # adjust its hop count by node name
+
+ $dxchan->send($routeit) unless $dxchan->{isolate} || !$routeit;
+ }
+}
+
+# broadcast a message to all clusters ignoring isolation
+# [except those mentioned after buffer]
+sub broadcast_all_ak1a
+{
+ my $s = shift; # the line to be rebroadcast
+ my @except = @_; # to all channels EXCEPT these (dxchannel refs)
+ my @dxchan = DXChannel::get_all_nodes();
+ my $dxchan;
+
+ # send it if it isn't the except list and isn't isolated and still has a hop count
+ foreach $dxchan (@dxchan) {
+ next if grep $dxchan == $_, @except;
+ next if $dxchan == $main::me;
+
+ my $routeit = $dxchan->can('adjust_hops') ? $dxchan->adjust_hops($s) : $s; # adjust its hop count by node name
+ $dxchan->send($routeit);
+ }
+}
+
+# broadcast to all users
+# storing the spot or whatever until it is in a state to receive it
+sub broadcast_users
+{
+ my $s = shift; # the line to be rebroadcast
+ my $sort = shift; # the type of transmission
+ my $fref = shift; # a reference to an object to filter on
+ my @except = @_; # to all channels EXCEPT these (dxchannel refs)
+ my @dxchan = DXChannel::get_all_users();
+ my $dxchan;
+ my @out;
+
+ foreach $dxchan (@dxchan) {
+ next if grep $dxchan == $_, @except;
+ push @out, $dxchan;
+ }
+ broadcast_list($s, $sort, $fref, @out);
+}
+
+
+# broadcast to a list of users
+sub broadcast_list
+{
+ my $s = shift;
+ my $sort = shift;
+ my $fref = shift;
+ my $dxchan;
+
+ foreach $dxchan (@_) {
+ my $filter = 1;
+ next if $dxchan == $main::me;
+
+ if ($sort eq 'dx') {
+ next unless $dxchan->{dx};
+ ($filter) = $dxchan->{spotsfilter}->it(@{$fref}) if ref $fref;
+ next unless $filter;
+ }
+ next if $sort eq 'ann' && !$dxchan->{ann} && $s !~ /^To\s+LOCAL\s+de\s+(?:$main::myalias|$main::mycall)/i;
+ next if $sort eq 'wwv' && !$dxchan->{wwv};
+ next if $sort eq 'wcy' && !$dxchan->{wcy};
+ next if $sort eq 'wx' && !$dxchan->{wx};
+
+ $s =~ s/\a//og unless $dxchan->{beep};
+
+ if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') {
+ $dxchan->send($s);
+ } else {
+ $dxchan->delay($s);
+ }
+ }
+}
+
+
no strict;
sub AUTOLOAD
{
diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 9f3c669e..a8418bd4 100644
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -61,7 +61,7 @@ sub new
my $pkg = shift;
my $call = shift;
my @rout = $main::routeroot->add_user($call, Route::here(1));
- DXProt::route_pc16($DXProt::me, $main::routeroot, @rout) if @rout;
+ DXProt::route_pc16($main::me, $main::routeroot, @rout) if @rout;
return $self;
}
@@ -132,7 +132,7 @@ sub start
my $lastoper = $user->lastoper || 0;
my $homenode = $user->homenode || "";
if ($homenode eq $main::mycall && $lastoper + $DXUser::lastoperinterval < $main::systime) {
- run_cmd($DXProt::me, "forward/opernam $call");
+ run_cmd($main::me, "forward/opernam $call");
$user->lastoper($main::systime);
}
@@ -451,7 +451,7 @@ sub disconnect
}
# issue a pc17 to everybody interested
- DXProt::route_pc17($DXProt::me, $main::routeroot, @rout) if @rout;
+ DXProt::route_pc17($main::me, $main::routeroot, @rout) if @rout;
# I was the last node visited
$self->user->node($main::mycall);
diff --git a/perl/DXCron.pm b/perl/DXCron.pm
index 785a1ad9..74b65996 100644
--- a/perl/DXCron.pm
+++ b/perl/DXCron.pm
@@ -286,13 +286,13 @@ sub rcmd
return unless $noderef && $noderef->version;
# send it
- DXProt::addrcmd($DXProt::me, $call, $line);
+ DXProt::addrcmd($main::me, $call, $line);
}
sub run_cmd
{
my $line = shift;
- my @in = DXCommandmode::run_cmd($DXProt::me, $line);
+ my @in = DXCommandmode::run_cmd($main::me, $line);
dbg("cmd run: $line") if isdbg('cron');
for (@in) {
s/\s*$//og;
diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm
index 8c565797..ec798b54 100644
--- a/perl/DXMsg.pm
+++ b/perl/DXMsg.pm
@@ -389,7 +389,7 @@ sub process
if ($_->{from} eq $f[1] && $_->{subject} eq $f[2]) {
$_->del_msg();
Log('msg', "Message $_->{msgno} from $_->{from} ($_->{subject}) fully deleted");
- DXProt::broadcast_ak1a($line, $self);
+ DXChannel::broadcast_nodes($line, $self);
}
}
}
@@ -1111,7 +1111,7 @@ sub import_msgs
my @msg = map { chomp; $_ } ;
close(MSG);
unlink($fn);
- my @out = import_one($DXProt::me, \@msg, $splitit);
+ my @out = import_one($main::me, \@msg, $splitit);
Log('msg', @out);
}
}
diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index 0c23663c..e6380b56 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -42,12 +42,11 @@ $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0;
$main::build += $VERSION;
$main::branch += $BRANCH;
-use vars qw($me $pc11_max_age $pc23_max_age $last_pc50
+use vars qw($pc11_max_age $pc23_max_age $last_pc50
$last_hour $last10 %eph %pings %rcmds $ann_to_talk
%nodehops $baddx $badspotter $badnode $censorpc $rspfcheck
$allowzero $decode_dk0wcy $send_opernam @checklist);
-$me = undef; # the channel id for this cluster
$pc11_max_age = 1*3600; # the maximum age for an incoming 'real-time' pc11
$pc23_max_age = 1*3600; # the maximum age for an incoming 'real-time' pc23
@@ -185,14 +184,17 @@ sub init
{
my $user = DXUser->get($main::mycall);
$DXProt::myprot_version += $main::version*100;
- $me = DXProt->new($main::mycall, 0, $user);
- $me->{here} = 1;
- $me->{state} = "indifferent";
+ $main::me = DXProt->new($main::mycall, 0, $user);
+ $main::me->{here} = 1;
+ $main::me->{state} = "indifferent";
do "$main::data/hop_table.pl" if -e "$main::data/hop_table.pl";
confess $@ if $@;
- $me->{sort} = 'S'; # S for spider
- $me->{priv} = 9;
-# $Route::Node::me->adddxchan($me);
+ $main::me->{sort} = 'S'; # S for spider
+ $main::me->{priv} = 9;
+ $main::me->{metric} = 0;
+ $main::me->{pingave} = 0;
+
+# $Route::Node::me->adddxchan($main::me);
}
#
@@ -262,6 +264,7 @@ sub start
$self->{nopings} = $user->nopings || 2;
$self->{pingtime} = [ ];
$self->{pingave} = 999;
+ $self->{metric} ||= 100;
$self->{lastping} = $main::systime;
# send initialisation string
@@ -1178,7 +1181,7 @@ sub normal
dbg("PCPROT: Ephemeral dup, dropped") if isdbg('chanerr');
} else {
unless ($self->{isolate}) {
- broadcast_ak1a($line, $self); # send it to everyone but me
+ DXChannel::broadcast_nodes($line, $self); # send it to everyone but me
}
}
}
@@ -1196,14 +1199,14 @@ sub process
# send out a pc50 on EVERY channel all at once
if ($t >= $last_pc50 + $DXProt::pc50_interval) {
- $pc50s = pc50($me, scalar DXChannel::get_all_users);
+ $pc50s = pc50($main::me, scalar DXChannel::get_all_users);
eph_dup($pc50s);
$last_pc50 = $t;
}
foreach $dxchan (@dxchan) {
next unless $dxchan->is_node();
- next if $dxchan == $me;
+ next if $dxchan == $main::me;
# send the pc50
$dxchan->send($pc50s) if $pc50s;
@@ -1252,7 +1255,7 @@ sub send_dx_spot
# send it if it isn't the except list and isn't isolated and still has a hop count
# taking into account filtering and so on
foreach $dxchan (@dxchan) {
- next if $dxchan == $me;
+ next if $dxchan == $main::me;
next if $dxchan == $self && $self->is_node;
$dxchan->dx_spot($line, $self->{isolate}, @_, $self->{call});
}
@@ -1315,7 +1318,7 @@ sub send_wwv_spot
# send it if it isn't the except list and isn't isolated and still has a hop count
# taking into account filtering and so on
foreach $dxchan (@dxchan) {
- next if $dxchan == $me;
+ next if $dxchan == $main::me;
next if $dxchan == $self && $self->is_node;
my $routeit;
my ($filter, $hops);
@@ -1362,7 +1365,7 @@ sub send_wcy_spot
# send it if it isn't the except list and isn't isolated and still has a hop count
# taking into account filtering and so on
foreach $dxchan (@dxchan) {
- next if $dxchan == $me;
+ next if $dxchan == $main::me;
next if $dxchan == $self;
$dxchan->wcy($line, $self->{isolate}, @_, $self->{call}, $wcy_dxcc, $wcy_itu, $wcy_cq, $org_dxcc, $org_itu, $org_cq);
@@ -1439,7 +1442,7 @@ sub send_announce
# send it if it isn't the except list and isn't isolated and still has a hop count
# taking into account filtering and so on
foreach $dxchan (@dxchan) {
- next if $dxchan == $me;
+ next if $dxchan == $main::me;
next if $dxchan == $self && $self->is_node;
$dxchan->announce($line, $self->{isolate}, $to, $target, $text, @_, $self->{call}, $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq);
}
@@ -1532,103 +1535,13 @@ sub route
if ($dxchan) {
my $routeit = adjust_hops($dxchan, $line); # adjust its hop count by node name
if ($routeit) {
- $dxchan->send($routeit) unless $dxchan == $me;
+ $dxchan->send($routeit) unless $dxchan == $main::me;
}
} else {
dbg("PCPROT: No route available, dropped") if isdbg('chanerr');
}
}
-# broadcast a message to all clusters taking into account isolation
-# [except those mentioned after buffer]
-sub broadcast_ak1a
-{
- my $s = shift; # the line to be rebroadcast
- my @except = @_; # to all channels EXCEPT these (dxchannel refs)
- my @dxchan = DXChannel::get_all_nodes();
- my $dxchan;
-
- # send it if it isn't the except list and isn't isolated and still has a hop count
- foreach $dxchan (@dxchan) {
- next if grep $dxchan == $_, @except;
- next if $dxchan == $me;
-
- my $routeit = adjust_hops($dxchan, $s); # adjust its hop count by node name
- $dxchan->send($routeit) unless $dxchan->{isolate} || !$routeit;
- }
-}
-
-# broadcast a message to all clusters ignoring isolation
-# [except those mentioned after buffer]
-sub broadcast_all_ak1a
-{
- my $s = shift; # the line to be rebroadcast
- my @except = @_; # to all channels EXCEPT these (dxchannel refs)
- my @dxchan = DXChannel::get_all_nodes();
- my $dxchan;
-
- # send it if it isn't the except list and isn't isolated and still has a hop count
- foreach $dxchan (@dxchan) {
- next if grep $dxchan == $_, @except;
- next if $dxchan == $me;
-
- my $routeit = adjust_hops($dxchan, $s); # adjust its hop count by node name
- $dxchan->send($routeit);
- }
-}
-
-# broadcast to all users
-# storing the spot or whatever until it is in a state to receive it
-sub broadcast_users
-{
- my $s = shift; # the line to be rebroadcast
- my $sort = shift; # the type of transmission
- my $fref = shift; # a reference to an object to filter on
- my @except = @_; # to all channels EXCEPT these (dxchannel refs)
- my @dxchan = DXChannel::get_all_users();
- my $dxchan;
- my @out;
-
- foreach $dxchan (@dxchan) {
- next if grep $dxchan == $_, @except;
- push @out, $dxchan;
- }
- broadcast_list($s, $sort, $fref, @out);
-}
-
-# broadcast to a list of users
-sub broadcast_list
-{
- my $s = shift;
- my $sort = shift;
- my $fref = shift;
- my $dxchan;
-
- foreach $dxchan (@_) {
- my $filter = 1;
- next if $dxchan == $me;
-
- if ($sort eq 'dx') {
- next unless $dxchan->{dx};
- ($filter) = $dxchan->{spotsfilter}->it(@{$fref}) if ref $fref;
- next unless $filter;
- }
- next if $sort eq 'ann' && !$dxchan->{ann} && $s !~ /^To\s+LOCAL\s+de\s+(?:$main::myalias|$main::mycall)/i;
- next if $sort eq 'wwv' && !$dxchan->{wwv};
- next if $sort eq 'wcy' && !$dxchan->{wcy};
- next if $sort eq 'wx' && !$dxchan->{wx};
-
- $s =~ s/\a//og unless $dxchan->{beep};
-
- if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') {
- $dxchan->send($s);
- } else {
- $dxchan->delay($s);
- }
- }
-}
-
-
#
# obtain the hops from the list for this callsign and pc no
#
@@ -1905,7 +1818,7 @@ sub broadcast_route
unless ($self->{isolate}) {
foreach $dxchan (@dxchan) {
next if $dxchan == $self;
- next if $dxchan == $me;
+ next if $dxchan == $main::me;
$dxchan->send_route($generate, @_);
}
}
diff --git a/perl/QXProt.pm b/perl/QXProt.pm
new file mode 100644
index 00000000..bce0b567
--- /dev/null
+++ b/perl/QXProt.pm
@@ -0,0 +1,116 @@
+#
+# This module impliments the new protocal mode for a dx cluster
+#
+# Copyright (c) 2001 Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+package QXProt;
+
+@ISA = qw(DXChannel DXProt);
+
+use DXUtil;
+use DXChannel;
+use DXUser;
+use DXM;
+use DXLog;
+use Spot;
+use DXDebug;
+use Filter;
+use DXDb;
+use AnnTalk;
+use Geomag;
+use WCY;
+use Time::HiRes qw(gettimeofday tv_interval);
+use BadWords;
+use DXHash;
+use Route;
+use Route::Node;
+use Script;
+use DXProt;
+
+use strict;
+
+use vars qw($VERSION $BRANCH);
+$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
+$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0;
+$main::build += $VERSION;
+$main::branch += $BRANCH;
+
+use vars qw($last_node_update $node_update_interval);
+
+$node_update_interval = 14*60;
+$last_node_update = time;
+
+
+sub start
+{
+ my $self = shift;
+ $self->SUPER::start(@_);
+}
+
+sub normal
+{
+ if ($_[1] =~ /^PC\d\d\^/) {
+ DXProt::normal(@_);
+ return;
+ }
+ my $pcno;
+ return unless ($pcno) = $_[1] =~ /^QX(\d\d)\^/;
+
+ my ($self, $line) = @_;
+
+ # calc checksum
+ $line =~ s/\^(\d\d)$//;
+ my $incs = hex $1;
+ my $cs = unpack("%32C*", $line) % 255;
+ if ($incs != $cs) {
+ dbg("QXPROT: Checksum fail in: $incs ne calc: $cs" ) if isdbg('qxerr');
+ return;
+ }
+
+ # split the field for further processing
+ my ($id, $tonode, $fromnode, @field) = split /\^/, $line;
+
+}
+
+sub process
+{
+ if ($main::systime >= $last_node_update+$node_update_interval) {
+# sendallnodes();
+# sendallusers();
+ $last_node_update = $main::systime;
+ }
+}
+
+sub sendallnodes
+{
+ my $nodes = join(',', map {sprintf("%s:%d", $_->{call}, int($_->{pingave} * $_->{metric}))} DXChannel::get_all_nodes());
+ my $users = DXChannel::get_all_users();
+ DXChannel::broadcast_nodes(frame(2, undef, undef, hextime(), $users, 'S', $nodes))
+}
+
+sub sendallusers
+{
+
+}
+
+sub hextime
+{
+ my $t = shift || $main::systime;
+ return sprintf "%X", $t;
+}
+
+sub frame
+{
+ my $pcno = shift;
+ my $to = shift || '';
+ my $from = shift || $main::mycall;
+
+ my $line = join '^', sprintf("QX%02d", $pcno), $to, $from, @_;
+ my $cs = unpack("%32C*", $line) % 255;
+ return $line . sprintf("^%02X", $cs);
+}
+
+1;
diff --git a/perl/cluster.pl b/perl/cluster.pl
index 3596fa00..1fa2806a 100755
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -60,6 +60,7 @@ use DXCommandmode;
use DXProtVars;
use DXProtout;
use DXProt;
+use QXProt;
use DXMsg;
use DXCron;
use DXConnect;
@@ -98,7 +99,7 @@ package main;
use strict;
use vars qw(@inqueue $systime $version $starttime $lockfn @outstanding_connects
$zombies $root @listeners $lang $myalias @debug $userfn $clusteraddr
- $clusterport $mycall $decease $is_win $routeroot
+ $clusterport $mycall $decease $is_win $routeroot $me
);
@inqueue = (); # the main input queue, an array of hashes
@@ -161,8 +162,8 @@ sub new_channel
my $basecall = $call;
$basecall =~ s/-\d+$//;
my $baseuser = DXUser->get($basecall);
- if ($baseuser && $baseuser->lockout) {
- my $lock = $user->lockout if $user;
+ my $lock = $user->lockout if $user;
+ if ($baseuser && $baseuser->lockout || $lock) {
if (!$user || !defined $lock || $lock) {
my $host = $conn->{peerhost} || "unknown";
Log('DXCommand', "$call on $host is locked out, disconnected");
@@ -179,10 +180,17 @@ sub new_channel
# create the channel
- $dxchan = DXCommandmode->new($call, $conn, $user) if $user->is_user;
- $dxchan = DXProt->new($call, $conn, $user) if $user->is_node;
- $dxchan = BBS->new($call, $conn, $user) if $user->is_bbs;
- die "Invalid sort of user on $call = $sort" if !$dxchan;
+ if ($user->is_spider) {
+ $dxchan = QXProt->new($call, $conn, $user);
+ } elsif ($user->is_node) {
+ $dxchan = DXProt->new($call, $conn, $user);
+ } elsif ($user->is_user) {
+ $dxchan = DXCommandmode->new($call, $conn, $user);
+ } elsif ($user->is_bbs) {
+ $dxchan = BBS->new($call, $conn, $user);
+ } else {
+ die "Invalid sort of user on $call = $sort";
+ }
# check that the conn has a callsign
$conn->conns($call) if $conn->isa('IntMsg');
@@ -230,7 +238,7 @@ sub cease
# disconnect nodes
foreach $dxchan (DXChannel->get_all_nodes) {
- $dxchan->disconnect(2) unless $dxchan == $DXProt::me;
+ $dxchan->disconnect(2) unless $dxchan == $main::me;
}
Msg->event_loop(100, 0.01);
@@ -429,12 +437,12 @@ dbg("reading in duplicate spot and WWV info ...");
DXProt->init();
# put in a DXCluster node for us here so we can add users and take them away
-$routeroot = Route::Node->new($mycall, $version*100+5300, Route::here($DXProt::me->here)|Route::conf($DXProt::me->conf));
+$routeroot = Route::Node->new($mycall, $version*100+5300, Route::here($main::me->here)|Route::conf($main::me->conf));
# make sure that there is a routing OUTPUT node default file
#unless (Filter::read_in('route', 'node_default', 0)) {
-# my $dxcc = $DXProt::me->dxcc;
-# $Route::filterdef->cmd($DXProt::me, 'route', 'accept', "node_default call $mycall" );
+# my $dxcc = $main::me->dxcc;
+# $Route::filterdef->cmd($main::me, 'route', 'accept', "node_default call $mycall" );
#}
# read in any existing message headers and clean out old crap
@@ -466,7 +474,7 @@ DXDebug::dbgclean();
# this, such as it is, is the main loop!
dbg("orft we jolly well go ...");
my $script = new Script "startup";
-$script->run($DXProt::me) if $script;
+$script->run($main::me) if $script;
#open(DB::OUT, "|tee /tmp/aa");
@@ -485,6 +493,7 @@ for (;;) {
DXCron::process(); # do cron jobs
DXCommandmode::process(); # process ongoing command mode stuff
DXProt::process(); # process ongoing ak1a pcxx stuff
+ QXProt::process();
DXConnect::process();
DXMsg::process();
DXDb::process();
--
2.43.0