From 4d22d5fd3874e8292d82f84a777b99ff7d10402a Mon Sep 17 00:00:00 2001 From: minima Date: Sun, 20 Feb 2005 22:40:13 +0000 Subject: [PATCH] add all the basic aranea routing + local configuration broadcasts --- perl/Aranea.pm | 34 +++++-- perl/DXProt.pm | 3 + perl/Route.pm | 8 ++ perl/Thingy.pm | 11 ++ perl/Thingy/Bye.pm | 78 +++++--------- perl/Thingy/Dx.pm | 21 ++-- perl/Thingy/Hello.pm | 67 +++++++----- perl/Thingy/Ping.pm | 44 +------- perl/Thingy/RouteFilter.pm | 107 ++++++++++++++++++++ perl/Thingy/Rt.pm | 202 +++++++++---------------------------- perl/Thingy/T.pm | 44 +------- 11 files changed, 288 insertions(+), 331 deletions(-) create mode 100644 perl/Thingy/RouteFilter.pm diff --git a/perl/Aranea.pm b/perl/Aranea.pm index 30816020..087eefc3 100644 --- a/perl/Aranea.pm +++ b/perl/Aranea.pm @@ -25,7 +25,12 @@ use Script; use Verify; use DXDupe; use Thingy; +use Thingy::Rt; +use Thingy::Hello; +use Thingy::Bye; use RouteDB; +use DXProt; +use DXCommandmode; use vars qw($VERSION $BRANCH); @@ -116,6 +121,12 @@ sub start # send info to all logged in thingies $self->tell_login('loginn'); + # broadcast our configuration to the world + unless ($self->{outbound}) { + my $thing = Thingy::Rt->new_lcf; + $thing->broadcast; + } + # run a script send the output to the debug file my $script = new Script(lc $call) || new Script('node_default'); $script->run($self) if $script; @@ -154,7 +165,7 @@ sub disconnect return if $self->{disconnecting}++; my $thing = Thingy::Bye->new(origin=>$main::mycall, user=>$call); - $thing->process($self); + $thing->broadcast($self); # get rid of any PC16/17/19 DXProt::eph_del_regex("^PC1[679]*$call"); @@ -179,7 +190,7 @@ sub disconnect $mref->stop_msg($call) if $mref; # broadcast to all other nodes that all the nodes connected to via me are gone -# $self->route_pc21($main::mycall, undef, @rout) if @rout; + DXProt::route_pc21($self, $main::mycall, undef, @rout) if @rout; # remove outstanding pings # delete $pings{$call}; @@ -273,16 +284,20 @@ sub tdecode sub genmsg { my $thing = shift; - my $name = shift; + my $list = ref $_[0] ? shift : \@_; + my ($name) = uc ref $thing; + $name =~ /::(\w+)$/; + $name = $1; my $head = genheader($thing->{origin}, ($thing->{group} || $thing->{touser} || $thing->{tonode}), ($thing->{user} || $thing->{fromuser} || $thing->{fromnode}) ); - my $data = "$name,"; - while (@_) { - my $k = lc shift; - my $v = tencode(shift); - $data .= "$k=$v,"; + + my $data = uc $name . ','; + while (@$list) { + my $k = lc shift @$list; + my $v = $thing->{$k}; + $data .= "$k=" . tencode($v) . ',' if defined $v; } chop $data; return "$head|$data"; @@ -312,7 +327,8 @@ sub input $err .= "missing cmd or data," unless $cmd && $data; $err .= "invalid command ($cmd)," unless $cmd =~ /^[A-Z][A-Z0-9]*$/; my ($gp, $tus) = split /:/, $group, 2 if $group; - + + $err .= "from me," if $origin eq $main::mycall; $err .= "invalid group ($gp)," if $gp && $gp !~ /^[A-Z0-9]{2,}$/; $err .= "invalid tocall ($tus)," if $tus && !is_callsign($tus); $err .= "invalid fromcall ($user)," if $user && !is_callsign($user); diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 886099f2..32d63b1f 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -313,6 +313,9 @@ sub start $self->state('init'); $self->{pc50_t} = $main::systime; + my $thing = Thingy::Hello->new(origin=>$main::mycall, user=>$call); + $thing->broadcast($self); + # send info to all logged in thingies $self->tell_login('loginn'); diff --git a/perl/Route.pm b/perl/Route.pm index 62631900..e0cfe3e5 100644 --- a/perl/Route.pm +++ b/perl/Route.pm @@ -35,6 +35,7 @@ use vars qw(%list %valid $filterdef); cq => '0,CQ Zone', state => '0,State', city => '0,City', + aranea => '0, By Aranea,yesno', ); $filterdef = bless ([ @@ -133,6 +134,13 @@ sub is_empty return @{$self->{$_[0]}} == 0; } +sub is_aranea +{ + my $self = shift; + $self->{aranea} = shift if @_; + return $self->{aranea}; +} + # # flag field constructors/enquirers # diff --git a/perl/Thingy.pm b/perl/Thingy.pm index 522e4b13..8b3f3cce 100644 --- a/perl/Thingy.pm +++ b/perl/Thingy.pm @@ -42,6 +42,8 @@ sub new { my $class = shift; my $thing = {@_}; + + $thing->{origin} ||= $main::mycall; bless $thing, $class; return $thing; @@ -171,5 +173,14 @@ sub ascii $dd->Quotekeys($] < 5.005 ? 1 : 0); return $dd->Dumpxs; } + +sub add_auth +{ + my $thing = shift; + my $s = $thing->{'s'} = sprintf "%X", int(rand() * 100000000); + my $auth = Verify->new("DXSp,$main::mycall,$s,$main::version,$main::build"); + $thing->{auth} = $auth->challenge($main::me->user->passphrase); +} + 1; diff --git a/perl/Thingy/Bye.pm b/perl/Thingy/Bye.pm index 22b7d4c6..a2964966 100644 --- a/perl/Thingy/Bye.pm +++ b/perl/Thingy/Bye.pm @@ -11,29 +11,23 @@ use strict; package Thingy::Bye; use vars qw($VERSION $BRANCH); -$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); -$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /^\d+\.\d+(?:\.(\d+)\.(\d+))?$/ || (0,0)); -$main::build += $VERSION; -$main::branch += $BRANCH; + +main::mkver($VERSION = q$Revision$); use DXChannel; use DXDebug; use Verify; use Thingy; +use Thingy::RouteFilter; use vars qw(@ISA); -@ISA = qw(Thingy); +@ISA = qw(Thingy Thingy::RouteFilter); sub gen_Aranea { my $thing = shift; unless ($thing->{Aranea}) { - my $s = sprintf "%X", int(rand() * 100000000); - my $auth = Verify->new("DXSp,$main::mycall,$s"); - $thing->{Aranea} = Aranea::genmsg($thing, 'Bye', - 's'=>$s, - auth=>$auth->challenge($main::me->user->passphrase) - ); + $thing->{Aranea} = Aranea::genmsg($thing, [qw(s auth)]); } return $thing->{Aranea}; } @@ -42,53 +36,37 @@ sub handle { my $thing = shift; my $dxchan = shift; - - # verify authenticity - if ($dxchan->{call} eq $thing->{origin}) { - # for directly connected calls -# if ($Thingy::Hello::verify_on_login) { -# my $pp = $dxchan->user->passphrase; -# unless ($pp) { -# dbglog('err', "Thingy::Bye::handle: verify on and $thing->{origin} has no passphrase"); -# return; -# } -# my $auth = Verify->new("DXSp,$thing->{origin},$thing->{s}"); -# unless ($auth->verify($thing->{auth}, $dxchan->user->passphrase)) { -# dbglog('err', "Thingy::Bye::handle: verify on and $thing->{origin} failed auth check"); -# return; -# } -# } - - my $int = $thing->{user} || $thing->{origin}; - RouteDB::delete_interface($int); + # fix the interface routing + my $intcall = $thing->{user} || $thing->{origin}; + if ($dxchan->{call} eq $thing->{origin}) { + RouteDB::delete_interface($intcall); } else { - - # for otherwise connected calls, that come in relayed from other nodes - # note that we cannot do any connections at this point - my $nref = Route::Node::get($thing->{origin}); - if ($nref) { - if (my $user = $thing->{user}) { - my $ur = Route::get($user); - if ($ur) { - if ($ur->isa('Route::Node')) { - $nref->del($ur); - } elsif ($ur->isa('Route::User')) { - $nref->del_user($ur); - } - } + RouteDB::delete($intcall, $dxchan->{call}); + } + + # pc prot generation + my @pc21; + if (my $user = $thing->{user}) { + my $parent = Route::Node->get($thing->{origin}); + my $uref = Route::get($user); + if ($parent && $uref) { + if ($uref->isa('Route::Node')) { + @pc21 = $parent->del($uref); + } else { + $parent->del_user($uref); + $thing->{pc17n} = $thing->{origin}; + $thing->{pc17u} = $user; } } + } else { + my $parent = Route::get($thing->{origin}); + @pc21 = $parent->del_nodes if $parent; } + $thing->{pc21n} = \@pc21 if @pc21; $thing->broadcast($dxchan); } -sub new -{ - my $pkg = shift; - my $thing = $pkg->SUPER::new(origin=>$main::mycall, @_); - return $thing; -} 1; diff --git a/perl/Thingy/Dx.pm b/perl/Thingy/Dx.pm index c4d969a0..dd526ea5 100644 --- a/perl/Thingy/Dx.pm +++ b/perl/Thingy/Dx.pm @@ -28,14 +28,15 @@ sub gen_Aranea my $thing = shift; unless ($thing->{Aranea}) { my $sd = $thing->{spotdata}; - my @items = ( - f=>$sd->[0], - c=>$sd->[1], - ); - push @items, ('b', $sd->[4]) unless $thing->{user}; - push @items, ('st', sprintf("%X", $sd->[2] / 60), 'o', $sd->[7]) unless $sd->[7] eq $main::mycall; - push @items, ('i', $sd->[3]) if $sd->[3]; - $thing->{Aranea} = Aranea::genmsg($thing, 'DX', @items); + $thing->{f} = $sd->[0]; + $thing->{c} = $sd->[1]; + $thing->{b} = $sd->[4] unless $thing->{user}; + unless ($sd->[7] eq $main::mycall) { + $thing->{t} = sprintf("%X", $sd->[2] / 60); + $thing->{o} = $sd->[7]; + } + $thing->{i} = $sd->[3] if $sd->[3]; + $thing->{Aranea} = Aranea::genmsg($thing, [qw(f c b t o i)]); } return $thing->{Aranea}; } @@ -44,8 +45,8 @@ sub from_Aranea { my $thing = shift; return unless $thing; - my $t = hex($thing->{st}) if exists $thing->{st}; - $t ||= $thing->{time} / 60; + my $t = hex($thing->{t}) if exists $thing->{t}; + $t ||= $thing->{time} / 60; # if it is an aranea generated my @spot = Spot::prepare( $thing->{f}, $thing->{c}, diff --git a/perl/Thingy/Hello.pm b/perl/Thingy/Hello.pm index f2938c1f..5b639006 100644 --- a/perl/Thingy/Hello.pm +++ b/perl/Thingy/Hello.pm @@ -1,6 +1,9 @@ # # Hello Thingy handling # +# Note that this is a generator of pc19n and pc16n/pc16u +# and a consumer of fpc19n and fpc16n +# # $Id$ # # Copyright (c) 2005 Dirk Koopman G1TLH @@ -18,9 +21,11 @@ use DXChannel; use DXDebug; use Verify; use Thingy; +use Thingy::RouteFilter; +use Thingy::Rt; use vars qw(@ISA $verify_on_login); -@ISA = qw(Thingy); +@ISA = qw(Thingy Thingy::RouteFilter); $verify_on_login = 1; # make sure that a HELLO coming from # the dxchan call is authentic @@ -29,14 +34,13 @@ sub gen_Aranea { my $thing = shift; unless ($thing->{Aranea}) { - my $s = sprintf "%X", int(rand() * 100000000); - my $auth = Verify->new("DXSp,$main::mycall,$s,$main::version,$main::build"); - $thing->{Aranea} = Aranea::genmsg($thing, 'HELLO', sw=>'DXSp', - v=>$main::version, - b=>$main::build, - 's'=>$s, - auth=>$auth->challenge($main::me->user->passphrase) - ); + $thing->add_auth; + + $thing->{sw} ||= 'DXSp'; + $thing->{v} ||= $main::version; + $thing->{b} ||= $main::build; + + $thing->{Aranea} = Aranea::genmsg($thing, [qw(sw v b s auth)]); } return $thing->{Aranea}; } @@ -46,6 +50,9 @@ sub handle my $thing = shift; my $dxchan = shift; + my $nref; + $thing->{pc19n} ||= []; + # verify authenticity if ($dxchan->{call} eq $thing->{origin}) { @@ -69,39 +76,47 @@ sub handle if ($dxchan->{outbound}) { my $thing = Thingy::Hello->new(); $thing->send($dxchan); + + # broadcast our configuration to the world + $thing = Thingy::Rt->new_lcf; + $thing->broadcast; } } + my $origin = $thing->{origin}; + $nref = $main::routeroot->add($origin, $thing->{v}, 1); + push @{$thing->{pc19n}}, $nref if $nref; } else { # for otherwise connected calls, that come in relayed from other nodes # note that we cannot do any connections at this point - my $nref = Route::Node::get($thing->{origin}); + $nref = Route::Node::get($thing->{origin}); unless ($nref) { my $v = $thing->{user} ? undef : $thing->{v}; $nref = Route::Node->new($thing->{origin}, $v, 1); + push @{$thing->{pc19n}}, $nref; } - if (my $user = $thing->{user}) { - my $ur = Route::get($user); - unless ($ur) { - my $uref = DXUser->get_current($user); - if ($uref->is_node || $uref->is_aranea) { - $nref->add($user, $thing->{v}, 1); - } else { - $nref->add_user($user, 1); - } + } + + # handle "User" + if (my $user = $thing->{user}) { + my $ur = Route::get($user); + unless ($ur) { + my $uref = DXUser->get_current($user); + if ($uref->is_node || $uref->is_aranea) { + my $u = $nref->add($user, $thing->{v}, 1); + push @{$thing->{pc19n}}, $u if $u; + } else { + $thing->{pc16n} = $nref; + $thing->{pc16u} = [$nref->add_user($user, 1)]; } } } RouteDB::update($thing->{origin}, $dxchan->{call}, $thing->{hopsaway}); RouteDB::update($thing->{user}, $dxchan->{call}, $thing->{hopsaway}) if $thing->{user}; - + + delete $thing->{pc19n} unless @{$thing->{pc19n}}; + $thing->broadcast($dxchan); } -sub new -{ - my $pkg = shift; - my $thing = $pkg->SUPER::new(origin=>$main::mycall, @_); - return $thing; -} 1; diff --git a/perl/Thingy/Ping.pm b/perl/Thingy/Ping.pm index 1ee84085..6fe808b5 100644 --- a/perl/Thingy/Ping.pm +++ b/perl/Thingy/Ping.pm @@ -11,10 +11,8 @@ use strict; package Thingy::Ping; use vars qw($VERSION $BRANCH); -$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); -$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /^\d+\.\d+(?:\.(\d+)\.(\d+))?$/ || (0,0)); -$main::build += $VERSION; -$main::branch += $BRANCH; + +main::mkver($VERSION = q$Revision$); use DXChannel; use DXDebug; @@ -29,8 +27,7 @@ sub gen_Aranea { my $thing = shift; unless ($thing->{Aranea}) { - my @items; - $thing->{Aranea} = Aranea::genmsg($thing, 'Rloc', @items); + $thing->{Aranea} = Aranea::genmsg($thing); } return $thing->{Aranea}; } @@ -65,7 +62,6 @@ sub from_DXProt my $k = shift; $thing->{$k} = shift; } - ($thing->{hops}) = $thing->{DXProt} =~ /\^H(\d+)\^?~?$/ if exists $thing->{DXProt}; return $thing; } @@ -77,38 +73,4 @@ sub handle $thing->broadcast($dxchan); } -sub in_filter -{ - my $thing = shift; - my $dxchan = shift; - - # global route filtering on INPUT - if ($dxchan->{inroutefilter}) { - my ($filter, $hops) = $dxchan->{inroutefilter}->it($thing->{routedata}); - unless ($filter) { - dbg("PCPROT: Rejected by input route filter") if isdbg('chanerr'); - return; - } - } - return 1; -} - -sub out_filter -{ - my $thing = shift; - my $dxchan = shift; - - # global route filtering on INPUT - if ($dxchan->{routefilter}) { - my ($filter, $hops) = $dxchan->{routefilter}->it($thing->{routedata}); - unless ($filter) { - dbg("PCPROT: Rejected by output route filter") if isdbg('chanerr'); - return; - } - $thing->{hops} = $hops if $hops; - } elsif ($dxchan->{isolate}) { - return; - } - return 1; -} 1; diff --git a/perl/Thingy/RouteFilter.pm b/perl/Thingy/RouteFilter.pm new file mode 100644 index 00000000..0e5bf3e8 --- /dev/null +++ b/perl/Thingy/RouteFilter.pm @@ -0,0 +1,107 @@ +# +# Thingy Route Filter handling +# +# This to provide multiple inheritance to Routing entities +# that wish to do standard filtering +# +# $Id$ +# +# Copyright (c) 2005 Dirk Koopman G1TLH +# + +use strict; + +package Thingy::RouteFilter; + +use vars qw($VERSION $BRANCH); + +main::mkver($VERSION = q$Revision$); + +use DXChannel; +use DXDebug; +use DXProt; +use Thingy; + +use vars qw(@ISA); +@ISA = qw(Thingy); + +sub _filter +{ + my $dxchan = shift; + my $r = shift; + + my ($filter, $hops) = $dxchan->{inroutefilter}->it($dxchan->{call}, $dxchan->{dxcc}, $dxchan->{itu}, $dxchan->{cq}, $r->{call}, $r->{dxcc}, $r->{itu}, $r->{cq}, $dxchan->{state}, $r->{state}); + return $filter ? $r : undef; +} + +sub gen_DXProt +{ + my $thing = shift; + my @out; + push @out, DXProt::pc21(@{$thing->{fpc21n}}) if $thing->{fpc21n}; + push @out, DXProt::pc17($thing->{fpc17n}, $thing->{pc17u}) if $thing->{fpc17n}; + push @out, DXProt::pc19(@{$thing->{fpc19n}}) if $thing->{fpc19n}; + push @out, DXProt::pc16($thing->{fpc16n}, @{$thing->{pc16u}}) if $thing->{fpc16n}; + return \@out; +} + +sub in_filter +{ + my $thing = shift; + my $dxchan = shift; + + # global route filtering on INPUT + if ($dxchan->{inroutefilter}) { + my $r = Route::Node::get($thing->{origin}) || Route->new($thing->{origin}); + my ($filter, $hops) = $dxchan->{inroutefilter}->it($dxchan->{call}, $dxchan->{dxcc}, $dxchan->{itu}, $dxchan->{cq}, $r->{call}, $r->{dxcc}, $r->{itu}, $r->{cq}, $dxchan->{state}, $r->{state}); + unless ($filter) { + dbg("PCPROT: Rejected by input route filter") if isdbg('chanerr'); + return; + } + } elsif ($dxchan->{isolate} && $thing->{origin} ne $main::mycall) { + return; + } + return 1; +} + +sub out_filter +{ + my $thing = shift; + my $dxchan = shift; + + # global route filtering on OUTPUT + if ($dxchan->{routefilter}) { + my $r = Route::Node::get($thing->{origin}); + my ($filter, $hops) = $dxchan->{routefilter}->it($dxchan->{call}, $dxchan->{dxcc}, $dxchan->{itu}, $dxchan->{cq}, $r->{call}, $r->{dxcc}, $r->{itu}, $r->{cq}, $dxchan->{state}, $r->{state}); + unless ($filter) { + dbg("PCPROT: Rejected by output route filter") if isdbg('chanerr'); + return; + } + + if ($dxchan->isa('DXProt')) { + $thing->{hops} = $hops if $hops; + delete $thing->{fpc16n}; + delete $thing->{fpc17n}; + delete $thing->{fpc19n}; + delete $thing->{fpc21n}; + + $thing->{fpc16n} = _filter($dxchan, $thing->{pc16n}) if $thing->{pc16n}; + $thing->{fpc17n} = _filter($dxchan, $thing->{pc17n}) if $thing->{pc17n}; + $thing->{fpc19n} = [_filter($dxchan, @{$thing->{pc19n}})] if $thing->{pc19n}; + $thing->{fpc21n} = [_filter($dxchan, @{$thing->{pc21n}})] if $thing->{pc21n}; + } + return 1; + + } elsif ($dxchan->{isolate}) { + return if $thing->{origin} ne $main::mycall; + } + if ($dxchan->isa('DXProt')) { + $thing->{fpc16n} ||= $thing->{pc16n}; + $thing->{fpc17n} ||= $thing->{pc17n}; + $thing->{fpc19n} ||= $thing->{pc18n}; + $thing->{fpc21n} ||= $thing->{pc21n}; + } + return 1; +} + +1; diff --git a/perl/Thingy/Rt.pm b/perl/Thingy/Rt.pm index f7c503ac..d7d73f48 100644 --- a/perl/Thingy/Rt.pm +++ b/perl/Thingy/Rt.pm @@ -18,21 +18,24 @@ use DXChannel; use DXDebug; use DXUtil; use Thingy; +use Thingy::RouteFilter; use Spot; use vars qw(@ISA); -@ISA = qw(Thingy); +@ISA = qw(Thingy Thingy::RouteFilter); sub gen_Aranea { my $thing = shift; unless ($thing->{Aranea}) { - my @items; - push @items, 's', $thing->{'s'} if $thing->{'s'}; - push @items, 'n', $thing->{n} if $thing->{n}; - push @items, 'v', $thing->{v} if $thing->{v}; - push @items, 'u', $thing->{u} if $thing->{u}; - $thing->{Aranea} = Aranea::genmsg($thing, 'RT', @items) if @items; + my $ref; + if ($ref = $thing->{anodes}) { + $thing->{n} = join(':', map {$_->{call}} @$ref); + } + if ($ref = $thing->{ausers}) { + $thing->{u} = join(':', map {$_->{call}} @$ref); + } + $thing->{Aranea} = Aranea::genmsg($thing, [qw(s n u)]); } return $thing->{Aranea}; } @@ -44,67 +47,13 @@ sub from_Aranea return $thing; } -sub gen_DXProt -{ - my $thing = shift; - my $dxchan = shift; - my $s = $thing->{'s'}; - if ($s eq 'au') { - my $n = $thing->{n} || $thing->{user}; - my @out; - if ($n && (my $u = $thing->{u})) { - my $s = ''; - for (split /:/, $u) { - my ($here, $call) = unpack "A1 A*", $_; - my $str = sprintf "^%s * %d", $call, $here; - if (length($s) + length($str) > $DXProt::sentencelth) { - push @out, "PC16^$n" . $s . sprintf "^%s^", DXProt::get_hops(16); - $s = ''; - } - $s .= $str; - } - push @out, "PC16^$n" . $s . sprintf "^%s^", DXProt::get_hops(16); - $thing->{DXProt} = @out > 1 ? \@out : $out[0]; - } - } elsif ($s eq 'du') { - my $n = $thing->{n} || $thing->{user}; - my $hops = DXProt::get_hops(17); - if ($n && (my $u = $thing->{u})) { - $thing->{DXProt} = "PC17^$u^$n^$hops^"; - } - } elsif ($s eq 'an') { - } elsif ($s eq 'dn') { - } - return $thing->{DXProt}; -} - -#sub gen_DXCommandmode -#{ -# my $thing = shift; -# my $dxchan = shift; -# my $buf; -# -# return $buf; -#} - -sub from_DXProt -{ - my $thing = shift; - while (@_) { - my $k = shift; - $thing->{$k} = shift; - } - ($thing->{hops}) = $thing->{DXProt} =~ /\^H(\d+)\^?~?$/ if exists $thing->{DXProt}; - return $thing; -} - sub handle { my $thing = shift; my $dxchan = shift; - if ($thing->{t}) { - my $sub = "handle_$thing->{t}"; + if ($thing->{'s'}) { + my $sub = "handle_$thing->{s}"; if ($thing->can($sub)) { no strict 'refs'; $thing = $thing->$sub($dxchan); @@ -114,97 +63,6 @@ sub handle } } -# these contain users and either a node (for externals) or the from address -sub handle_au -{ - my $thing = shift; - my $dxchan = shift; - - my $node = $thing->{n} || $thing->{user}; - my $nref = Route::Node::get($node); - - if ($nref) { - if (my $u = $thing->{u}) { - for (split /:/, $u) { - my ($here, $call) = unpack "A1 A*", $_; - add_user($nref, $call, $here); - my $h = $dxchan->{call} eq $nref->{call} ? 3 : ($thing->{hops} || 99); - RouteDB::update($call, $dxchan->{call}, $h); - } - } - } else { - dbg("Thingy::Rt::au: $node not found") if isdbg('chanerr'); - return; - } - return $thing; -} - -sub handle_du -{ - my $thing = shift; - my $dxchan = shift; - - my $node = $thing->{n} || $thing->{user}; - my $nref = Route::Node::get($node); - - if ($nref) { - if (my $u = $thing->{u}) { - for (split /:/, $u) { - my ($here, $call) = unpack "A1 A*", $_; - my $uref = Route::User::get($call); - unless ($uref) { - dbg("Thingy::Rt::du $call not a user") if isdbg('chanerr'); - next; - } - $nref->del_user($uref); - RouteDB::delete($call, $dxchan->{call}); - } - RouteDB::update($nref->{call}, $dxchan->{call}, $dxchan->{call} eq $nref->{call} ? 2 : ($thing->{hops} || 99)); - } - } else { - dbg("Thingy::Rt::du: $node not found") if isdbg('chanerr'); - return; - } - - return $thing; -} - -sub in_filter -{ - my $thing = shift; - my $dxchan = shift; - - # global route filtering on INPUT - if ($dxchan->{inroutefilter}) { - my $r = Route::Node::get($thing->{origin}); - my ($filter, $hops) = $dxchan->{inroutefilter}->it($dxchan->{call}, $dxchan->{dxcc}, $dxchan->{itu}, $dxchan->{cq}, $r->{call}, $r->{dxcc}, $r->{itu}, $r->{cq}, $dxchan->{state}, $r->{state}); - unless ($filter) { - dbg("PCPROT: Rejected by input route filter") if isdbg('chanerr'); - return; - } - } - return 1; -} - -sub out_filter -{ - my $thing = shift; - my $dxchan = shift; - - # global route filtering on OUTPUT - if ($dxchan->{routefilter}) { - my $r = Route::Node::get($thing->{origin}); - my ($filter, $hops) = $dxchan->{routefilter}->it($dxchan->{call}, $dxchan->{dxcc}, $dxchan->{itu}, $dxchan->{cq}, $r->{call}, $r->{dxcc}, $r->{itu}, $r->{cq}, $dxchan->{state}, $r->{state}); - unless ($filter) { - dbg("PCPROT: Rejected by output route filter") if isdbg('chanerr'); - return; - } - $thing->{hops} = $hops if $hops; - } elsif ($dxchan->{isolate}) { - return; - } - return 1; -} sub add_user { @@ -231,4 +89,40 @@ sub upd_user_rec $user->lastin($main::systime) unless DXChannel->get($call); return $user; } + +# +# Generate a configuration for onward broadcast +# +# Basically, this creates a thingy with list of nodes and users that +# are on this node. This the normal method of spreading this +# info whenever a node connects and also periodically. +# + +sub new_lcf +{ + my $pkg = shift; + my $thing = $pkg->SUPER::new(@_); + + $thing->{'s'} = 'lcf'; + + my @nodes; + my @users; + + foreach my $dxchan (DXChannel::get_all()) { + if ($dxchan->is_node || $dxchan->is_aranea) { + my $ref = Route::Node::get($dxchan->{call}); + push @nodes, $ref if $ref; + } else { + my $ref = Route::User::get($dxchan->{call}); + push @users, $ref if $ref; + } + } + $thing->{anodes} = \@nodes if @nodes; + $thing->{ausers} = \@users if @users; + return $thing; +} + + + + 1; diff --git a/perl/Thingy/T.pm b/perl/Thingy/T.pm index d66011bd..cab98120 100644 --- a/perl/Thingy/T.pm +++ b/perl/Thingy/T.pm @@ -11,10 +11,8 @@ use strict; package Thingy::T; use vars qw($VERSION $BRANCH); -$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); -$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /^\d+\.\d+(?:\.(\d+)\.(\d+))?$/ || (0,0)); -$main::build += $VERSION; -$main::branch += $BRANCH; + +main::mkver($VERSION = q$Revision$); use DXChannel; use DXDebug; @@ -29,8 +27,7 @@ sub gen_Aranea { my $thing = shift; unless ($thing->{Aranea}) { - my @items; - $thing->{Aranea} = Aranea::genmsg($thing, 'Rloc', @items); + $thing->{Aranea} = Aranea::genmsg($thing, [qw(d)]); } return $thing->{Aranea}; } @@ -65,7 +62,6 @@ sub from_DXProt my $k = shift; $thing->{$k} = shift; } - ($thing->{hops}) = $thing->{DXProt} =~ /\^H(\d+)\^?~?$/ if exists $thing->{DXProt}; return $thing; } @@ -77,38 +73,4 @@ sub handle $thing->broadcast($dxchan); } -sub in_filter -{ - my $thing = shift; - my $dxchan = shift; - - # global route filtering on INPUT - if ($dxchan->{inroutefilter}) { - my ($filter, $hops) = $dxchan->{inroutefilter}->it($thing->{routedata}); - unless ($filter) { - dbg("PCPROT: Rejected by input route filter") if isdbg('chanerr'); - return; - } - } - return 1; -} - -sub out_filter -{ - my $thing = shift; - my $dxchan = shift; - - # global route filtering on INPUT - if ($dxchan->{routefilter}) { - my ($filter, $hops) = $dxchan->{routefilter}->it($thing->{routedata}); - unless ($filter) { - dbg("PCPROT: Rejected by output route filter") if isdbg('chanerr'); - return; - } - $thing->{hops} = $hops if $hops; - } elsif ($dxchan->{isolate}) { - return; - } - return 1; -} 1; -- 2.43.0