+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
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, ());
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) ;
}
}
}
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;
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;
$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);
$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));
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 || "";
$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();
$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));
$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;
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();
$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));
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);
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;
+ }
}
}
}
$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);
$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};
$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, ());
extend it, but none have done what is actually required: which is to throw it
away completely and start from scratch.</p>
-<p>This is an attempt at starting again.</p>
+<p>This is an attempt at starting again. In fit of originality I am calling
+it "New Protocol" or "NP" for short</p>
<h3>Design Criteria</h3>
<ul>
<p></p>
-<p>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.</p>
+<p>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.</p>
<p>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
that no intermediate node has changed the sentence. It is assumed that the
underlying transport mechanisms will deal with communications errors.</p>
-<p>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.</p>
+<p>All sentences shall have an <origin> and a <destination>
+number. The <destination> can be empty which implies that this sentence
+is to be broadcast. </p>
<p>So the generic form of a sentence is:-</p>
<p></p>
<blockquote class="code">
- DX99|<origin>|<serial>|<destination>|...|<cs></blockquote>
+ QX99|<destination>|<origin>|...|<cs></blockquote>
<p></p>
<p>Some examples:-</p>
<blockquote class="code">
- DX01|GB7TLH|0|GB7DJK|DXSpider 1.48/53.287|DE450A30|F4<br>
- DX01|GB7DJK|345|GB7TLH|DXSpider 1.49/60.45|4532DA56|A1<br>
- DX11|GB7TLH|1||G1TLH|FR0G|164563|14001.1|Easy|53<br>
- DX10|GB7TLH|2||G1TLH|SYSOP|GB7TLH rebooting|4A<br>
- DX02|GB7TLH|3|GB7MBC|1|98012349|5D<br>
- DX02|GB7MBC|9356|GB7TLH|0|GB7DJK/0.76,GB7BAA/1.2|AE<br>
+ QX01|GB7TLH|GB7DJK|1|DXSpider:1.48:53.287|90001FFF|5234FE12|DE450A30|F4<br>
+ QX01|GB7DJK|GB7TLH|1|DXSpider:1.49:60.45|90002010|AD412458|4532DA56|A1<br>
+ QX11||GB7TLH|1|G1TLH|FR0G|164563|14001.1|Easy|53<br>
+ QX10||GB7TLH|2|G1TLH|SYSOP|GB7TLH rebooting|4A<br>
</blockquote>
<p></p>
+
+<p>Some fields are split further into subfields. The separator character
+shall be ' :' .</p>
+
+<p>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).</p>
+
+<p></p>
+
+<h1>Initialisation</h1>
+
+<p>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:-</p>
+
+<p><span class="code">QX01|<destination>|<origin>|<protocol
+version>|<software
+info>|<time>|<random>|<challange>|<cs></span> </p>
+
+<p>All NP nodes <span style="font-weight: bold">shall<span
+style="font-weight: normal"> use a cryptograph</span></span>ic 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. </p>
+
+<p>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.</p>
+
+<p>Each sentence that uses a challenge shall include some random element of
+at least 8 characters. The <time> field (if included) is not
+sufficient!</p>
+
+<p>Getting back to the initialisation sentence </p>
<hr>
<span class="copy">Copyright © 2001 by Dirk Koopman G1TLH. All Rights
Reserved</span>
width => '0,Column Width',
disconnecting => '9,Disconnecting,yesno',
ann_talk => '0,Suppress Talk Anns,yesno',
+ metric => '1,Route metric',
);
use vars qw($VERSION $BRANCH);
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
{
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;
}
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);
}
}
# 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);
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;
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);
}
}
}
my @msg = map { chomp; $_ } <MSG>;
close(MSG);
unlink($fn);
- my @out = import_one($DXProt::me, \@msg, $splitit);
+ my @out = import_one($main::me, \@msg, $splitit);
Log('msg', @out);
}
}
$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
{
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);
}
#
$self->{nopings} = $user->nopings || 2;
$self->{pingtime} = [ ];
$self->{pingave} = 999;
+ $self->{metric} ||= 100;
$self->{lastping} = $main::systime;
# send initialisation string
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
}
}
}
# 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;
# 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});
}
# 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);
# 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);
# 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);
}
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
#
unless ($self->{isolate}) {
foreach $dxchan (@dxchan) {
next if $dxchan == $self;
- next if $dxchan == $me;
+ next if $dxchan == $main::me;
$dxchan->send_route($generate, @_);
}
}
--- /dev/null
+#
+# 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;
use DXProtVars;
use DXProtout;
use DXProt;
+use QXProt;
use DXMsg;
use DXCron;
use DXConnect;
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
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");
# 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');
# 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);
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
# 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");
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();
projects / spider.git / commitdiff