From 598233c22daef138cd7b0a653d3165b4a16905e2 Mon Sep 17 00:00:00 2001 From: minima Date: Mon, 5 Jul 2004 17:21:27 +0000 Subject: [PATCH] wip --- Changes | 2 + data/bands.pl | 2 +- perl/DXChannel.pm | 3 +- perl/DXProt.pm | 187 ++++++++++++++++++++++++++++++++++++--------- perl/DXProtout.pm | 64 +++++++++++++++- perl/Route.pm | 36 ++++++--- perl/Route/Node.pm | 81 +++++--------------- perl/Route/User.pm | 20 +---- 8 files changed, 268 insertions(+), 127 deletions(-) diff --git a/Changes b/Changes index 4792fdc0..dff781ad 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,7 @@ 05Jul04======================================================================= 1. fix rspfcheck on pc27 +24Jun04======================================================================= +1. reduced lower limit of 13cm band to 2304Mhz 23Jun04======================================================================= 1. Add zone, by_zone, itu, by_itu, state and by_state searches to sh/dx 2. Update manuals for CVS and new commands diff --git a/data/bands.pl b/data/bands.pl index 9d98a173..60d2896e 100644 --- a/data/bands.pl +++ b/data/bands.pl @@ -121,7 +121,7 @@ ssb => [1296150, 1296800], }, 'Bands'), - '13cm' => bless( { band => [2310000, 2450000], + '13cm' => bless( { band => [2304000, 2450000], cw => [2320100, 2320150], ssb => [2320150, 2320800], }, 'Bands'), diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 3b3ac62f..3ae6afd6 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -113,6 +113,7 @@ $count = 0; version => '1,Node Version', build => '1,Node Build', verified => '9,Verified?,yesno', + newroute => '1,New Style Routing,yesno', ); use vars qw($VERSION $BRANCH); @@ -637,7 +638,7 @@ sub AUTOLOAD # this clever line of code creates a subroutine which takes over from autoload # from OO Perl - Conway *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}}; - goto &$AUTOLOAD; + goto &$AUTOLOAD; } diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 0d222859..fb09e99d 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -887,6 +887,7 @@ sub handle_18 $self->version($_[2] / 100) if $_[2] && $_[2] =~ /^\d+$/; $self->user->version($self->version); } + $self->newroute( $_[1] =~ /NewRoute/ ); # first clear out any nodes on this dxchannel my $parent = Route::Node::get($self->{call}); @@ -931,7 +932,7 @@ sub handle_19 my $user = DXUser->get_current($origin); if (!$user) { $user = DXUser->new($origin); - $user->sort('S'); + $user->sort('A'); $user->priv(1); # I have relented and defaulted nodes $user->lockout(1); $user->homenode($origin); @@ -1498,6 +1499,116 @@ sub handle_51 } } +# New style routing handler +sub handle_59 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + my $origin = shift; + + return unless eph_dup($line); + + my ($sort, $hextime, $ncall) = @_[1,2,3]; + if ($ncall eq $main::mycall) { + dbg("PCPROT: ignoring PC59 for me") if isdbg('chan'); + return; + } + + # mark myself as NewRoute if I get a PC59 + $self->{newroute} = 1 if $ncall eq $self->{call}; + + # do this once for filtering with a throwaway routing entry if a new node + my $fnode = Route::Node::get($ncall) || Route::new($ncall); + return unless $self->in_filter_route($fnode); + + # now do it properly for actions + my $node = Route::Node::get($ncall) || Route::Node::new($ncall); + + # find each of the entries (or create new ones) + my @refs; + for my $ent (@_[4..-1]) { + my ($esort, $ehere, $ecall) = unpack "A A A*", $ent; + my $ref; + + # create user, if required + my $user = DXUser->get_current($ecall); + unless ($user) { + $user = DXUser->new($ecall); + $user->sort(); + $user->priv(1); # I have relented and defaulted nodes + $user->lockout(1); + $user->homenode($call); + $user->node($call); + } + if ($esort eq 'U') { + $ref = Route::User::get($ecall); + unless ($ref) { + # create user, if required + my $user = DXUser->get_current($ecall); + unless ($user) { + $user = DXUser->new($ecall); + $user->sort('U'); + $user->homenode($ncall); + $user->node($ncall); + $user->put; + } + $ref = Route::User::new($ecall, 0); + } + } elsif ($esort eq 'N') { + $ref = Route::Node::get($ecall); + unless ($ref) { + # create user, if required + my $user = DXUser->get_current($ecall); + unless ($user) { + $user = DXUser->new($ecall); + $user->priv(1); # I have relented and defaulted nodes + $user->lockout(1); + $user->sort('A'); + $user->homenode($ncall); + $user->node($ncall); + $user->put; + } + $ref = Route::Node::new($ecall, 0); + } + } else { + dbg("DXPROT: unknown entity type '$esort' on $ecall for node $ncall") if isdbg('chan'); + next; + } + $ref->here($here); # might as well set this here + push @refs, $ref; + } + + # if it is a delete or a configure, disconnect all the entries mentioned + # from this node (which is a parent in this context). + my @del; + if ($sort eq 'D' || $sort eq 'C') { + for my $ref (@refs) { + next if $ref->call eq $ncall; + if ($ref->isa('Route::Node')) { + push @del, $ref->del($node); + } elsif ($ref->isa('Route::User')) { + push @del, $node->del_user($ref); + } + } + } + + # if it is an add or a configure, connect all the entries + my @add; + if ($sort eq 'A' || $sort eq 'C') { + for my $ref (@refs) { + next if $ref->call eq $ncall; + if ($ref->isa('Route::Node')) { + my $new = $node->add($ref->call); + push @add, $new if $new; + } elsif ($ref->isa('Route::User')) { + push @add, $node->add_user($ref->call); + } + } + } +} + + # dunno but route it sub handle_75 { @@ -1921,42 +2032,48 @@ sub send_local_config my @remotenodes; dbg('DXProt::send_local_config') if isdbg('trace'); - - # send our nodes - if ($self->{isolate}) { - @localnodes = ( $main::routeroot ); - $self->send_route($main::mycall, \&pc19, 1, $main::routeroot); + + if ($self->{newroute}) { + my @nodes = $self->{isolate} ? ($main::routeroot) : grep { $_->call ne $main::mycall && $_ != $self && !$_->{isolate} } DXChannel::get_all_nodes(); + my @users = DXChannel::get_all_users(); + $self->send_route($main::mycall, \&pc59c, @nodes+@users+1, (grep { Route::get($_) } $main::routeroot, @nodes, @users)); } else { - # create a list of all the nodes that are not connected to this connection - # and are not themselves isolated, this to make sure that isolated nodes - # don't appear outside of this node - - # send locally connected nodes - my @dxchan = grep { $_->call ne $main::mycall && $_ != $self && !$_->{isolate} } DXChannel::get_all_nodes(); - @localnodes = map { my $r = Route::Node::get($_->{call}); $r ? $r : () } @dxchan if @dxchan; - $self->send_route($main::mycall, \&pc19, scalar(@localnodes)+1, $main::routeroot, @localnodes); - - my $node; - my @rawintcalls = map { $_->nodes } @localnodes if @localnodes; - my @intcalls; - for $node (@rawintcalls) { - push @intcalls, $node unless grep $node eq $_, @intcalls; - } - my $ref = Route::Node::get($self->{call}); - my @rnodes = $ref->nodes; - for $node (@intcalls) { - push @remotenodes, Route::Node::get($node) unless grep $node eq $_, @rnodes, @remotenodes; - } - $self->send_route($main::mycall, \&pc19, scalar(@remotenodes), @remotenodes); - } - - # get all the users connected on the above nodes and send them out - foreach $node ($main::routeroot, @localnodes, @remotenodes) { - if ($node) { - my @rout = map {my $r = Route::User::get($_); $r ? ($r) : ()} $node->users; - $self->send_route($main::mycall, \&pc16, 1, $node, @rout) if @rout && $self->user->wantsendpc16; + # send our nodes + if ($self->{isolate}) { + @localnodes = ( $main::routeroot ); + $self->send_route($main::mycall, \&pc19, 1, $main::routeroot); } else { - dbg("sent a null value") if isdbg('chanerr'); + # create a list of all the nodes that are not connected to this connection + # and are not themselves isolated, this to make sure that isolated nodes + # don't appear outside of this node + + # send locally connected nodes + my @dxchan = grep { $_->call ne $main::mycall && $_ != $self && !$_->{isolate} } DXChannel::get_all_nodes(); + @localnodes = map { my $r = Route::Node::get($_->{call}); $r ? $r : () } @dxchan if @dxchan; + $self->send_route($main::mycall, \&pc19, scalar(@localnodes)+1, $main::routeroot, @localnodes); + + my $node; + my @rawintcalls = map { $_->nodes } @localnodes if @localnodes; + my @intcalls; + for $node (@rawintcalls) { + push @intcalls, $node unless grep $node eq $_, @intcalls; + } + my $ref = Route::Node::get($self->{call}); + my @rnodes = $ref->nodes; + for $node (@intcalls) { + push @remotenodes, Route::Node::get($node) unless grep $node eq $_, @rnodes, @remotenodes; + } + $self->send_route($main::mycall, \&pc19, scalar(@remotenodes), @remotenodes); + } + + # get all the users connected on the above nodes and send them out + foreach $node ($main::routeroot, @localnodes, @remotenodes) { + if ($node) { + my @rout = map {my $r = Route::User::get($_); $r ? ($r) : ()} $node->users; + $self->send_route($main::mycall, \&pc16, 1, $node, @rout) if @rout && $self->user->wantsendpc16; + } else { + dbg("sent a null value") if isdbg('chanerr'); + } } } } diff --git a/perl/DXProtout.pm b/perl/DXProtout.pm index b31eacdf..f08fef49 100644 --- a/perl/DXProtout.pm +++ b/perl/DXProtout.pm @@ -123,7 +123,7 @@ sub pc17 # Request init string sub pc18 { - return "PC18^DXSpider Version: $main::version Build: $main::build^$DXProt::myprot_version^"; + return "PC18^DXSpider Version: $main::version Build: $main::build NewRoute^$DXProt::myprot_version^"; } # @@ -358,6 +358,68 @@ sub pc51 return "PC51^$to^$from^$val^"; } +my $hexlasttime = 0; +my $hexlastlet = 'A'; + +sub hexstamp +{ + my $t = shift || $main::systime; + if ($t ne $hexlasttime) { + $hexlasttime = $t; + $hexlastlet = 'A'; + } else { + do { + $hexlastlet = chr(ord($hexlastlet) + 1); + } while ($hexlastlet eq '^'); + } + return sprintf "%c%08X", $hexlastlet, $hexlasttime; +} + +sub pc58 +{ + my $sort = shift; + my $hexstamp = shift || hexstamp(); + my $from = shift; + my $to = shift; + my $text = unpad(shift); + $text = ' ' if !$text; + $text =~ s/\^/%5E/g; + return "PC58^$sort^$hexstamp^$from^$to^$text" . sprintf "^%s^", get_hops(58); +} + +sub pc59 +{ + my @out; + my $sort = shift; + my $hexstamp = shift || hexstamp(); + + my $node = $_[0]->call; + for (@_) { + next unless $_; + my $ref = $_; + my $call = $ref->call; + my $here = $ref->here; + $s .= $ref->isa('Route::Node') ? "^N$here$call" : "^U$here$call"; + } + push @out, "PC59^$sort^$hexstamp^$node^$s" . sprintf "^%s^", get_hops(59); + return @out; +} + +sub PC59c +{ + return PC59('C', @_); +} + +sub PC59a +{ + return PC59('A', @_); +} + +sub PC59d +{ + return PC59('D', @_); +} + # clx remote cmd send sub pc84 { diff --git a/perl/Route.pm b/perl/Route.pm index 0f52e39b..0e9b6139 100644 --- a/perl/Route.pm +++ b/perl/Route.pm @@ -37,6 +37,7 @@ use vars qw(%list %valid $filterdef); cq => '0,CQ Zone', state => '0,State', city => '0,City', + lastseen => 'Last Seen,atime', ); $filterdef = bless ([ @@ -165,12 +166,6 @@ sub conf return $r ? 1 : 0; } -sub parents -{ - my $self = shift; - return @{$self->{parent}}; -} - # # display routines # @@ -287,8 +282,8 @@ sub alldxchan # it isn't, build up a list of dxchannels and possible ping times # for all the candidates. unless (@dxchan) { - foreach my $p (@{$self->{parent}}) { -# dbg("Trying parent $p") if isdbg('routech'); + foreach my $p (@{$self->{dxchan}}) { +# dbg("Trying dxchan $p") if isdbg('routech'); next if $p eq $main::mycall; # the root my $dxchan = DXChannel->get($p); if ($dxchan) { @@ -305,7 +300,7 @@ sub alldxchan return @dxchan; } -sub dxchan +sub bestdxchan { my $self = shift; @@ -329,6 +324,29 @@ sub dxchan return $dxchan; } +sub _adddxchan +{ + my $self = shift; + return $self->_addlist('dxchan', @_); +} + +sub _deldxchan +{ + my $self = shift; + return $self->_dellist('dxchan', @_); +} + +sub _addnode +{ + my $self = shift; + return $self->_addlist('nodes', @_); +} + +sub _delnode +{ + my $self = shift; + return $self->_dellist('nodes', @_); +} # diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm index 3c4addd0..92ceba22 100644 --- a/perl/Route/Node.pm +++ b/perl/Route/Node.pm @@ -24,7 +24,7 @@ use vars qw(%list %valid @ISA $max $filterdef); @ISA = qw(Route); %valid = ( - parent => '0,Parent Calls,parray', + dxchan => '0,Visible on DXChans,parray', nodes => '0,Nodes,parray', users => '0,Users,parray', usercount => '0,User Count', @@ -59,22 +59,22 @@ sub max # object with that callsign. The upper layers are expected to do something # sensible with this! # -# called as $parent->add(call, dxchan, version, flags) +# called as $dxchan->add(call, dxchan, version, flags) # sub add { - my $parent = shift; + my $dxchan = shift; my $call = uc shift; - confess "Route::add trying to add $call to myself" if $call eq $parent->{call}; + confess "Route::add trying to add $call to myself" if $call eq $dxchan->{call}; my $self = get($call); if ($self) { - $self->_addparent($parent); - $parent->_addnode($self); + $self->_adddxchan($dxchan); + $dxchan->_addnode($self); return undef; } - $self = $parent->new($call, @_); - $parent->_addnode($self); + $self = $dxchan->new($call, @_); + $dxchan->_addnode($self); return $self; } @@ -90,14 +90,14 @@ sub del my $self = shift; my $pref = shift; - # delete parent from this call's parent list + # delete dxchan from this call's dxchan list $pref->_delnode($self); - $self->_delparent($pref); + $self->_deldxchan($pref); my @nodes; my $ncall = $self->{call}; - # is this the last connection, I have no parents anymore? - unless (@{$self->{parent}}) { + # is this the last connection, I have no dxchan anymore? + unless (@{$self->{dxchan}}) { foreach my $rcall (@{$self->{nodes}}) { next if grep $rcall eq $_, @_; my $r = Route::Node::get($rcall); @@ -112,11 +112,11 @@ sub del sub del_nodes { - my $parent = shift; + my $dxchan = shift; my @out; - foreach my $rcall (@{$parent->{nodes}}) { + foreach my $rcall (@{$dxchan->{nodes}}) { my $r = get($rcall); - push @out, $r->del($parent, $parent->{call}, @_) if $r; + push @out, $r->del($dxchan, $dxchan->{call}, @_) if $r; } return @out; } @@ -142,7 +142,7 @@ sub add_user my $uref = Route::User::get($ucall); my @out; if ($uref) { - @out = $uref->addparent($self); + @out = $uref->adddxchan($self); } else { $uref = Route::User->new($ucall, $self->{call}, @_); @out = $uref; @@ -191,12 +191,6 @@ sub nodes return @{$self->{nodes}}; } -sub parents -{ - my $self = shift; - return @{$self->{parent}}; -} - sub rnodes { my $self = shift; @@ -219,7 +213,7 @@ sub new confess "already have $call in $pkg" if $list{$call}; my $self = $pkg->SUPER::new($call); - $self->{parent} = ref $pkg ? [ $pkg->{call} ] : [ ]; + $self->{dxchan} = ref $pkg ? [ $pkg->{call} ] : [ ]; $self->{version} = shift; $self->{flags} = shift; $self->{users} = []; @@ -245,47 +239,6 @@ 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 > 500) { - $self->{id} = $id; - return 1; - } - return 0; -} - -sub _addparent -{ - my $self = shift; - return $self->_addlist('parent', @_); -} - -sub _delparent -{ - my $self = shift; - return $self->_dellist('parent', @_); -} - - -sub _addnode -{ - my $self = shift; - return $self->_addlist('nodes', @_); -} - -sub _delnode -{ - my $self = shift; - return $self->_dellist('nodes', @_); -} - sub _adduser { diff --git a/perl/Route/User.pm b/perl/Route/User.pm index b9862e6d..88d2aa2a 100644 --- a/perl/Route/User.pm +++ b/perl/Route/User.pm @@ -23,7 +23,7 @@ use vars qw(%list %valid @ISA $max $filterdef); @ISA = qw(Route); %valid = ( - parent => '0,Parent Calls,parray', + dxchan => '0,Dxchan Calls,parray', ); $filterdef = $Route::filterdef; @@ -52,7 +52,7 @@ sub new confess "already have $call in $pkg" if $list{$call}; my $self = $pkg->SUPER::new($call); - $self->{parent} = [ $ncall ]; + $self->{nodes} = [ $ncall ]; $self->{flags} = $flags; $list{$call} = $self; @@ -68,8 +68,8 @@ sub del { my $self = shift; my $pref = shift; - $self->delparent($pref); - unless (@{$self->{parent}}) { + $self->deldxchan($pref); + unless (@{$self->{dxchan}}) { delete $list{$self->{call}}; return $self; } @@ -85,18 +85,6 @@ sub get return $ref; } -sub addparent -{ - my $self = shift; - return $self->_addlist('parent', @_); -} - -sub delparent -{ - my $self = shift; - return $self->_dellist('parent', @_); -} - # # generic AUTOLOAD for accessors # -- 2.43.0