+11Jul02=======================================================================
+1. NP work has now started in ernest ([ed]who he?). You will need to download
+Digest::SHA1 and any dependant packages to run this release. HOWEVER tempted
+you are, please don't set/newprotocol on any nodes. It won't work.
+2. Make the cluster node registered on from startup (from Mark HB9DBM).
09Jul02=======================================================================
1. make the is_qra more accurate (from Mark HB9DBM).
04Jul02=======================================================================
'^set/nota', 'unset/talk', 'unset/talk',
'^set/noww', 'unset/wwv', 'unset/wwv',
'^set/nowx', 'unset/wx', 'unset/wx',
+ '^set/us', 'unset/node', 'unset/node',
'^set$', 'apropos set', 'apropos',
'^sho?w?/u$', 'show/user', 'show/user',
'^sho?w?/bu', 'show/files bulletins', 'show/files',
set/badspotter VE2STN
-will stop anything from VE2STN. If you want SSIDs as well then you must
-enter them specifically.
+will stop anything from VE2STN. This command will automatically
+stop spots from this user, regardless of whether or which SSID
+he uses. DO NOT USE SSIDs in the callsign, just use the callsign
+as above or below.
unset/badspotter VE2STN
--- /dev/null
+#
+# set the new protocol flag
+#
+# Copyright (c) 1998 - Dirk Koopman
+#
+# $Id$
+#
+
+my ($self, $line) = @_;
+my @args = split /\s+/, $line;
+my $call;
+my @out;
+
+@args = $self->call if (!@args || $self->priv < 9);
+
+foreach $call (@args) {
+ $call = uc $call;
+ my $user = DXUser->get_current($call);
+ if ($user) {
+ $user->wantnp(1);
+ $user->put;
+ push @out, $self->msg('set', 'New Protocol', $call);
+ } else {
+ push @out, $self->msg('e3', "Set New Protocol", $call);
+ }
+}
+return (1, @out);
--- /dev/null
+#
+# set a user's passphrase
+#
+# Copyright (c) 2002 Dirk Koopman G1TLH
+#
+# Syntax: set/passphrase <callsign> <password>
+#
+
+my ($self, $line) = @_;
+my @args = split /\s+/, $line, 2;
+my $call = shift @args;
+my @out;
+my $user;
+my $ref;
+
+if ($self->remotecmd) {
+ $call ||= $self->call;
+ Log('DXCommand', $self->call . " attempted to change passphrase for $call remotely");
+ return (1, $self->msg('e5'));
+}
+
+if ($call) {
+ if ($self->priv < 9) {
+ Log('DXCommand', $self->call . " attempted to change passphrase for $call");
+ return (1, $self->msg('e5'));
+ }
+ return (1, $self->msg('e29')) unless @args;
+ if ($ref = DXUser->get_current($call)) {
+ $ref->passphrase($args[0]);
+ $ref->put();
+ push @out, $self->msg("passphrase", $call);
+ Log('DXCommand', $self->call . " changed passphrase for $call");
+ } else {
+ push @out, $self->msg('e3', 'User record for', $call);
+ }
+}
+
+return (1, @out);
+++ /dev/null
-#
-# set the pc90 flag
-#
-# Copyright (c) 1998 - Dirk Koopman
-#
-# $Id$
-#
-
-my ($self, $line) = @_;
-my @args = split /\s+/, $line;
-my $call;
-my @out;
-
-@args = $self->call if (!@args || $self->priv < 9);
-
-foreach $call (@args) {
- $call = uc $call;
- my $user = DXUser->get_current($call);
- if ($user) {
- $user->wantpc90(1);
- $user->put;
- push @out, $self->msg('set', 'PC90', $call);
- } else {
- push @out, $self->msg('e3', "Set PC90", $call);
- }
-}
-return (1, @out);
--- /dev/null
+#
+# unset the new protocol flag
+#
+# Copyright (c) 1998 - Dirk Koopman
+#
+# $Id$
+#
+
+my ($self, $line) = @_;
+my @args = split /\s+/, $line;
+my $call;
+my @out;
+
+@args = $self->call if (!@args || $self->priv < 9);
+
+foreach $call (@args) {
+ $call = uc $call;
+ my $user = DXUser->get_current($call);
+ if ($user) {
+ $user->wantnp(0);
+ $user->put;
+ push @out, $self->msg('unset', 'New Protocol', $call);
+ } else {
+ push @out, $self->msg('e3', "Unset New Protocol", $call);
+ }
+}
+return (1, @out);
--- /dev/null
+#
+# unset a user's passphrase
+#
+# Copyright (c) 2002 Dirk Koopman G1TLH
+#
+# Syntax: unset/passphrase <callsign> ...
+#
+
+my ($self, $line) = @_;
+my @args = split /\s+/, $line;
+my @out;
+my $user;
+my $ref;
+
+if ($self->remotecmd) {
+ Log('DXCommand', $self->call . " attempted to unset passphrase for @args remotely");
+ return (1, $self->msg('e5'));
+}
+
+if ($self->priv < 9) {
+ Log('DXCommand', $self->call . " attempted to unset passphrase for @args");
+ return (1, $self->msg('e5'));
+}
+
+for (@args) {
+ my $call = uc $_;
+ if ($ref = DXUser->get_current($call)) {
+ $ref->unset_passphrase;
+ $ref->put();
+ push @out, $self->msg("passphraseu", $call);
+ Log('DXCommand', $self->call . " unset passphrase for $call");
+ } else {
+ push @out, $self->msg('e3', 'User record for', $call);
+ }
+}
+
+return (1, @out);
+++ /dev/null
-#
-# unset the pc90 flag
-#
-# Copyright (c) 1998 - Dirk Koopman
-#
-# $Id$
-#
-
-my ($self, $line) = @_;
-my @args = split /\s+/, $line;
-my $call;
-my @out;
-
-@args = $self->call if (!@args || $self->priv < 9);
-
-foreach $call (@args) {
- $call = uc $call;
- my $user = DXUser->get_current($call);
- if ($user) {
- $user->wantpc90(0);
- $user->put;
- push @out, $self->msg('unset', 'PC90', $call);
- } else {
- push @out, $self->msg('e3', "Unset PC90", $call);
- }
-}
-return (1, @out);
{
my $ref = shift;
my $to = $ref->{to};
- my $uref = DXUser->get($to);
+ my $uref = DXUser->get_current($to);
my $dxchan = DXChannel->get($to);
if (((*Net::SMTP && $email_server) || $email_prog) && $uref && $uref->wantemail) {
my $email = $uref->email;
sub init
{
- my $user = DXUser->get($main::mycall);
- $DXProt::myprot_version += $main::version*100;
- $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 $@;
- $main::me->{sort} = 'S'; # S for spider
- $main::me->{priv} = 9;
- $main::me->{metric} = 0;
- $main::me->{pingave} = 0;
- $main::me->{version} = $main::version;
- $main::me->{build} = $main::build;
-
-# $Route::Node::me->adddxchan($main::me);
}
#
# send initialisation string
unless ($self->{outbound}) {
- $self->send(pc18());
+ $self->sendinit;
}
$self->state('init');
$script->run($self) if $script;
}
+#
+# send outgoing 'challenge'
+#
+
+sub sendinit
+{
+ my $self = shift;
+ $self->send(pc18());
+}
+
#
# This is the normal pcxx despatcher
#
return;
}
if ($pcno == 90) { # new style PC16,17,19,21
- my $node = $field[1];
-
- # mark this node as wanting PC90s
- my $parent = Route::Node::get($node);
- if ($parent) {
- my $t = hex $field[2];
- my $last = $parent->lastpc90 || 0;
- if ($last < $t) {
- $parent->pc90(1);
- $parent->lastpc90($t);
- my ($updsort, $n) = unpack "AA*", $field[3];
- for (my $i = 4; $i < $#field; $i++) {
- my ($sort, $flag, $node, $ping) = $field[$i] =~ m{(\w)(\d)([-\w+])(,\d+)?};
- $ping /= 10 if (defined $ping);
- }
- }
- }
-
return;
}
}
next if $dxchan == $main::me;
# send the pc50 or PC90
- if ($pc50s && $dxchan->user->wantpc90) {
- $dxchan->send_route(\&pc90, 1, $main::me, 'T', @dxchan);
- } else {
- $dxchan->send($pc50s) if $pc50s;
- }
+ $dxchan->send($pc50s) if $pc50s;
# send a ping out on this channel
if ($dxchan->{pingint} && $t >= $dxchan->{pingint} + $dxchan->{lastping}) {
dbg("sent a null value") if isdbg('chanerr');
}
}
- $self->send_route(\&pc90, 1, $main::me, 'T', DXChannel::get_all()) if $self->user->wantpc90;
}
#
# spider route broadcast
sub pc90
{
- my $node = shift;
- my $sort = shift;
- my @out;
- my $dxchan;
-
- while (@_) {
- my $str = '';
- for (; @_ && length $str <= 230;) {
- my $ref = shift;
- my $call = $ref->call;
- my $flag = 0;
-
- $flag += 1 if $ref->here;
- $flag += 2 if $ref->conf;
- if ($ref->is_node) {
- my $ping = int($ref->pingave * 10);
- $str .= "^N$flag$call,$ping";
- my $v = $ref->build || $ref->version;
- $str .= ",$v" if defined $v;
- } else {
- $str .= "^U$flag$call";
- }
- }
- push @out, $str if $str;
- }
- my $n = @out;
- my $h = get_hops(90);
- @out = map { sprintf "PC90^%s^%X^%s%d%s^%s^", $node->call, $main::systime, $sort, --$n, $_, $h } @out;
- return @out;
}
1;
priv => '9,Privilege Level',
lastin => '0,Last Time in,cldatetime',
passwd => '9,Password,yesno',
+ passphrase => '9,Pass Phrase,yesno',
addr => '0,Full Address',
'sort' => '0,Type of User', # A - ak1a, U - User, S - spider cluster, B - BBS
xpert => '0,Expert Status,yesno',
wantgrid => '0,DX Grid Info,yesno',
wantann_talk => '0,Talklike Anns,yesno',
wantpc90 => '1,Req PC90,yesno',
+ wantnp => '1,Req New Protocol,yesno',
lastoper => '9,Last for/oper,cldatetime',
nothere => '0,Not Here Text',
registered => '9,Registered?,yesno',
my $dxchan = DXChannel->get($call);
return $dxchan->user if $dxchan;
- my $data;
- unless ($dbm->get($call, $data)) {
- return decode($data);
- }
- return undef;
+ my $rref = Route::get($call);
+ return $rref->user if $rref && exists $rref->{user};
+ return $pkg->get($call);
}
#
my $self = shift;
delete $self->{passwd};
}
+
+sub unset_passphrase
+{
+ my $self = shift;
+ delete $self->{passphrase};
+}
1;
__END__
e29 => 'Need a password',
e30 => 'Cannot Open $_[0] $!',
e31 => '$_[0] is not a user',
+ e32 => 'Need a passphrase',
echoon => 'Echoing enabled',
echooff => 'Echoing disabled',
page => 'Press Enter to continue, A to abort ($_[0] lines) >',
pagelth => 'Page Length is now $_[0]',
passerr => 'Please use: SET/PASS <password> <callsign>',
+ passphrase => 'Passphrase set or changed for $_[0]',
+ passphraseu => 'Passphrase removed for $_[0]',
password => 'Password set or changed for $_[0]',
passwordu => 'Password removed for $_[0]',
pc90s => 'PC90 enabled for $_[0]',
use Route::Node;
use Script;
use DXProt;
+use Verify;
use strict;
$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 init
+{
+ my $user = DXUser->get($main::mycall);
+ $DXProt::myprot_version += $main::version*100;
+ $main::me = QXProt->new($main::mycall, 0, $user);
+ $main::me->{here} = 1;
+ $main::me->{state} = "indifferent";
+ $main::me->{sort} = 'S'; # S for spider
+ $main::me->{priv} = 9;
+ $main::me->{metric} = 0;
+ $main::me->{pingave} = 0;
+ $main::me->{registered} = 1;
+ $main::me->{version} = $main::version;
+ $main::me->{build} = $main::build;
+
+# $Route::Node::me->adddxchan($main::me);
+}
sub start
{
$self->SUPER::start(@_);
}
+sub sendinit
+{
+ my $self = shift;
+
+ $self->send($self->gen1);
+}
+
sub normal
{
if ($_[1] =~ /^PC\d\d\^/) {
DXProt::normal(@_);
return;
}
- my $pcno;
- return unless ($pcno) = $_[1] =~ /^QX(\d\d)\^/;
+ my ($id, $fromnode, $msgid, $incs);
+ return unless ($id, $fromnode, $msgid, $incs) = $_[1] =~ /^QX(\d\d)\^([-A-Z0-9]+)\^([0-9A-F]{1,4})\^.*\^([0-9A-F]{2})$/;
- 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');
+ my $noderef = Route::Node::get($fromnode);
+ $noderef = Route::Node::new($fromnode) unless $noderef;
+ my $user = DXChannel->get_current($fromnode);
+
+ my $il = length $incs;
+ my $cs = sprintf("%02X", unpack("%32C*", substr($_[1], 0, length($_[1]) - ($il+1))));
+ if ($incs ne $cs) {
+ dbg("QXPROT: Checksum fail in: $incs ne calc: $cs" ) if isdbg('chanerr');
return;
}
- # split the field for further processing
- my ($id, $tonode, $fromnode, @field) = split /\^/, $line;
-
+ return unless $noderef->newid($msgid);
+
+ $_[0]->handle($id, $fromnode, $msgid, $_[1]);
+ return;
+}
+
+sub handle
+{
+ no strict 'subs';
+ my $self = shift;
+ my $id = 0 + shift;
+ my $sub = "handle$id";
+ $self->$sub($self, @_) if $self->can($sub);
+ return;
}
+sub gen
+{
+ no strict 'subs';
+ my $self = shift;
+ my $id = 0 + shift;
+ my $sub = "gen$id";
+ $self->$sub($self, @_) if $self->can($sub);
+ return;
+}
+
+my $last_node_update = 0;
+my $node_update_interval = 60*15;
+
sub process
{
if ($main::systime >= $last_node_update+$node_update_interval) {
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;
-}
+my $msgid = 1;
sub frame
{
my $pcno = shift;
- my $to = shift || '';
- my $from = shift || $main::mycall;
+ my $ht;
+
+ $ht = sprintf "%X", $msgid;
+ my $line = join '^', sprintf("QX%02d", $pcno), $main::mycall, $ht, @_;
+ my $cs = sprintf "%02X", unpack("%32C*", $line) & 255;
+ $msgid = 1 if ++$msgid > 0xffff;
+ return "$line^$cs";
+}
+
+sub handle1
+{
+ my $self = shift;
- my $line = join '^', sprintf("QX%02d", $pcno), $to, $from, @_;
- my $cs = unpack("%32C*", $line) % 255;
- return $line . sprintf("^%02X", $cs);
+ my @f = split /\^/, $_[2];
+ my $inv = Verify->new($f[5]);
+ unless ($inv->verify($main::me->user->passphrase, $f[6], $main::mycall, $self->call)) {
+ $self->sendnow('D','Sorry...');
+ $self->disconnect;
+ }
+ if ($self->{outbound}) {
+ $self->send($self->gen1);
+ }
+ if ($self->{sort} ne 'S' && $f[2] eq 'DXSpider') {
+ $self->{user}->{sort} = $self->{sort} = 'S';
+ $self->{user}->{priv} = $self->{priv} = 1 unless $self->{priv};
+ }
+ $self->{version} = $f[3];
+ $self->{build} = $f[4];
+ $self->state('normal');
+ $self->{lastping} = 0;
+}
+
+sub gen1
+{
+ my $self = shift;
+ my $inp = Verify->new;
+ return frame(1, 1, "DXSpider", $main::version + 53, $main::build, $inp->challenge, $inp->response($self->user->passphrase, $self->call, $main::mycall));
+}
+
+sub handle2
+{
+
+}
+
+sub gen2
+{
+ my $self = shift;
+
+ my $node = shift;
+ my $sort = shift;
+ my @out;
+ my $dxchan;
+
+ while (@_) {
+ my $str = '';
+ for (; @_ && length $str <= 230;) {
+ my $ref = shift;
+ my $call = $ref->call;
+ my $flag = 0;
+
+ $flag += 1 if $ref->here;
+ $flag += 2 if $ref->conf;
+ if ($ref->is_node) {
+ my $ping = int($ref->pingave * 10);
+ $str .= "^N$flag$call,$ping";
+ my $v = $ref->build || $ref->version;
+ $str .= ",$v" if defined $v;
+ } else {
+ $str .= "^U$flag$call";
+ }
+ }
+ push @out, $str if $str;
+ }
+ my $n = @out;
+ my $h = get_hops(90);
+ @out = map { sprintf "PC90^%s^%X^%s%d%s^%s^", $node->call, $main::systime, $sort, --$n, $_, $h } @out;
+ return @out;
}
1;
users => '0,Users,parray',
usercount => '0,User Count',
version => '0,Version',
- pc90 => '0,Using PC90,yesno',
- lastpc90 => '0,Last PC90 time,cldatetime',
+ np => '0,Using New Prot,yesno',
+ lid => '0,Last Msgid',
);
$filterdef = $Route::filterdef;
$self->{flags} = shift;
$self->{users} = [];
$self->{nodes} = [];
+ $self->{lid} = 0;
$list{$call} = $self;
return values %list;
}
+sub newid
+{
+ my $self = shift;
+ my $id = shift;
+
+ return 0 if $id == $self->{lid};
+ if ($id > $self->{lid}) {
+ $self->{lid} = $id;
+ return 1;
+ } elsif ($self->{lid} - $id > 60000) {
+ $self->{id} = $id;
+ return 1;
+ }
+ return 0;
+}
+
sub _addparent
{
my $self = shift;
--- /dev/null
+#!/usr/bin/perl
+#
+# This module impliments the verification routines
+#
+# Copyright (c) 2002 Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+package Verify;
+
+use DXChannel;
+use DXUtil;
+use DXDebug;
+use Time::HiRes qw(gettimeofday);
+use Digest::SHA1 qw(sha1_base64);
+
+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;
+
+sub new
+{
+ my $class = shift;
+ my $self = bless {}, ref($class) || $class;
+ $self->{seed} = shift if @_;
+ return $self;
+}
+
+sub challenge
+{
+ my $self = shift;
+ my @t = gettimeofday();
+ my $r = unpack("xxNxx", pack("d", rand));
+ @t = map {$_ ^ $r} @t;
+ dbg("challenge r: $r seed: $t[0] $t[1]" ) if isdbg('verify');
+ $r = unpack("xxNxx", pack("d", rand));
+ @t = map {$_ ^ $r} @t;
+ dbg("challenge r: $r seed: $t[0] $t[1]" ) if isdbg('verify');
+ return $self->{seed} = sha1_base64(@t, gettimeofday, rand, rand, rand, @_);
+}
+
+sub response
+{
+ my $self = shift;
+ return sha1_base64($self->{seed}, @_);
+}
+
+sub verify
+{
+ my $self = shift;
+ my $answer = shift;
+ my $p = sha1_base64($self->{seed}, @_);
+ return $p eq $answer;
+}
+
+1;
use vars qw($VERSION $BRANCH $build $branch);
$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0;
-$main::build += 12; # add an offset to make it bigger than last system
+$main::build += 11; # add an offset to make it bigger than last system
$main::build += $VERSION;
$main::branch += $BRANCH;
# set up the basic channel info
# is there one already connected to me - locally?
- my $user = DXUser->get($call);
+ my $user = DXUser->get_current($call);
my $dxchan = DXChannel->get($call);
if ($dxchan) {
my $mess = DXM::msg($lang, ($user && $user->is_node) ? 'concluster' : 'conother', $call, $main::mycall);
# is he locked out ?
my $basecall = $call;
$basecall =~ s/-\d+$//;
- my $baseuser = DXUser->get($basecall);
+ my $baseuser = DXUser->get_current($basecall);
my $lock = $user->lockout if $user;
if ($baseuser && $baseuser->lockout || $lock) {
if (!$user || !defined $lock || $lock) {
# create the channel
- if ($user->is_spider) {
- $dxchan = QXProt->new($call, $conn, $user);
+ if ($user->wantnp) {
+ if ($user->passphrase && $main::me->user->passphrase) {
+ $dxchan = QXProt->new($call, $conn, $user);
+ } else {
+ unless ($user->passphrase) {
+ Log('DXCommand', "$call using NP but has no passphrase");
+ dbg("$call using NP but has no passphrase");
+ }
+ unless ($main::me->user->passphrase) {
+ Log('DXCommand', "$main::mycall using NP but has no passphrase");
+ dbg("$main::mycall using NP but has no passphrase");
+ }
+ already_conn($conn, $call, "Need to exchange passphrases");
+ return;
+ }
} elsif ($user->is_node) {
$dxchan = DXProt->new($call, $conn, $user);
} elsif ($user->is_user) {
# initialise the protocol engine
dbg("reading in duplicate spot and WWV info ...");
DXProt->init();
+QXProt->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($main::me->here)|Route::conf($main::me->conf));
projects / spider.git / commitdiff