X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FAranea.pm;h=3fb2807290945e3234a61b143d2087203899e2a9;hb=de7f7dbbadcad48ba245f22db044b14954e18782;hp=7f0134c33e32bb0b8061d18684245b514d51f6a4;hpb=b045cd59e152bf125fb32d3c28cc49cf659b8a4d;p=spider.git diff --git a/perl/Aranea.pm b/perl/Aranea.pm index 7f0134c3..3fb28072 100644 --- a/perl/Aranea.pm +++ b/perl/Aranea.pm @@ -25,18 +25,25 @@ 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); main::mkver($VERSION = q$Revision$); -use vars qw(@ISA $ntpflag $dupeage); +use vars qw(@ISA $ntpflag $dupeage $cf_interval $hello_interval); @ISA = qw(DXChannel); $ntpflag = 0; # should be set in startup if NTP in use $dupeage = 12*60*60; # duplicates stored half a day +$cf_interval = 30*60; # interval between config broadcasts +$hello_interval = 3*60*60; # interval between hello broadcasts for me and local users my $seqno = 0; my $dayno = 0; @@ -54,7 +61,6 @@ sub new # add this node to the table, the values get filled in later my $pkg = shift; my $call = shift; - $main::routeroot->add($call, '5251', Route::here(1)) if $call ne $main::mycall; $self->{'sort'} = 'W'; return $self; } @@ -68,7 +74,7 @@ sub start # log it my $host = $self->{conn}->{peerhost} || "unknown"; Log('Aranea', "$call connected from $host"); - + # remember type of connection $self->{consort} = $line; $self->{outbound} = $sort eq 'O'; @@ -116,6 +122,13 @@ 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_cf; + $thing->broadcast; + $self->lastcf($main::systime); + } + # 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; @@ -132,9 +145,11 @@ sub normal } # -# periodic processing +# periodic processing (every second) # +my $lastmin = 0; + sub process { @@ -144,6 +159,40 @@ sub process $dayno = $d; $daystart = $main::systime - ($main::systime % 86400); } + if ($main::systime >= $lastmin + 60) { + if ($lastmin) { + per_minute(); + $lastmin = $main::systime; + } + } +} + +sub per_minute +{ + # send hello and cf packages periodically + foreach my $dxchan (DXChannel::get_all()) { + next if $dxchan == $main::me; + next if $dxchan->is_aranea; + if ($main::systime > $dxchan->lasthello + $hello_interval) { + my $thing = Thingy::Hello->new(user => $dxchan->call, h => $dxchan->here); + $thing->broadcast($dxchan); + $dxchan->lasthello($main::systime); + } + if ($dxchan->is_node) { + if ($main::systime > $dxchan->lasthello + $hello_interval) { + my $call = $dxchan->call; + my $thing = Thingy::Rt->new(user => $call); + if (my $nref = Route::Node::get($call)) { + $thing->copy_pc16_data($nref); + $thing->broadcast($dxchan); + $dxchan->lastcf($main::systime); + } else { + dbg("Aranea::per_minute: Route::Node for $call disappeared"); + $dxchan->disconnect; + } + } + } + } } sub disconnect @@ -152,9 +201,12 @@ sub disconnect my $call = $self->call; return if $self->{disconnecting}++; - + + my $thing = Thingy::Bye->new(origin=>$main::mycall, user=>$call); + $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); @@ -165,7 +217,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"); } } @@ -176,7 +228,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}; @@ -197,6 +249,23 @@ sub disconnect # because it has to be used before a channel is fully initialised). # +sub formathead +{ + my $mycall = shift; + my $dts = shift; + my $hop = shift; + my $user = shift; + my $group = shift; + + my $s = "$mycall,$dts,$hop"; + $s .= ",$user" if $user; + if ($group) { + $s .= "," unless $user; + $s .= ",$group" if $group; + } + return $s; +} + sub genheader { my $mycall = shift; @@ -204,10 +273,7 @@ sub genheader my $from = shift; my $date = ((($dayno << 1) | $ntpflag) << 18) | ($main::systime % 86400); - my $r = "$mycall," . sprintf('%6X%04X,0', $date, $seqno); - $r .= ",$to" if $to; - $r .= "," if $from && !$to; - $r .= ",$from" if $from; + my $r = formathead($mycall, sprintf('%6X%04X', $date, $seqno), 0, $from, $to); $seqno++; $seqno = 0 if $seqno > 0x0ffff; return $r; @@ -250,22 +316,26 @@ sub tdecode my $s = shift; $s =~ s/^'(.*)'$/$1/; $s =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg; - return $s; + return length $s ? $s : ''; } 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"; @@ -285,7 +355,7 @@ sub input my ($head, $data) = split /\|/, $line, 2; return unless $head && $data; - my ($origin, $dts, $hop, $group, $user) = split /,/, $head; + my ($origin, $dts, $hop, $user, $group) = split /,/, $head; return if DXDupe::check("Ara,$origin,$dts", $dupeage); my $err; $err .= "incomplete header," unless $origin && $dts && defined $hop; @@ -295,7 +365,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); @@ -313,9 +384,7 @@ sub input $thing = $class->new(); # reconstitute the header but wth hop increased by one - $head = join(',', $origin, $dts, ++$hop); - $head .= ",$group" if $group; - $head .= ",$user" if $user; + $head = formathead($origin, $dts, ++$hop, $user, $group); $thing->{Aranea} = "$head|$data"; # store useful data