From: Dirk Koopman Date: Tue, 24 Jun 2008 18:36:57 +0000 (+0100) Subject: New improved route finding algorithm X-Git-Tag: 1.56~82 X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=c1540ccd7990ec4bd151604dd63583d19fe4d0f6;p=spider.git New improved route finding algorithm This is what Changes says: Change the route finding algorithm completely. No more recursion. No more tree searching. It now gives you answers even on a partial cluster map. Oh and the answers are correct, instead on completely random. Also completely remove RouteDB from the equation. Also change sh/newc to default to node map rather than node+user map. --- diff --git a/Changes b/Changes index 88feeaef..86906d0d 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,7 @@ +24Jun08======================================================================= +1. Change the route finding algorithm completely. No more recursion. No more +tree searching. It now gives you answers even on a partial cluster map. Oh +and the answers are correct, instead on completely random. 28May08======================================================================= 1. remove "recursion limit" message from Route.pm 28May08======================================================================= diff --git a/cmd/Commands_en.hlp b/cmd/Commands_en.hlp index d0cce0da..a7a82996 100644 --- a/cmd/Commands_en.hlp +++ b/cmd/Commands_en.hlp @@ -2331,17 +2331,18 @@ So if you have said: ACC/SPOT on hf Doing a SHOW/MYDX will now only, ever, show HF spots. All the other options on SH/DX can still be used. -=== 0^SHOW/NEWCONFIGURATION []^Show all the nodes and users visible -This command allows you to see all the users that can be seen -and the nodes to which they are connected. +=== 0^SHOW/NEWCONFIGURATION [USERS|]^Show the cluster map +Show the map of the whole cluster. -This command produces essentially the same information as -SHOW/CONFIGURATION except that it shows all the duplication of -any routes that might be present It also uses a different format -which may not take up quite as much space if you don't have any -loops. +This shows the structure of the cluster that you are connected to. By +default it will only show the nodes that are known. By adding the keyword +USER to the command it will show all the users as well. -BE WARNED: the list that is returned can be VERY long +As there will be loops, you will see '...', this means that the information +is as printed earlier and that is a looped connection from here on. + +BE WARNED: the list that is returned can be VERY long (particularly +with the USER keyword) === 0^SHOW/NEWCONFIGURATION/NODE^Show all the nodes connected locally Show all the nodes connected to this node in the new format. diff --git a/cmd/ping.pl b/cmd/ping.pl index 1ea9dda8..32efda31 100644 --- a/cmd/ping.pl +++ b/cmd/ping.pl @@ -21,7 +21,6 @@ return (1, $self->msg('pinge1')) if $call eq $main::mycall; # can we see it? Is it a node? my $noderef = Route::Node::get($call); -$noderef = RouteDB::get($call) unless $noderef; return (1, $self->msg('e7', $call)) unless $noderef; diff --git a/cmd/show/newconfiguration.pl b/cmd/show/newconfiguration.pl index 63414e06..30939442 100644 --- a/cmd/show/newconfiguration.pl +++ b/cmd/show/newconfiguration.pl @@ -9,10 +9,10 @@ my ($self, $line) = @_; my @list = map { uc } split /\s+/, $line; # list of callsigns of nodes my @out; -my $nodes_only; +my $nodes_only = 1; -if (@list && $list[0] =~ /^NOD/) { - $nodes_only++; +if (@list && $list[0] =~ /^USE/) { + $nodes_only = 0; shift @list; } diff --git a/cmd/show/route.pl b/cmd/show/route.pl index 04eecd86..c927e8dc 100644 --- a/cmd/show/route.pl +++ b/cmd/show/route.pl @@ -12,8 +12,6 @@ my @out; return (1, $self->msg('e6')) unless @list; -use RouteDB; - my $l; foreach $l (@list) { my $ref = Route::get($l); @@ -23,13 +21,6 @@ foreach $l (@list) { } else { push @out, $self->msg('e7', $l); } - my @in = RouteDB::_sorted($l); - if (@in) { - push @out, "Learned Routes:"; - for (@in) { - push @out, "$l via $_->{call} count: $_->{count} last heard: " . atime($_->{t}); - } - } } return (1, @out); diff --git a/perl/DXProt.pm b/perl/DXProt.pm index e0144349..5694ba05 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -32,7 +32,6 @@ use DXHash; use Route; use Route::Node; use Script; -use RouteDB; use DXProtHandle; use strict; @@ -1037,19 +1036,6 @@ sub route } } - # try the backstop method - unless ($dxchan) { - my $rcall = RouteDB::get($call); - if ($rcall) { - if ($self && $rcall eq $self->{call}) { - dbg("PCPROT: Trying to route back to source, dropped") if isdbg('chanerr'); - return; - } - $dxchan = DXChannel::get($rcall); - dbg("route: $call -> $rcall using RouteDB" ) if isdbg('route') && $dxchan; - } - } - if ($dxchan) { my $routeit = adjust_hops($dxchan, $line); # adjust its hop count by node name if ($routeit) { @@ -1228,7 +1214,7 @@ sub disconnect # do routing stuff, remove me from routing table my $node = Route::Node::get($call); - RouteDB::delete_interface($call); + Route::delete_interface($call); # unbusy and stop and outgoing mail my $mref = DXMsg::get_busy($call); diff --git a/perl/DXProtHandle.pm b/perl/DXProtHandle.pm index cb13e37c..b3f03222 100644 --- a/perl/DXProtHandle.pm +++ b/perl/DXProtHandle.pm @@ -32,8 +32,6 @@ use DXHash; use Route; use Route::Node; use Script; -use RouteDB; - use strict; @@ -122,10 +120,6 @@ sub handle_10 } } - # remember a route to this node and also the node on which this user is - RouteDB::update($_[6], $self->{call}); -# RouteDB::update($to, $_[6]); - # convert this to a PC93, coming from mycall with origin set and process it as such $main::me->normal(pc93($to, $from, $via, $_[3], $_[6])); } @@ -203,10 +197,6 @@ sub handle_11 } } - # remember a route -# RouteDB::update($_[7], $self->{call}); -# RouteDB::update($_[6], $_[7]); - my @spot = Spot::prepare($_[1], $_[2], $d, $_[5], $nossid, $_[7]); # global spot filtering on INPUT if ($self->{inspotsfilter}) { @@ -338,10 +328,6 @@ sub handle_12 $self->send_chat(0, $line, @_[1..6]); } elsif ($_[2] eq '*' || $_[2] eq $main::mycall) { - # remember a route -# RouteDB::update($_[5], $self->{call}); -# RouteDB::update($_[1], $_[5]); - # ignore something that looks like a chat line coming in with sysop # flag - this is a kludge... if ($_[3] =~ /^\#\d+ / && $_[4] eq '*') { @@ -422,7 +408,6 @@ sub handle_16 my $h; $h = 1 if DXChannel::get($ncall); - RouteDB::update($ncall, $self->{call}, $h); if ($h && $self->{call} ne $ncall) { dbg("PCPROT: trying to update a local node, ignored") if isdbg('chanerr'); return; @@ -542,8 +527,6 @@ sub handle_17 return; } - RouteDB::delete($ncall, $self->{call}); - my $uref = Route::User::get($ucall); unless ($uref) { dbg("PCPROT: Route::User $ucall not in config") if isdbg('chanerr'); @@ -737,7 +720,6 @@ sub handle_19 # next; # } - RouteDB::update($call, $self->{call}, $dxchan ? 1 : undef); unless ($h) { if ($parent->via_pc92) { @@ -843,8 +825,6 @@ sub handle_21 # we don't need any isolation code here, because we will never # act on a PC21 with self->call in it. - RouteDB::delete($call, $self->{call}); - my $parent = Route::Node::get($self->{call}); unless ($parent) { dbg("PCPROT: my parent $self->{call} has disappeared"); @@ -1241,13 +1221,12 @@ sub handle_50 my $call = $_[1]; - RouteDB::update($call, $self->{call}); - my $node = Route::Node::get($call); if ($node) { return unless $node->call eq $self->{call}; $node->usercount($_[2]) unless $node->users; $node->reset_obs; + $node->PC92C_dxchan($self->call, $_[-1]); # input filter if required # return unless $self->in_filter_route($node); @@ -1279,9 +1258,6 @@ sub handle_51 DXXml::Ping::handle_ping_reply($self, $from); } } else { - - RouteDB::update($from, $self->{call}); - if (eph_dup($line)) { return; } @@ -1415,6 +1391,9 @@ sub _add_thingy { my $parent = shift; my $s = shift; + my $dxchan = shift; + my $hops = shift; + my ($call, $is_node, $is_extnode, $here, $version, $build) = @$s; my @rout; @@ -1422,6 +1401,8 @@ sub _add_thingy if ($is_node) { dbg("ROUTE: added node $call to " . $parent->call) if isdbg('routelow'); @rout = $parent->add($call, $version, Route::here($here)); + my $r = Route::Node::get($call); + $r->PC92C_dxchan($dxchan->call, $hops) if $r; } else { dbg("ROUTE: added user $call to " . $parent->call) if isdbg('routelow'); @rout = $parent->add_user($call, Route::here($here)); @@ -1579,6 +1560,7 @@ sub pc92_handle_first_slot my $slot = shift; my $parent = shift; my $t = shift; + my $hops = shift; my $oparent = $parent; my @radd; @@ -1603,7 +1585,7 @@ sub pc92_handle_first_slot # from the true parent node for this external before we get one for the this node unless ($parent = Route::Node::get($call)) { if ($is_extnode && $oparent) { - @radd = _add_thingy($oparent, $slot); + @radd = _add_thingy($oparent, $slot, $self, $hops); $parent = $radd[0]; } else { dbg("PCPROT: no previous C or A for this external node received, ignored") if isdbg('chanerr'); @@ -1612,7 +1594,7 @@ sub pc92_handle_first_slot } $parent = check_pc9x_t($call, $t, 92) || return; $parent->via_pc92(1); - $parent->PC92C_dxchan($self->{call}); + $parent->PC92C_dxchan($self->{call}, $hops); } } else { dbg("PCPROT: must be \$mycall or external node as first entry, ignored") if isdbg('chanerr'); @@ -1621,7 +1603,7 @@ sub pc92_handle_first_slot $parent->here(Route::here($here)); $parent->version($version || $pc19_version) if $version; $parent->build($build) if $build; - $parent->PC92C_dxchan($self->{call}) unless $self->{call} eq $parent->call; + $parent->PC92C_dxchan($self->{call}, $hops) unless $self->{call} eq $parent->call; return ($parent, @radd); } @@ -1638,6 +1620,7 @@ sub handle_92 my $pcall = $_[1]; my $t = $_[2]; my $sort = $_[3]; + my $hops = $_[-1]; # this catches loops of A/Ds # if (eph_dup($line, $pc9x_dupe_age)) { @@ -1722,14 +1705,14 @@ sub handle_92 $pc92Kin += length $line; # remember the last channel we arrived on - $parent->PC92C_dxchan($self->{call}) unless $self->{call} eq $parent->call; + $parent->PC92C_dxchan($self->{call}, $hops) unless $self->{call} eq $parent->call; my @ent = _decode_pc92_call($_[4]); if (@ent) { my $add; - ($parent, $add) = $self->pc92_handle_first_slot(\@ent, $parent, $t); + ($parent, $add) = $self->pc92_handle_first_slot(\@ent, $parent, $t, $hops); return unless $parent; # dupe push @radd, $add if $add; @@ -1746,7 +1729,7 @@ sub handle_92 $pc92Din += length $line if $sort eq 'D'; # remember the last channel we arrived on - $parent->PC92C_dxchan($self->{call}) unless $self->{call} eq $parent->call; + $parent->PC92C_dxchan($self->{call}, $hops) unless $self->{call} eq $parent->call; # this is the main route section # here is where all the routes are created and destroyed @@ -1765,7 +1748,7 @@ sub handle_92 # that needs to be done. my $add; - ($parent, $add) = $self->pc92_handle_first_slot($ent[0], $parent, $t); + ($parent, $add) = $self->pc92_handle_first_slot($ent[0], $parent, $t, $hops); return unless $parent; # dupe shift @ent; @@ -1785,7 +1768,7 @@ sub handle_92 if ($sort eq 'A') { for (@nent) { - push @radd, _add_thingy($parent, $_); + push @radd, _add_thingy($parent, $_, $self, $hops); } } elsif ($sort eq 'D') { for (@nent) { @@ -1818,7 +1801,7 @@ sub handle_92 foreach my $r (@nent) { my $call = $r->[0]; if ($call) { - push @radd,_add_thingy($parent, $r) if grep $call eq $_, (@$nnodes, @$nusers); + push @radd,_add_thingy($parent, $r, $self, $hops) if grep $call eq $_, (@$nnodes, @$nusers); } } # del users here diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index 608102e8..512c30ef 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -20,7 +20,7 @@ use vars qw(@month %patmap @ISA @EXPORT); require Exporter; @ISA = qw(Exporter); @EXPORT = qw(atime ztime cldate cldatetime slat slong yesno promptf - parray parraypairs phex shellregex readfilestr writefilestr + parray parraypairs phex phash shellregex readfilestr writefilestr filecopy ptimelist print_all_fields cltounix unpad is_callsign is_latlong is_qra is_freq is_digits is_pctext is_pcflag insertitem deleteitem @@ -194,7 +194,7 @@ sub parraypairs my $ref = shift; my $i; my $out; - + for ($i = 0; $i < @$ref; $i += 2) { my $r1 = @$ref[$i]; my $r2 = @$ref[$i+1]; @@ -205,6 +205,20 @@ sub parraypairs return $out; } +# take the arg as a hash reference and print it out as such +sub phash +{ + my $ref = shift; + my $out; + + while (my ($k,$v) = each %$ref) { + $out .= "${k}=>$v, "; + } + chop $out; # remove last space + chop $out; # remove last comma + return $out; +} + sub _sort_fields { my $ref = shift; diff --git a/perl/DXXml.pm b/perl/DXXml.pm index 9b62328c..f05f3d1c 100644 --- a/perl/DXXml.pm +++ b/perl/DXXml.pm @@ -238,15 +238,6 @@ sub route dbg("route: $via -> $dxchan->{call} using normal route" ) if isdbg('route'); } - # try the backstop method - unless ($dxchan) { - my $rcall = RouteDB::get($via); - if ($rcall) { - $dxchan = DXChannel::get($rcall); - dbg("route: $via -> $rcall using RouteDB" ) if isdbg('route') && $dxchan; - } - } - unless ($dxchan) { dbg("XML: no route available to $via") if isdbg('chanerr'); return; diff --git a/perl/Route.pm b/perl/Route.pm index 7cbda347..33010998 100644 --- a/perl/Route.pm +++ b/perl/Route.pm @@ -1,4 +1,4 @@ -#!/usr/bin/perl +# # # This module impliments the abstracted routing for all protocols and # is probably what I SHOULD have done the first time. @@ -286,92 +286,52 @@ sub get return Route::Node::get($call) || Route::User::get($call); } -# this may be a better algorithm -#start = {start node} -#end = {end node} -#dist = 0 -#marked(n) = false for all nodes n -#queue = [start] -#while queue is not empty: -# dist = dist + 1 -# newqueue = [] -# for each node n in queue: -# for each edge from node n to node m: -# if not marked(m): -# marked(m) = true -# if m == end: -# -- We've found the end node -# -- it's a distance "dist" from the start -# return dist -# add m to newqueue -# queue = newqueue - sub findroutes { my $call = shift; - my $level = shift || 0; - my $seen = shift || {}; my @out; - dbg("findroutes: $call level: $level calls: " . join(',', @_)) if isdbg('routec'); - - # recursion detector (no point in recursing that deeply) - return () if $seen->{$call}; - if ($level >= 20) { -# dbg("Route::findroutes: recursion limit reached looking for $call"); - return (); - } + dbg("ROUTE: findroutes: $call") if isdbg('findroutes'); # return immediately if we are directly connected if (my $dxchan = DXChannel::get($call)) { - $seen->{$call}++; - push @out, $level ? [$level, $dxchan] : $dxchan; - return @out; + return $dxchan; } - $seen->{$call}++; - # deal with more nodes my $nref = Route::get($call); return () unless $nref; - foreach my $ncall (@{$nref->{parent}}) { - unless ($seen->{$ncall}) { - # put non-pc9x nodes to the back of the queue - my $l = $level + ($nref->{do_pc9x} && ($nref->{version}||5454) >= 5454 ? 0 : 30); - dbg("recursing from $call -> $ncall level $l") if isdbg('routec'); - my @rout = findroutes($ncall, $l+1, $seen); - push @out, @rout; + # obtain the dxchannels that have seen this thingy + my @parent = $nref->isa('Route::User') ? @{$nref->{parent}} : $call; + my %cand; + foreach my $p (@parent) { + my $r = Route::Node::get($p); + if ($r) { + my %r = $r->PC92C_dxchan; + while (my ($k, $v) = each %r) { + $cand{$k} = $v if $v > ($cand{$k} || 0); + } } } - if ($level == 0) { - my @nout = map {$_->[1]} sort {$a->[0] <=> $b->[0]} @out; - my $last; - if ($nref->isa('Route::Node')) { - my $ncall = $nref->PC92C_dxchan; - $last = DXChannel::get($ncall) if $ncall; - } else { - my $pcall = $nref->{parent}->[0]; - my ($ref, $ncall); - $ref = Route::Node::get($pcall) if $pcall; - $ncall = $ref->PC92C_dxchan if $ref; - $last = DXChannel::get($ncall) if $ncall; + # remove any dxchannels that have gone away + while (my ($k, $v) = each %cand) { + if (my $dxc = DXChannel::get($k)) { + push @out, [$v, $dxc]; } + } - if (isdbg('findroutes')) { - if (@out) { - foreach (sort {$a->[0] <=> $b->[0]} @out) { - dbg("ROUTE: findroute $call -> $_->[0] " . $_->[1]->call); - } - } else { - dbg("ROUTE: findroute $call -> PC92C_dxchan " . $last->call) if $last; + # get a sorted list of dxchannels with the highest hop count first + my @nout = map {$_->[1]} sort {$b->[0] <=> $a->[0]} @out; + if (isdbg('findroutes')) { + if (@out) { + foreach (sort {$b->[0] <=> $a->[0]} @out) { + dbg("ROUTE: findroute $call -> $_->[0] " . $_->[1]->call); } } - push @nout, $last if @out == 0 && $last; - return @nout; - } else { - return @out; } + + return @nout; } # find all the possible dxchannels which this object might be on @@ -393,21 +353,14 @@ sub dxchan my @dxchan = $self->alldxchan; return undef unless @dxchan; - # determine the minimum ping channel -# my $minping = 99999999; -# foreach my $dxc (@dxchan) { -# my $p = $dxc->pingave; -# if (defined $p && $p < $minping) { -# $minping = $p; -# $dxchan = $dxc; -# } -# } -# $dxchan = shift @dxchan unless $dxchan; - # dxchannels are now returned in order of "closeness" return $dxchan[0]; } +sub delete_interface +{ + +} # diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm index 23e29382..9c2b734e 100644 --- a/perl/Route/Node.pm +++ b/perl/Route/Node.pm @@ -32,7 +32,7 @@ use vars qw(%list %valid @ISA $max $filterdef $obscount); via_pc92 => '0,Came in via pc92,yesno', obscount => '0,Obscount', last_PC92C => '9,Last PC92C', - PC92C_dxchan => '9,Channel of PC92C', + PC92C_dxchan => '9,Channel of PC92C,phash', ); $filterdef = $Route::filterdef; @@ -286,7 +286,7 @@ sub new $self->{flags} = shift || Route::here(1); $self->{users} = []; $self->{nodes} = []; - $self->{PC92C_dxchan} = ''; + $self->{PC92C_dxchan} = {}; $self->reset_obs; # by definition $list{$call} = $self; @@ -371,6 +371,19 @@ sub measure_pc9x_t } } +sub PC92C_dxchan +{ + my $parent = shift; + my $call = shift; + my $hops = shift; + if ($call && $hops) { + $hops =~ s/^H//; + $parent->{PC92C_dxchan}->{$call} = $hops; + return; + } + return (%{$parent->{PC92C_dxchan}}); +} + sub DESTROY { my $self = shift; diff --git a/perl/RouteDB.pm b/perl/RouteDB.pm deleted file mode 100644 index 8059b08d..00000000 --- a/perl/RouteDB.pm +++ /dev/null @@ -1,145 +0,0 @@ -# This module is used to keep a list of where things come from -# -# all interfaces add/update entries in here to allow casual -# routing to occur. -# -# It is up to the protocol handlers in here to make sure that -# this information makes sense. -# -# This is (for now) just an adjunct to the normal routing -# and is experimental. It will override filtering for -# things that are explicitly routed (pings, talks and -# such like). -# -# Copyright (c) 2004 Dirk Koopman G1TLH -# -# -# - -package RouteDB; - -use DXDebug; -use DXChannel; -use DXUtil; -use Prefix; - -use strict; - -use vars qw(%list %valid $default); - - -%list = (); -$default = 99; # the number of hops to use if we don't know -%valid = ( - call => "0,Callsign", - item => "0,Interfaces,parray", - t => '0,Last Seen,atime', - hops => '0,Hops', - count => '0,Times Seen', - ); - -sub new -{ - my $pkg = shift; - my $call = shift; - return bless {call => $call, list => {}}, (ref $pkg || $pkg); -} - -# get the best one -sub get -{ - my @out = _sorted(shift); - return @out ? $out[0]->{call} : undef; -} - -# get all of them in sorted order -sub get_all -{ - my @out = _sorted(shift); - return @out ? map { $_->{call} } @out : (); -} - -# get them all, sorted into reverse occurance order (latest first) -# with the smallest hops -sub _sorted -{ - my $call = shift; - my $ref = $list{$call}; - return () unless $ref; - return sort { - if ($a->{hops} == $b->{hops}) { - $b->{t} <=> $a->{t}; - } else { - $a->{hops} <=> $b->{hops}; - } - } values %{$ref->{item}}; -} - - -# add or update this call on this interface -# -# RouteDB::update($call, $interface, $hops, time); -# -sub update -{ - my $call = shift; - my $interface = shift; - my $hops = shift || $default; - my $ref = $list{$call} || RouteDB->new($call); - my $iref = $ref->{item}->{$interface} ||= RouteDB::Item->new($interface, $hops); - $iref->{count}++; - $iref->{hops} = $hops if $hops < $iref->{hops}; - $iref->{t} = shift || $main::systime; - $ref->{item}->{$interface} ||= $iref; - $list{$call} ||= $ref; -} - -sub delete -{ - my $call = shift; - my $interface = shift; - my $ref = $list{$call}; - delete $ref->{item}->{$interface} if $ref; -} - -sub delete_interface -{ - my $interface = shift; - foreach my $ref (values %list) { - delete $ref->{item}->{$interface}; - } -} - -# -# generic AUTOLOAD for accessors -# -sub AUTOLOAD -{ - no strict; - my $name = $AUTOLOAD; - return if $name =~ /::DESTROY$/; - $name =~ s/^.*:://o; - - confess "Non-existant field '$AUTOLOAD'" if !$valid{$name}; - - # 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; - -} - -package RouteDB::Item; - -use vars qw(@ISA); -@ISA = qw(RouteDB); - -sub new -{ - my $pkg = shift; - my $call = shift; - my $hops = shift || $RouteDB::default; - return bless {call => $call, hops => $hops}, (ref $pkg || $pkg); -} - -1; diff --git a/perl/Version.pm b/perl/Version.pm index c83ac473..aada2601 100644 --- a/perl/Version.pm +++ b/perl/Version.pm @@ -11,6 +11,6 @@ use vars qw($version $subversion $build); $version = '1.55'; $subversion = '0'; -$build = '13'; +$build = '14'; 1; diff --git a/perl/cluster.pl b/perl/cluster.pl index 67918966..25b84a9c 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -98,7 +98,6 @@ use Mrtg; use USDB; use UDPMsg; use QSL; -use RouteDB; use DXXml; use DXSql; use IsoTime;