From 148f4d43135748ba5aff985c50720b370ca1e336 Mon Sep 17 00:00:00 2001 From: minima Date: Thu, 11 Jul 2002 15:28:35 +0000 Subject: [PATCH] start work on NP stuff seriously --- Changes | 5 + cmd/Aliases | 1 + cmd/Commands_en.hlp | 6 +- cmd/set/{pc90.pl => newprotocol.pl} | 8 +- cmd/set/passphrase.pl | 38 ++++++ cmd/unset/{pc90.pl => newprotocol.pl} | 8 +- cmd/unset/passphrase.pl | 37 ++++++ perl/DXMsg.pm | 2 +- perl/DXProt.pm | 50 ++------ perl/DXProtout.pm | 29 ----- perl/DXUser.pm | 16 ++- perl/Messages | 3 + perl/QXProt.pm | 170 +++++++++++++++++++++----- perl/Route/Node.pm | 21 +++- perl/Verify.pm | 61 +++++++++ perl/cluster.pl | 24 +++- 16 files changed, 358 insertions(+), 121 deletions(-) rename cmd/set/{pc90.pl => newprotocol.pl} (66%) create mode 100644 cmd/set/passphrase.pl rename cmd/unset/{pc90.pl => newprotocol.pl} (65%) create mode 100644 cmd/unset/passphrase.pl create mode 100644 perl/Verify.pm diff --git a/Changes b/Changes index c36cc516..bb156973 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,8 @@ +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======================================================================= diff --git a/cmd/Aliases b/cmd/Aliases index d2a3c93e..e9cb882b 100644 --- a/cmd/Aliases +++ b/cmd/Aliases @@ -112,6 +112,7 @@ package CmdAlias; '^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', diff --git a/cmd/Commands_en.hlp b/cmd/Commands_en.hlp index 14fb84ad..41ec1441 100644 --- a/cmd/Commands_en.hlp +++ b/cmd/Commands_en.hlp @@ -1305,8 +1305,10 @@ The call must be written in full, no wild cards are allowed eg:- 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 diff --git a/cmd/set/pc90.pl b/cmd/set/newprotocol.pl similarity index 66% rename from cmd/set/pc90.pl rename to cmd/set/newprotocol.pl index cf906516..ae2054a2 100644 --- a/cmd/set/pc90.pl +++ b/cmd/set/newprotocol.pl @@ -1,5 +1,5 @@ # -# set the pc90 flag +# set the new protocol flag # # Copyright (c) 1998 - Dirk Koopman # @@ -17,11 +17,11 @@ foreach $call (@args) { $call = uc $call; my $user = DXUser->get_current($call); if ($user) { - $user->wantpc90(1); + $user->wantnp(1); $user->put; - push @out, $self->msg('set', 'PC90', $call); + push @out, $self->msg('set', 'New Protocol', $call); } else { - push @out, $self->msg('e3', "Set PC90", $call); + push @out, $self->msg('e3', "Set New Protocol", $call); } } return (1, @out); diff --git a/cmd/set/passphrase.pl b/cmd/set/passphrase.pl new file mode 100644 index 00000000..41334ffd --- /dev/null +++ b/cmd/set/passphrase.pl @@ -0,0 +1,38 @@ +# +# set a user's passphrase +# +# Copyright (c) 2002 Dirk Koopman G1TLH +# +# Syntax: set/passphrase +# + +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); diff --git a/cmd/unset/pc90.pl b/cmd/unset/newprotocol.pl similarity index 65% rename from cmd/unset/pc90.pl rename to cmd/unset/newprotocol.pl index 51dd2147..e14c2df0 100644 --- a/cmd/unset/pc90.pl +++ b/cmd/unset/newprotocol.pl @@ -1,5 +1,5 @@ # -# unset the pc90 flag +# unset the new protocol flag # # Copyright (c) 1998 - Dirk Koopman # @@ -17,11 +17,11 @@ foreach $call (@args) { $call = uc $call; my $user = DXUser->get_current($call); if ($user) { - $user->wantpc90(0); + $user->wantnp(0); $user->put; - push @out, $self->msg('unset', 'PC90', $call); + push @out, $self->msg('unset', 'New Protocol', $call); } else { - push @out, $self->msg('e3', "Unset PC90", $call); + push @out, $self->msg('e3', "Unset New Protocol", $call); } } return (1, @out); diff --git a/cmd/unset/passphrase.pl b/cmd/unset/passphrase.pl new file mode 100644 index 00000000..213e4f92 --- /dev/null +++ b/cmd/unset/passphrase.pl @@ -0,0 +1,37 @@ +# +# unset a user's passphrase +# +# Copyright (c) 2002 Dirk Koopman G1TLH +# +# Syntax: unset/passphrase ... +# + +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); diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index 17e96176..552709dd 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -435,7 +435,7 @@ sub notify { 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; diff --git a/perl/DXProt.pm b/perl/DXProt.pm index f68edc27..750b8883 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -185,21 +185,8 @@ sub check 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); } # @@ -278,7 +265,7 @@ sub start # send initialisation string unless ($self->{outbound}) { - $self->send(pc18()); + $self->sendinit; } $self->state('init'); @@ -292,6 +279,16 @@ sub start $script->run($self) if $script; } +# +# send outgoing 'challenge' +# + +sub sendinit +{ + my $self = shift; + $self->send(pc18()); +} + # # This is the normal pcxx despatcher # @@ -1252,24 +1249,6 @@ sub normal 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; } } @@ -1314,11 +1293,7 @@ sub process 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}) { @@ -1620,7 +1595,6 @@ sub send_local_config dbg("sent a null value") if isdbg('chanerr'); } } - $self->send_route(\&pc90, 1, $main::me, 'T', DXChannel::get_all()) if $self->user->wantpc90; } # diff --git a/perl/DXProtout.pm b/perl/DXProtout.pm index 38ace99b..67376e11 100644 --- a/perl/DXProtout.pm +++ b/perl/DXProtout.pm @@ -363,35 +363,6 @@ sub pc85 # 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; diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 277b2a5f..1e06cd3c 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -44,6 +44,7 @@ $lasttime = 0; 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', @@ -73,6 +74,7 @@ $lasttime = 0; 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', @@ -200,11 +202,9 @@ sub get_current 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); } # @@ -596,6 +596,12 @@ sub unset_passwd my $self = shift; delete $self->{passwd}; } + +sub unset_passphrase +{ + my $self = shift; + delete $self->{passphrase}; +} 1; __END__ diff --git a/perl/Messages b/perl/Messages index 76234bce..e9a32707 100644 --- a/perl/Messages +++ b/perl/Messages @@ -85,6 +85,7 @@ package DXM; e29 => 'Need a password', e30 => 'Cannot Open $_[0] $!', e31 => '$_[0] is not a user', + e32 => 'Need a passphrase', echoon => 'Echoing enabled', echooff => 'Echoing disabled', @@ -195,6 +196,8 @@ package DXM; page => 'Press Enter to continue, A to abort ($_[0] lines) >', pagelth => 'Page Length is now $_[0]', passerr => 'Please use: SET/PASS ', + 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]', diff --git a/perl/QXProt.pm b/perl/QXProt.pm index f3a69128..b277e3bd 100644 --- a/perl/QXProt.pm +++ b/perl/QXProt.pm @@ -29,6 +29,7 @@ use Route; use Route::Node; use Script; use DXProt; +use Verify; use strict; @@ -38,11 +39,23 @@ $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 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 { @@ -50,31 +63,62 @@ 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) { @@ -92,9 +136,6 @@ sub disconnect 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 @@ -102,21 +143,88 @@ 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; diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm index e7a6f8e4..ff3351b3 100644 --- a/perl/Route/Node.pm +++ b/perl/Route/Node.pm @@ -29,8 +29,8 @@ use vars qw(%list %valid @ISA $max $filterdef); 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; @@ -224,6 +224,7 @@ sub new $self->{flags} = shift; $self->{users} = []; $self->{nodes} = []; + $self->{lid} = 0; $list{$call} = $self; @@ -244,6 +245,22 @@ sub get_all 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; diff --git a/perl/Verify.pm b/perl/Verify.pm new file mode 100644 index 00000000..2d89495f --- /dev/null +++ b/perl/Verify.pm @@ -0,0 +1,61 @@ +#!/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; diff --git a/perl/cluster.pl b/perl/cluster.pl index b33a8b6e..6893b708 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -122,7 +122,7 @@ $reqreg = 0; # 1 = registration required, 2 = deregister people 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; @@ -160,7 +160,7 @@ sub new_channel # 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); @@ -171,7 +171,7 @@ sub new_channel # 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) { @@ -190,8 +190,21 @@ sub new_channel # 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) { @@ -457,6 +470,7 @@ Spot->init(); # 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)); -- 2.43.0