X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FAranea.pm;h=087eefc3d2f16c639f01384a77107648d95f5771;hb=4d22d5fd3874e8292d82f84a777b99ff7d10402a;hp=ed1c99cda1e429ce27928c5099e9a2e856206596;hpb=6c06ed486e67b3e36e9af4794d2eb84f59f249c4;p=spider.git diff --git a/perl/Aranea.pm b/perl/Aranea.pm index ed1c99cd..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,10 +165,10 @@ 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 - eph_del_regex("^PC1[679]*$call"); + DXProt::eph_del_regex("^PC1[679]*$call"); # do routing stuff, remove me from routing table my $node = Route::Node::get($call); @@ -168,7 +179,7 @@ sub disconnect # and all my ephemera as well for (@rout) { my $c = $_->call; - eph_del_regex("^PC1[679].*$c"); + DXProt::eph_del_regex("^PC1[679].*$c"); } } @@ -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);