From 05a7fdd4a58c51e21b55b0509b054b625839290c Mon Sep 17 00:00:00 2001 From: minima Date: Mon, 5 Jul 2004 23:53:15 +0000 Subject: [PATCH] more wip, ready for some testing (maybe) --- perl/DXChannel.pm | 9 ++ perl/DXProt.pm | 380 +++++++++++++++++++-------------------------- perl/DXProtout.pm | 5 +- perl/DXUser.pm | 6 + perl/Route.pm | 39 +---- perl/Route/Node.pm | 169 ++++++-------------- perl/Route/User.pm | 49 ++++-- 7 files changed, 264 insertions(+), 393 deletions(-) diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 3ae6afd6..d0c995d9 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -303,6 +303,15 @@ sub sort return @_ ? $self->{'sort'} = shift : $self->{'sort'} ; } +# find out whether we are prepared to believe this callsign on this interface +sub is_believed +{ + my $self = shift; + my $call = shift; + + return grep $call eq $_, $self->user->believe; +} + # handle out going messages, immediately without waiting for the select to drop # this could, in theory, block sub send_now diff --git a/perl/DXProt.pm b/perl/DXProt.pm index fb09e99d..e2722165 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -671,10 +671,6 @@ sub handle_16 my $line = shift; my $origin = shift; - if (eph_dup($line)) { - dbg("PCPROT: dup PC16 detected") if isdbg('chanerr'); - return; - } # general checks my $dxchan; @@ -686,83 +682,31 @@ sub handle_16 dbg("PCPROT: don't send users to $self->{call}") if isdbg('chanerr'); return; } + # is it me? if ($ncall eq $main::mycall) { dbg("PCPROT: trying to alter config on this node from outside!") if isdbg('chanerr'); return; } - my $parent = Route::Node::get($ncall); - # if there is a parent, proceed, otherwise if there is a latent PC19 in the PC19list, - # fix it up in the routing tables and issue it forth before the PC16 - unless ($parent) { - my $nl = $pc19list{$ncall}; - - if ($nl && @_ > 3) { # 3 because of the hop count! - - # this is a new (remembered) node, now attach it to me if it isn't in filtered - # and we haven't disallowed it - my $user = DXUser->get_current($ncall); - if (!$user) { - $user = DXUser->new($ncall); - $user->sort('A'); - $user->priv(1); # I have relented and defaulted nodes - $user->lockout(1); - $user->homenode($ncall); - $user->node($ncall); - } + # do we believe this call? + next unless $ncall eq $self->{call} || $self->is_believed($ncall); - my $wantpc19 = $user->wantroutepc19; - if ($wantpc19 || !defined $wantpc19) { - my $new = Route->new($ncall); # throw away - if ($self->in_filter_route($new)) { - my @nrout; - for (@$nl) { - $parent = Route::Node::get($_->[0]); - $dxchan = $parent->dxchan if $parent; - if ($dxchan && $dxchan ne $self) { - dbg("PCPROT: PC19 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr'); - $parent = undef; - } - if ($parent) { - my $r = $parent->add($ncall, $_->[1], $_->[2]); - push @nrout, $r unless @nrout; - } - } - $user->wantroutepc19(1) unless defined $wantpc19; # for now we work on the basis that pc16 = real route - $user->lastin($main::systime) unless DXChannel->get($ncall); - $user->put; - - # route the pc19 - this will cause 'stuttering PC19s' for a while - $self->route_pc19($origin, $line, @nrout) if @nrout ; - $parent = Route::Node::get($ncall); - unless ($parent) { - dbg("PCPROT: lost $ncall after sending PC19 for it?"); - return; - } - } else { - return; - } - delete $pc19list{$ncall}; - } - } else { - dbg("PCPROT: Node $ncall not in config") if isdbg('chanerr'); - return; - } - } else { - - $dxchan = $parent->dxchan; - if ($dxchan && $dxchan ne $self) { - dbg("PCPROT: PC16 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr'); - return; - } + my $node = Route::Node::get($ncall); + unless ($node) { + dbg("PCPROT: Node $ncall not in config") if isdbg('chanerr'); + return; + } - # input filter if required - return unless $self->in_filter_route($parent); + # dedupe only that which we potentially process + if (eph_dup($line)) { + dbg("PCPROT: dup PC16 detected") if isdbg('chanerr'); + return; } my $i; my @rout; + my @new; for ($i = 2; $i < $#_; $i++) { my ($call, $conf, $here) = $_[$i] =~ /^(\S+) (\S) (\d)/o; next unless $call && $conf && defined $here && is_callsign($call); @@ -780,31 +724,23 @@ sub handle_16 next; } - $r = Route::User::get($call); - my $flags = Route::here($here)|Route::conf($conf); - - if ($r) { - my $au = $r->addparent($parent); - if ($r->flags != $flags) { - $r->flags($flags); - $au = $r; - } - push @rout, $r if $au; - } else { - push @rout, $parent->add_user($call, $flags); - } - + $r = Route::User::get($call) || Route::User::get($call); + $r->here($here); + $r->conf($conf); + $node->lastseen($main::systime); + + push @new, $node->add_user($r); # add this station to the user database, if required $call =~ s/-\d+$//o; # remove ssid for users my $user = DXUser->get_current($call); $user = DXUser->new($call) if !$user; - $user->homenode($parent->call) if !$user->homenode; - $user->node($parent->call); + $user->homenode($node->call) if !$user->homenode; + $user->node($node->call); $user->lastin($main::systime) unless DXChannel->get($call); $user->put; } - $self->route_pc16($origin, $line, $parent, @rout) if @rout; + $self->route_pc16($origin, $line, $node, @new) if @new; } # remove a user @@ -830,36 +766,35 @@ sub handle_17 return; } + # do we believe this call? + next unless $ncall eq $self->{call} || $self->is_believed($ncall); + my $uref = Route::User::get($ucall); unless ($uref) { dbg("PCPROT: Route::User $ucall not in config") if isdbg('chanerr'); } - my $parent = Route::Node::get($ncall); - unless ($parent) { + my $node = Route::Node::get($ncall); + unless ($node) { dbg("PCPROT: Route::Node $ncall not in config") if isdbg('chanerr'); } - $dxchan = $parent->dxchan if $parent; - if ($dxchan && $dxchan ne $self) { - dbg("PCPROT: PC17 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr'); - return; - } - - # input filter if required and then remove user if present - if ($parent) { -# return unless $self->in_filter_route($parent); - $parent->del_user($uref) if $uref; - } else { - $parent = Route->new($ncall); # throw away + return unless $node && $uref; + + my @rout; + my @new; + if ($self->in_filter_route($node)) { + + if (eph_dup($line)) { + dbg("PCPROT: dup PC17 detected") if isdbg('chanerr'); + return; + } + push @new, $node->del_user($uref); } - if (eph_dup($line)) { - dbg("PCPROT: dup PC17 detected") if isdbg('chanerr'); - return; - } + $self->route_pc17($origin, $line, $node, $uref) if @new; - $uref = Route->new($ucall) unless $uref; # throw away - $self->route_pc17($origin, $line, $parent, $uref); + # get rid of orphaned users; + $_->delete for @new; } # link request @@ -924,26 +859,8 @@ sub handle_19 return; } - # if the origin isn't the same as the INTERFACE, then reparent, creating nodes as necessary - if ($origin ne $self->call) { - my $op = Route::Node::get($origin); - unless ($op) { - $op = $parent->add($origin, 5000, Route::here(1)); - my $user = DXUser->get_current($origin); - if (!$user) { - $user = DXUser->new($origin); - $user->sort('A'); - $user->priv(1); # I have relented and defaulted nodes - $user->lockout(1); - $user->homenode($origin); - $user->node($origin); - $user->wantroutepc19(1); - } - $user->put; - } - $parent = $op; - } - + my @new; + # parse the PC19 for ($i = 1; $i < $#_-1; $i += 4) { my $here = $_[$i]; @@ -952,21 +869,17 @@ sub handle_19 my $ver = $_[$i+3]; next unless defined $here && defined $conf && is_callsign($call); - eph_del_regex("^PC(?:21\\^$call|17\\^[^\\^]+\\^$call)"); - # check for sane parameters # $ver = 5000 if $ver eq '0000'; next if $ver < 5000; # only works with version 5 software next if length $call < 3; # min 3 letter callsigns next if $call eq $main::mycall; - # check that this PC19 isn't trying to alter the wrong dxchan - my $dxchan = DXChannel->get($call); - if ($dxchan && $dxchan != $self) { - dbg("PCPROT: PC19 from $self->{call} trying to alter wrong locally connected $call, ignored!") if isdbg('chanerr'); - next; - } + # do we believe this call? + next unless $call eq $self->{call} || $self->is_believed($call); + eph_del_regex("^PC(?:21\\^$call|17\\^[^\\^]+\\^$call)"); + # add this station to the user database, if required (don't remove SSID from nodes) my $user = DXUser->get_current($call); if (!$user) { @@ -977,43 +890,17 @@ sub handle_19 $user->homenode($call); $user->node($call); } + $user->wantroutepc19(1) unless defined $user->wantroutepc19; - my $r = Route::Node::get($call); - my $flags = Route::here($here)|Route::conf($conf); - - # modify the routing table if it is in it, otherwise store it in the pc19list for now - if ($r) { - my $ar; - if ($call ne $parent->call) { - if ($self->in_filter_route($r)) { - $ar = $parent->add($call, $ver, $flags); - push @rout, $ar if $ar; - } else { - next; - } - } - if ($r->version ne $ver || $r->flags != $flags) { - $r->version($ver); - $r->flags($flags); - push @rout, $r unless $ar; - } - } else { + my $r = Route::Node::get($call) || Route::Node->new($call); + $r->here($here); + $r->conf($conf); + $r->version($ver); + $r->lastseen($main::systime); - # if he is directly connected or allowed then add him, otherwise store him up for later - if ($call eq $self->{call} || $user->wantroutepc19) { - my $new = Route->new($call); # throw away - if ($self->in_filter_route($new)) { - my $ar = $parent->add($call, $ver, $flags); - $user->wantroutepc19(1) unless defined $user->wantroutepc19; - push @rout, $ar if $ar; - } else { - next; - } - } else { - $pc19list{$call} = [] unless exists $pc19list{$call}; - my $nl = $pc19list{$call}; - push @{$pc19list{$call}}, [$self->{call}, $ver, $flags] unless grep $_->[0] eq $self->{call}, @$nl; - } + if ($self->in_filter_route($r)) { + push @new, $parent->link_node($r, $self); + push @rout, $r; } # unbusy and stop and outgoing mail (ie if somehow we receive another PC19 without a disconnect) @@ -1024,8 +911,9 @@ sub handle_19 $user->put; } - - $self->route_pc19($origin, $line, @rout) if @rout; + # route out new nodes to legacy nodes + $self->route_pc19($origin, $line, @new) if @new; + $self->route_pc59('A', 0, $self->{call}, @rout) if @rout; } # send local configuration @@ -1050,6 +938,8 @@ sub handle_21 my $origin = shift; my $call = uc $_[1]; + return if $call eq $main::mycall; # don't allow malicious buggers to disconnect me (or ignore loops)! + eph_del_regex("^PC1[679].*$call"); # if I get a PC21 from the same callsign as self then treat it @@ -1059,43 +949,31 @@ sub handle_21 return; } - # check to see if we are in the pc19list, if we are then don't bother with any of - # this routing table manipulation, just remove it from the list and dump it my @rout; - if (my $nl = $pc19list{$call}) { - $pc19list{$call} = [ grep {$_->[0] ne $self->{call}} @$nl ]; - delete $pc19list{$call} unless @{$pc19list{$call}}; - } else { - - my $parent = Route::Node::get($self->{call}); - unless ($parent) { - dbg("DXPROT: my parent $self->{call} has disappeared"); - $self->disconnect; - return; - } - if ($call ne $main::mycall) { # don't allow malicious buggers to disconnect me! - my $node = Route::Node::get($call); - if ($node) { - - my $dxchan = DXChannel->get($call); - if ($dxchan && $dxchan != $self) { - dbg("PCPROT: PC21 from $self->{call} trying to alter locally connected $call, ignored!") if isdbg('chanerr'); - return; - } - - # input filter it - return unless $self->in_filter_route($node); - - # routing objects - push @rout, $node->del($parent); - } - } else { - dbg("PCPROT: I WILL _NOT_ be disconnected!") if isdbg('chanerr'); - return; - } + my @new; + my $parent = Route::Node::get($self->{call}); + unless ($parent) { + dbg("DXPROT: my parent $self->{call} has disappeared"); + $self->disconnect; + return; } + $parent->lastseen; - $self->route_pc21($origin, $line, @rout) if @rout; + my $node = Route::Node::get($call); + if ($node) { + $node->lastseen($main::systime); + + # input filter it + return unless $self->in_filter_route($node); + push @rout, $node; + push @new, $node->link_node($parent, $self); + } + + $self->route_pc21($origin, $line, @new) if @new; + $self->route_pc59('D', 0, $self->{call}, @rout) if @rout; + + # get rid of orphaned nodes; + $_->delete for @new; } @@ -1530,7 +1408,7 @@ sub handle_59 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) { @@ -1538,8 +1416,8 @@ sub handle_59 $user->sort(); $user->priv(1); # I have relented and defaulted nodes $user->lockout(1); - $user->homenode($call); - $user->node($call); + $user->homenode($ncall); + $user->node($ncall); } if ($esort eq 'U') { $ref = Route::User::get($ecall); @@ -1575,37 +1453,80 @@ sub handle_59 dbg("DXPROT: unknown entity type '$esort' on $ecall for node $ncall") if isdbg('chan'); next; } - $ref->here($here); # might as well set this here + $ref->here($ehere); # might as well set this here + $ref->lastheard($main::systime); push @refs, $ref; } - # if it is a delete or a configure, disconnect all the entries mentioned + # if it is a delete, disconnect all the entries mentioned # from this node (which is a parent in this context). - my @del; - if ($sort eq 'D' || $sort eq 'C') { + my @delnode; + my @deluser; + if ($sort eq 'D') { for my $ref (@refs) { next if $ref->call eq $ncall; if ($ref->isa('Route::Node')) { - push @del, $ref->del($node); + push @delnode, $node->unlink_node($ref, $self); } elsif ($ref->isa('Route::User')) { - push @del, $node->del_user($ref); + push @deluser, $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') { + # if it is an add, connect all the entries + my @addnode; + my @adduser; + if ($sort eq 'A') { 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; + my $new = $node->link_node($ref, $self); + push @addnode, $new if $new; } elsif ($ref->isa('Route::User')) { - push @add, $node->add_user($ref->call); + push @adduser, $node->del_user($ref); } } } + + # if it is a configure, unlink all the nodes and users that + # are not in @refs but are in the node, then add all the + # nodes and users that are @refs but not in the node. + # + if ($sort eq 'C') { + my @dn; + my @du; + my @an; + my @au; + for my $r (map {Route::Node::get($_)} $node->nodes) { + next unless $r; + push @dn, $r unless grep $_->call eq $r->call, @refs; + } + for my $r (map {Route::User::get($_)} $node->users) { + next unless $r; + push @du, $r unless grep $_->call eq $r->call, @refs; + } + for my $r (@refs) { + next unless $r; + if ($r->isa('Route::Node')) { + push @an, $r unless grep $r->call eq $_, $node->nodes; + } elsif ($r->isa('Route::User')) { + push @au, $r unless grep $r->call eq $_, $node->users; + } + } + push @delnode, $node->unlink_node($_, $self) for @dn; + push @deluser, $node->del_user($_) for @du; + push @addnode, $node->link_node($_, $self) for @an; + push @adduser, $node->add_user($_) for @au; + } + + + $self->route_pc21($origin, $line, @delnode) if @delnode; + $self->route_pc19($origin, $line, @addnode) if @addnode; + $self->route_pc17($origin, $line, @deluser) if @deluser; + $self->route_pc16($origin, $line, @adduser) if @adduser; + + $self->route_pc59($sort, $hextime, $ncall, @refs) if @refs; + $_->delete for @delnode, @deluser; } @@ -2372,6 +2293,13 @@ sub send_route for (; @_ && $no; $no--) { my $r = shift; + + # deal with non routing parameters + unless (ref $r && $r->isa('Route')) { + push @rin, $r; + $no++; + next; + } if (!$self->{isolate} && $self->{routefilter}) { $filter = undef; @@ -2419,6 +2347,8 @@ sub broadcast_route next if $dxchan == $main::me; next unless $dxchan->isa('DXProt'); next if ($generate == \&pc16 || $generate==\&pc17) && !$dxchan->user->wantsendpc16; + next if ($generate == \&pc19 || $generate==\&pc21) && !$dxchan->user->wantsendpc19; + next if ($generate == \&pc59) && !$dxchan->{newroute}; $dxchan->send_route($origin, $generate, @_); } @@ -2483,6 +2413,16 @@ sub route_pc50 broadcast_route($self, $origin, \&pc50, $line, 1, @_); } +sub route_pc59 +{ + my $self = shift; + my $origin = shift; + my $line = shift; + + # @_ - 2 because we start with [ACD], hexstamp + broadcast_route($self, $origin, \&pc59, $line, scalar @_ - 2, @_); +} + sub in_filter_route { my $self = shift; diff --git a/perl/DXProtout.pm b/perl/DXProtout.pm index f08fef49..dc4257a8 100644 --- a/perl/DXProtout.pm +++ b/perl/DXProtout.pm @@ -392,8 +392,9 @@ sub pc59 my @out; my $sort = shift; my $hexstamp = shift || hexstamp(); + my $node = shift; - my $node = $_[0]->call; + my $s = "PC59^$sort^$hexstamp^$node"; for (@_) { next unless $_; my $ref = $_; @@ -401,7 +402,7 @@ sub pc59 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); + push @out, sprintf "$s^%s^", get_hops(59); return @out; } diff --git a/perl/DXUser.pm b/perl/DXUser.pm index f371161b..22cf0df2 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -796,6 +796,12 @@ sub unset_believe delete $self->{believe} unless @{$self->{believe}}; } } + +sub believe +{ + my $self = shift; + return exists $self->{believe} ? @{$self->{believe}} : (); +} 1; __END__ diff --git a/perl/Route.pm b/perl/Route.pm index 0e9b6139..388aed2e 100644 --- a/perl/Route.pm +++ b/perl/Route.pm @@ -308,47 +308,12 @@ sub bestdxchan my $dxchan = DXChannel->get($self->call); return $dxchan if $dxchan; - my @dxchan = $self->alldxchan; + my @dxchan = sort { ($a->pingave || 9999999) <=> ($b->pingave || 9999999) } $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; - return $dxchan; -} - -sub _adddxchan -{ - my $self = shift; - return $self->_addlist('dxchan', @_); -} - -sub _deldxchan -{ - my $self = shift; - return $self->_dellist('dxchan', @_); + return shift @dxchan; } -sub _addnode -{ - my $self = shift; - return $self->_addlist('nodes', @_); -} - -sub _delnode -{ - my $self = shift; - return $self->_dellist('nodes', @_); -} - - # # track destruction # diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm index 92ceba22..38e7f3e4 100644 --- a/perl/Route/Node.pm +++ b/perl/Route/Node.pm @@ -24,13 +24,11 @@ use vars qw(%list %valid @ISA $max $filterdef); @ISA = qw(Route); %valid = ( - dxchan => '0,Visible on DXChans,parray', + dxchan => '0,DXChannel List,parray', nodes => '0,Nodes,parray', users => '0,Users,parray', usercount => '0,User Count', version => '0,Version', - np => '0,Using New Prot,yesno', - lid => '0,Last Msgid', ); $filterdef = $Route::filterdef; @@ -50,124 +48,60 @@ sub max return $max; } +# link a node to this node and mark the route as available thru +# this dxchan, any users must be linked separately # -# this routine handles the possible adding of an entry in the routing -# table. It will only add an entry if it is new. It may have all sorts of -# other side effects which may include fixing up other links. -# -# It will return a node object if (and only if) it is a completely new -# object with that callsign. The upper layers are expected to do something -# sensible with this! -# -# called as $dxchan->add(call, dxchan, version, flags) +# call as $node->link_node($neighbour, $dxchan); # -sub add +sub link_node { - my $dxchan = shift; - my $call = uc shift; - confess "Route::add trying to add $call to myself" if $call eq $dxchan->{call}; - my $self = get($call); - if ($self) { - $self->_adddxchan($dxchan); - $dxchan->_addnode($self); - return undef; - } - $self = $dxchan->new($call, @_); - $dxchan->_addnode($self); - return $self; -} + my ($self, $neighbour, $dxchan) = @_; -# -# this routine is the opposite of 'add' above. -# -# It will return an object if (and only if) this 'del' will remove -# this object completely -# - -sub del -{ - my $self = shift; - my $pref = shift; - - # delete dxchan from this call's dxchan list - $pref->_delnode($self); - $self->_deldxchan($pref); - my @nodes; - my $ncall = $self->{call}; - - # 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); - push @nodes, $r->del($self, $ncall, @_) if $r; - } - $self->_del_users; - delete $list{$self->{call}}; - push @nodes, $self; - } - return @nodes; + my $r = $self->is_empty('dxchan'); + $self->_addlist('nodes', $neighbour); + $neighbour->_addlist('nodes', $self); + $self->_addlist('dxchan', $dxchan); + $neighbour->_addlist('dxchan', $dxchan); + return $r ? ($self) : (); } -sub del_nodes -{ - my $dxchan = shift; - my @out; - foreach my $rcall (@{$dxchan->{nodes}}) { - my $r = get($rcall); - push @out, $r->del($dxchan, $dxchan->{call}, @_) if $r; - } - return @out; -} +# unlink a node from a neighbour and remove any +# routes, if this node becomes orphaned (no routes +# and no nodes) then return it +# -sub _del_users +sub unlink_node { - my $self = shift; - for (@{$self->{users}}) { - my $ref = Route::User::get($_); - $ref->del($self) if $ref; - } - $self->{users} = []; + my ($self, $neighbour, $dxchan) = @_; + $self->_dellist('nodes', $neighbour); + $neighbour->_dellist('nodes', $self); + $self->_dellist('dxchan', $dxchan); + $neighbour->_dellist('dxchan', $dxchan); + return $self->is_empty('dxchan') ? ($self) : (); } # add a user to this node +# returns Route::User if it is a new user; sub add_user { - my $self = shift; - my $ucall = shift; - - confess "Trying to add NULL User call to routing tables" unless $ucall; - - my $uref = Route::User::get($ucall); - my @out; - if ($uref) { - @out = $uref->adddxchan($self); - } else { - $uref = Route::User->new($ucall, $self->{call}, @_); - @out = $uref; - } - $self->_adduser($uref); + my ($self, $uref) = @_; + my $r = $uref->is_empty('nodes'); + $self->_addlist('users', $uref); + $uref->_addlist('nodes', $self); $self->{usercount} = scalar @{$self->{users}}; - - return @out; + return $r ? ($uref) : (); } # delete a user from this node sub del_user { - my $self = shift; - my $ref = shift; - my @out; - - if ($ref) { - @out = $self->_deluser($ref); - $ref->del($self); - } else { - confess "tried to delete non-existant $ref->{call} from $self->{call}"; - } + my ($self, $uref) = @_; + + $self->_dellist('users', $uref); + $uref->_dellist('nodes', $self); $self->{usercount} = scalar @{$self->{users}}; - return @out; + return $uref->is_empty('nodes') ? ($uref) : (); } sub usercount @@ -191,20 +125,15 @@ sub nodes return @{$self->{nodes}}; } -sub rnodes +sub unlink_all_users { my $self = shift; - my @out; - foreach my $call (@{$self->{nodes}}) { - next if grep $call eq $_, @_; - push @out, $call; - my $r = get($call); - push @out, $r->rnodes($call, @_) if $r; + foreach my $u (${$self->{nodes}}) { + my $uref = Route::User::get($u); + $self->unlink_user($uref) if $uref; } - return @out; } - sub new { my $pkg = shift; @@ -221,10 +150,18 @@ sub new $self->{lid} = 0; $list{$call} = $self; + dbg("creating Route::Node $self->{call}") if isdbg('routelow'); return $self; } +sub delete +{ + my $self = shift; + dbg("deleting Route::Node $self->{call}") if isdbg('routelow'); + delete $list{$self->{call}}; +} + sub get { my $call = shift; @@ -239,19 +176,6 @@ sub get_all return values %list; } - -sub _adduser -{ - my $self = shift; - return $self->_addlist('users', @_); -} - -sub _deluser -{ - my $self = shift; - return $self->_dellist('users', @_); -} - sub DESTROY { my $self = shift; @@ -259,6 +183,7 @@ sub DESTROY my $call = $self->{call} || "Unknown"; dbg("destroying $pkg with $call") if isdbg('routelow'); + $self->unlink_all_users if @{$self->{users}}; } # diff --git a/perl/Route/User.pm b/perl/Route/User.pm index 88d2aa2a..ebccba9b 100644 --- a/perl/Route/User.pm +++ b/perl/Route/User.pm @@ -52,28 +52,24 @@ sub new confess "already have $call in $pkg" if $list{$call}; my $self = $pkg->SUPER::new($call); - $self->{nodes} = [ $ncall ]; + $self->{nodes} = [ ]; $self->{flags} = $flags; $list{$call} = $self; + dbg("creating Route::User $self->{call}") if isdbg('routelow'); return $self; } -sub get_all +sub delete { - return values %list; + my $self = shift; + dbg("deleting Route::User $self->{call}") if isdbg('routelow'); + delete $list{$self->{call}}; } -sub del +sub get_all { - my $self = shift; - my $pref = shift; - $self->deldxchan($pref); - unless (@{$self->{dxchan}}) { - delete $list{$self->{call}}; - return $self; - } - return undef; + return values %list; } sub get @@ -85,6 +81,35 @@ sub get return $ref; } +# add a user to this node +# returns Route::User if it is a new user; +sub add_node +{ + my ($self, $nref) = @_; + my $r = $self->is_empty('nodes'); + $self->_addlist('nodes', $nref); + $nref->_addlist('users', $self); + $nref->{usercount} = scalar @{$nref->{users}}; + return $r ? ($self) : (); +} + +# delete a user from this node +sub del_user +{ + my ($self, $nref) = @_; + + $self->_dellist('nodes', $nref); + $nref->_dellist('users', $self); + $nref->{usercount} = scalar @{$nref->{users}}; + return $self->is_empty('nodes') ? ($self) : (); +} + +sub nodes +{ + my $self = shift; + return @{$self->{nodes}}; +} + # # generic AUTOLOAD for accessors # -- 2.34.1