X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=cc468cd54409a0e6cfb3b103aab3187d235baf2b;hb=da115e307d67c9aa6756a7b3b1cfa7a6f70e2e0d;hp=a3049ee329e502b416de681a37129a595b7d5136;hpb=f47bc72134852f42fe03ab6afe91a9ba1b0ff705;p=spider.git diff --git a/perl/DXProt.pm b/perl/DXProt.pm index a3049ee3..cc468cd5 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -33,18 +33,26 @@ use DXHash; use Route; use Route::Node; use Script; +use Investigate; +use RouteDB; +use Thingy; +use Thingy::Dx; +use Thingy::Rt; +use Thingy::Ping; +use Thingy::T; +use Thingy::Hello; +use Thingy::Bye; use strict; 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 vars qw($pc11_max_age $pc23_max_age $last_pc50 $eph_restime $eph_info_restime $eph_pc34_restime $last_hour $last10 %eph %pings %rcmds $ann_to_talk - $pingint $obscount %pc19list $chatdupeage + $pingint $obscount %pc19list $chatdupeage $chatimportfn + $investigation_int $pc19_version $myprot_version %nodehops $baddx $badspotter $badnode $censorpc $rspfcheck $allowzero $decode_dk0wcy $send_opernam @checklist); @@ -71,51 +79,54 @@ $eph_pc34_restime = 30; $pingint = 5*60; $obscount = 2; $chatdupeage = 20 * 60 * 60; +$chatimportfn = "$main::root/chat_import"; +$investigation_int = 12*60*60; # time between checks to see if we can see this node +$pc19_version = 5466; # the visible version no for outgoing PC19s generated from pc59 @checklist = ( - [ qw(c c m bp bc c) ], # pc10 - [ qw(f m d t m c c h) ], # pc11 - [ qw(c bm m bm bm p h) ], # pc12 - [ qw(c h) ], # - [ qw(c h) ], # - [ qw(c m h) ], # + [ qw(i c c m bp bc c) ], # pc10 + [ qw(i f m d t m c c h) ], # pc11 + [ qw(i c bm m bm bm p h) ], # pc12 + [ qw(i c h) ], # + [ qw(i c h) ], # + [ qw(i c m h) ], # undef , # pc16 has to be validated manually - [ qw(c c h) ], # pc17 - [ qw(m n) ], # pc18 + [ qw(i c c h) ], # pc17 + [ qw(i m n) ], # pc18 undef , # pc19 has to be validated manually undef , # pc20 no validation - [ qw(c m h) ], # pc21 + [ qw(i c m h) ], # pc21 undef , # pc22 no validation - [ qw(d n n n n m c c h) ], # pc23 - [ qw(c p h) ], # pc24 - [ qw(c c n n) ], # pc25 - [ qw(f m d t m c c bc) ], # pc26 - [ qw(d n n n n m c c bc) ], # pc27 - [ qw(c c m c d t p m bp n p bp bc) ], # pc28 - [ qw(c c n m) ], # pc29 - [ qw(c c n) ], # pc30 - [ qw(c c n) ], # pc31 - [ qw(c c n) ], # pc32 - [ qw(c c n) ], # pc33 - [ qw(c c m) ], # pc34 - [ qw(c c m) ], # pc35 - [ qw(c c m) ], # pc36 - [ qw(c c n m) ], # pc37 + [ qw(i d n n n n m c c h) ], # pc23 + [ qw(i c p h) ], # pc24 + [ qw(i c c n n) ], # pc25 + [ qw(i f m d t m c c bc) ], # pc26 + [ qw(i d n n n n m c c bc) ], # pc27 + [ qw(i c c m c d t p m bp n p bp bc) ], # pc28 + [ qw(i c c n m) ], # pc29 + [ qw(i c c n) ], # pc30 + [ qw(i c c n) ], # pc31 + [ qw(i c c n) ], # pc32 + [ qw(i c c n) ], # pc33 + [ qw(i c c m) ], # pc34 + [ qw(i c c m) ], # pc35 + [ qw(i c c m) ], # pc36 + [ qw(i c c n m) ], # pc37 undef, # pc38 not interested - [ qw(c m) ], # pc39 - [ qw(c c m p n) ], # pc40 - [ qw(c n m h) ], # pc41 - [ qw(c c n) ], # pc42 + [ qw(i c m) ], # pc39 + [ qw(i c c m p n) ], # pc40 + [ qw(i c n m h) ], # pc41 + [ qw(i c c n) ], # pc42 undef, # pc43 don't handle it - [ qw(c c n m m c) ], # pc44 - [ qw(c c n m) ], # pc45 - [ qw(c c n) ], # pc46 + [ qw(i c c n m m c) ], # pc44 + [ qw(i c c n m) ], # pc45 + [ qw(i c c n) ], # pc46 undef, # pc47 undef, # pc48 - [ qw(c m h) ], # pc49 - [ qw(c n h) ], # pc50 - [ qw(c c n) ], # pc51 + [ qw(i c m h) ], # pc49 + [ qw(i c n h) ], # pc50 + [ qw(i c c n) ], # pc51 undef, undef, undef, @@ -137,7 +148,7 @@ $chatdupeage = 20 * 60 * 60; undef, # pc70 undef, undef, - [ qw(d n n n n n n m m m c c h) ], # pc73 + [ qw(i d n n n n n n m m m c c h) ], # pc73 undef, undef, undef, @@ -148,8 +159,13 @@ $chatdupeage = 20 * 60 * 60; undef, undef, undef, - [ qw(c c c m) ], # pc84 - [ qw(c c c m) ], # pc85 + [ qw(i c c c m) ], # pc84 + [ qw(i c c c m) ], # pc85 + undef, + undef, + undef, + undef, + [ qw(i c n) ], # pc90 ); # use the entry in the check list to check the field list presented @@ -163,28 +179,29 @@ sub check return 0 unless ref $ref; my $i; - shift; # not interested in the first field - for ($i = 0; $i < @$ref; $i++) { + for ($i = 1; $i < @$ref; $i++) { my ($blank, $act) = $$ref[$i] =~ /^(b?)(\w)$/; return 0 unless $act; next if $blank && $_[$i] =~ /^[ \*]$/; if ($act eq 'c') { - return $i+1 unless is_callsign($_[$i]); + return $i unless is_callsign($_[$i]); + } elsif ($act eq 'i') { + ; # do nothing } elsif ($act eq 'm') { - return $i+1 unless is_pctext($_[$i]); + return $i unless is_pctext($_[$i]); } elsif ($act eq 'p') { - return $i+1 unless is_pcflag($_[$i]); + return $i unless is_pcflag($_[$i]); } elsif ($act eq 'f') { - return $i+1 unless is_freq($_[$i]); + return $i unless is_freq($_[$i]); } elsif ($act eq 'n') { - return $i+1 unless $_[$i] =~ /^[\d ]+$/; + return $i unless $_[$i] =~ /^[\d ]+$/; } elsif ($act eq 'h') { - return $i+1 unless $_[$i] =~ /^H\d\d?$/; + return $i unless $_[$i] =~ /^H\d\d?$/; } elsif ($act eq 'd') { - return $i+1 unless $_[$i] =~ /^\s*\d+-\w\w\w-[12][90]\d\d$/; + return $i unless $_[$i] =~ /^\s*\d+-\w\w\w-[12][90]\d\d$/; } elsif ($act eq 't') { - return $i+1 unless $_[$i] =~ /^[012]\d[012345]\dZ$/; - } + return $i unless $_[$i] =~ /^[012]\d[012345]\dZ$/; + } } return 0; } @@ -193,6 +210,21 @@ sub init { do "$main::data/hop_table.pl" if -e "$main::data/hop_table.pl"; confess $@ if $@; + + my $user = DXUser->get($main::mycall); + die "User $main::mycall not setup or disappeared RTFM" unless $user; + + $main::me = DXProt->new($main::mycall, 0, $user); + $main::me->{here} = 1; + $main::me->{state} = "indifferent"; + $main::me->{sort} = 'S'; # S for spider + $main::me->{priv} = 9; + $main::me->{metric} = 0; + $main::me->{pingave} = 0; + $main::me->{registered} = 1; + $main::me->{version} = $myprot_version + int ($main::version * 100); + $main::me->{build} = $main::build; + $main::me->{lastcf} = $main::me->{lasthello} = time; } # @@ -206,8 +238,7 @@ sub new # add this node to the table, the values get filled in later my $pkg = shift; my $call = shift; - $main::routeroot->add($call, '5000', Route::here(1)) if $call ne $main::mycall; - + $main::routeroot->add($call, '5000', 1) if $call ne $main::mycall; return $self; } @@ -277,6 +308,11 @@ sub start $self->state('init'); $self->{pc50_t} = $main::systime; + # ALWAYS output the hello + my $thing = Thingy::Hello->new(user => $call, h => $self->{here}); + $thing->broadcast($self); + $self->lasthello($main::systime); + # send info to all logged in thingies $self->tell_login('loginn'); @@ -295,12 +331,14 @@ sub sendinit $self->send(pc18()); } + # # This is the normal pcxx despatcher # sub normal { my ($self, $line) = @_; + my @field = split /\^/, $line; return unless @field; @@ -308,11 +346,12 @@ sub normal # print join(',', @field), "\n"; - # process PC frames, this will fail unless the frame starts PCnn my ($pcno) = $field[0] =~ /^PC(\d\d)/; # just get the number - return unless $pcno; - return if $pcno < 10 || $pcno > 99; + unless (defined $pcno && $pcno >= 10 && $pcno <= 99) { + dbg("PCPROT: unknown protocol") if isdbg('chanerr'); + return; + } # check for and dump bad protocol messages my $n = check($pcno, @field); @@ -321,20 +360,24 @@ sub normal return; } - # local processing 1 - my $pcr; - eval { - $pcr = Local::pcprot($self, $pcno, @field); - }; -# dbg("Local::pcprot error $@") if isdbg('local') if $@; - return if $pcr; + # decrement any hop fields at this point + if ($line =~ /\^H(\d\d?)\^?~?$/) { + my $hops = $1 - 1; + if ($hops < 0) { + dbg("PCPROT: zero hop count, dumped") if isdbg('chanerr'); + return; + } + $line =~ s/\^H\d\d?(\^?~?)$/^H$hops$1/; + } + my $origin = $self->{call}; no strict 'subs'; my $sub = "handle_$pcno"; + if ($self->can($sub)) { - $self->$sub($pcno, $line, @field); + $self->$sub($pcno, $line, $origin, @field); } else { - $self->handle_default($pcno, $line, @field); + $self->handle_default($pcno, $line, $origin, @field); } } @@ -344,8 +387,9 @@ sub handle_10 my $self = shift; my $pcno = shift; my $line = shift; + my $origin = shift; - # rsfp check + # rsfp check return if $rspfcheck and !$self->rspfcheck(0, $_[6], $_[1]); # will we allow it at all? @@ -389,9 +433,13 @@ sub handle_10 } } + # remember a route to this node and also the node on which this user is + RouteDB::update($_[6], $origin); +# RouteDB::update($to, $_[6]); + # it is here and logged on - $dxchan = DXChannel->get($main::myalias) if $to eq $main::mycall; - $dxchan = DXChannel->get($to) unless $dxchan; + $dxchan = DXChannel::get($main::myalias) if $to eq $main::mycall; + $dxchan = DXChannel::get($to) unless $dxchan; if ($dxchan && $dxchan->is_user) { $_[3] =~ s/\%5E/^/g; $dxchan->talk($from, $to, $via, $_[3]); @@ -409,6 +457,8 @@ sub handle_10 return; } + # can we see an interface to send it down? + # not visible here, send a message of condolence $vref = undef; $ref = Route::get($from); @@ -425,6 +475,7 @@ sub handle_11 my $self = shift; my $pcno = shift; my $line = shift; + my $origin = shift; # route 'foreign' pc26s if ($pcno == 26) { @@ -460,7 +511,7 @@ sub handle_11 } # is it 'baddx' - if ($baddx->in($_[2]) || BadWords::check($_[2]) || $_[2] =~ /COCK/) { + if ($baddx->in($_[2]) || BadWords::check($_[2])) { dbg("PCPROT: Bad DX spot, ignored") if isdbg('chanerr'); return; } @@ -480,28 +531,19 @@ sub handle_11 } } - + # remember a route +# RouteDB::update($_[7], $self->{call}); +# RouteDB::update($_[6], $_[7]); + my @spot = Spot::prepare($_[1], $_[2], $d, $_[5], $_[6], $_[7]); - # global spot filtering on INPUT - if ($self->{inspotsfilter}) { - my ($filter, $hops) = $self->{inspotsfilter}->it(@spot); - unless ($filter) { - dbg("PCPROT: Rejected by input spot filter") if isdbg('chanerr'); - return; - } - } + + my $thing = Thingy::Dx->new(origin=>$main::mycall); + $thing->from_DXProt(DXProt=>$line,spotdata=>\@spot); + $thing->process($self); # this goes after the input filtering, but before the add # so that if it is input filtered, it isn't added to the dup # list. This allows it to come in from a "legitimate" source - if (Spot::dup($_[1], $_[2], $d, $_[5], $_[6])) { - dbg("PCPROT: Duplicate Spot ignored\n") if isdbg('chanerr'); - return; - } - - # add it - Spot::add(@spot); - # # @spot at this point contains:- # freq, spotted call, time, text, spotter, spotted cc, spotters cc, orig node @@ -555,20 +597,6 @@ sub handle_11 } } } - - # local processing - my $r; - eval { - $r = Local::spot($self, @spot); - }; - # dbg("Local::spot1 error $@") if isdbg('local') if $@; - return if $r; - - # DON'T be silly and send on PC26s! - return if $pcno == 26; - - # send out the filtered spots - send_dx_spot($self, $line, @spot) if @spot; } # announces @@ -577,6 +605,7 @@ sub handle_12 my $self = shift; my $pcno = shift; my $line = shift; + my $origin = shift; # return if $rspfcheck and !$self->rspfcheck(1, $_[5], $_[1]); @@ -605,12 +634,17 @@ sub handle_12 return; } + my $dxchan; - if ((($dxchan = DXChannel->get($_[2])) && $dxchan->is_user) || $_[4] =~ /^[\#\w.]+$/){ + if ((($dxchan = DXChannel::get($_[2])) && $dxchan->is_user) || $_[4] =~ /^[\#\w.]+$/){ $self->send_chat($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 '*') { @@ -645,21 +679,16 @@ sub handle_16 my $self = shift; my $pcno = shift; my $line = shift; - - - if (eph_dup($line)) { - dbg("PCPROT: dup PC16 detected") if isdbg('chanerr'); - return; - } + my $origin = shift; # general checks my $dxchan; my $ncall = $_[1]; my $newline = "PC16^"; - # do I want users from this channel? + # dos I want users from this channel? unless ($self->user->wantpc16) { - dbg("PCPROT: don't send users to $self->{call}") if isdbg('chanerr'); + dbg("PCPROT: don't send users to $origin") if isdbg('chanerr'); return; } # is it me? @@ -667,6 +696,24 @@ sub handle_16 dbg("PCPROT: trying to alter config on this node from outside!") if isdbg('chanerr'); return; } + + RouteDB::update($ncall, $self->{call}); + + # do we believe this call? + unless ($ncall eq $self->{call} || $self->is_believed($ncall)) { + if (my $ivp = Investigate::get($ncall, $self->{call})) { + $ivp->store_pcxx($pcno,$line,$origin,@_); + } else { + dbg("PCPROT: We don't believe $ncall on $self->{call}") if isdbg('chanerr'); + } + return; + } + + if (eph_dup($line)) { + dbg("PCPROT: dup PC16 detected") 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, @@ -700,17 +747,17 @@ sub handle_16 dbg("PCPROT: PC19 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr'); $parent = undef; } - if ($parent) { + 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->lastin($main::systime) unless DXChannel::get($ncall); $user->put; # route the pc19 - this will cause 'stuttering PC19s' for a while - $self->route_pc19(@nrout) if @nrout ; + $self->route_pc19($origin, $line, @nrout) if @nrout ; $parent = Route::Node::get($ncall); unless ($parent) { dbg("PCPROT: lost $ncall after sending PC19 for it?"); @@ -726,7 +773,7 @@ sub handle_16 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'); @@ -737,17 +784,23 @@ sub handle_16 return unless $self->in_filter_route($parent); } + # is he under the control of the new protocol? + if ($parent && $parent->np) { + dbg("PCPROT: $ncall aranea node, ignored") if isdbg('chanerr'); + return; + } + my $i; my @rout; for ($i = 2; $i < $#_; $i++) { my ($call, $conf, $here) = $_[$i] =~ /^(\S+) (\S) (\d)/o; next unless $call && $conf && defined $here && is_callsign($call); next if $call eq $main::mycall; - + eph_del_regex("^PC17\\^$call\\^$ncall"); - + $conf = $conf eq '*'; - + # reject this if we think it is a node already my $r = Route::Node::get($call); my $u = DXUser->get_current($call) unless $r; @@ -755,10 +808,10 @@ sub handle_16 dbg("PCPROT: $call is a node") if isdbg('chanerr'); next; } - + $r = Route::User::get($call); - my $flags = Route::here($here)|Route::conf($conf); - + my $flags = $here; + if ($r) { my $au = $r->addparent($parent); if ($r->flags != $flags) { @@ -770,18 +823,17 @@ sub handle_16 push @rout, $parent->add_user($call, $flags); } - + # 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->lastin($main::systime) unless DXChannel->get($call); + $user->lastin($main::systime) unless DXChannel::get($call); $user->put; } - - $self->route_pc16($parent, @rout) if @rout; + $self->route_pc16($origin, $line, $parent, @rout) if @rout; } # remove a user @@ -790,6 +842,7 @@ sub handle_17 my $self = shift; my $pcno = shift; my $line = shift; + my $origin = shift; my $dxchan; my $ncall = $_[2]; my $ucall = $_[1]; @@ -806,34 +859,54 @@ sub handle_17 return; } + RouteDB::delete($ncall, $self->{call}); + + # do we believe this call? + unless ($ncall eq $self->{call} || $self->is_believed($ncall)) { + if (my $ivp = Investigate::get($ncall, $self->{call})) { + $ivp->store_pcxx($pcno,$line,$origin,@_); + } else { + dbg("PCPROT: We don't believe $ncall on $self->{call}") if isdbg('chanerr'); + } + return; + } + my $uref = Route::User::get($ucall); unless ($uref) { dbg("PCPROT: Route::User $ucall not in config") if isdbg('chanerr'); - return; } my $parent = Route::Node::get($ncall); unless ($parent) { dbg("PCPROT: Route::Node $ncall not in config") if isdbg('chanerr'); - return; } - $dxchan = $parent->dxchan; + $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 - return unless $self->in_filter_route($parent); - - $parent->del_user($uref); + # is he under the control of the new protocol? + if ($parent && $parent->np) { + dbg("PCPROT: $ncall aranea node, 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 + } if (eph_dup($line)) { dbg("PCPROT: dup PC17 detected") if isdbg('chanerr'); return; } - $self->route_pc17($parent, $uref); + $uref = Route->new($ucall) unless $uref; # throw away + $self->route_pc17($origin, $line, $parent, $uref); } # link request @@ -842,12 +915,13 @@ sub handle_18 my $self = shift; my $pcno = shift; my $line = shift; + my $origin = shift; $self->state('init'); # record the type and version offered if ($_[1] =~ /DXSpider Version: (\d+\.\d+) Build: (\d+\.\d+)/) { - $self->version(53 + $1); - $self->user->version(53 + $1); + $self->version(0 + $1); + $self->user->version(0 + $1); $self->build(0 + $2); $self->user->build(0 + $2); unless ($self->is_spider) { @@ -862,9 +936,9 @@ sub handle_18 } # first clear out any nodes on this dxchannel - my $parent = Route::Node::get($self->{call}); + my $parent = Route::Node::get($origin); my @rout = $parent->del_nodes; - $self->route_pc21(@rout, $parent) if @rout; + $self->route_pc21($origin, $line, @rout, $parent) if @rout; $self->send_local_config(); $self->send(pc20()); } @@ -875,24 +949,42 @@ sub handle_19 my $self = shift; my $pcno = shift; my $line = shift; + my $origin = shift; my $i; my $newline = "PC19^"; - if (eph_dup($line)) { - dbg("PCPROT: dup PC19 detected") if isdbg('chanerr'); - return; - } - # new routing list my @rout; - my $parent = Route::Node::get($self->{call}); + + # first get the INTERFACE node + my $parent = Route::Node::get($origin); unless ($parent) { - dbg("DXPROT: my parent $self->{call} has disappeared"); + dbg("DXPROT: my parent $origin has disappeared"); $self->disconnect; 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, 1); + my $user = DXUser->get_current($origin); + if (!$user) { + $user = DXUser->new($origin); + $user->priv(1); # I have relented and defaulted nodes + $user->lockout(1); + $user->homenode($origin); + $user->node($origin); + $user->wantroutepc19(1); + } + $user->sort('A') unless $user->is_node; + $user->put; + } + $parent = $op; + } + # parse the PC19 for ($i = 1; $i < $#_-1; $i += 4) { my $here = $_[$i]; @@ -910,9 +1002,9 @@ sub handle_19 next if $call eq $main::mycall; # check that this PC19 isn't trying to alter the wrong dxchan - my $dxchan = DXChannel->get($call); + 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'); + dbg("PCPROT: PC19 from $origin trying to alter wrong locally connected $call, ignored!") if isdbg('chanerr'); next; } @@ -920,16 +1012,44 @@ sub handle_19 my $user = DXUser->get_current($call); if (!$user) { $user = DXUser->new($call); - $user->sort('A'); $user->priv(1); # I have relented and defaulted nodes $user->lockout(1); $user->homenode($call); $user->node($call); } + $user->sort('A') unless $user->is_node; + + RouteDB::update($call, $origin); + + # do we believe this call? + my $genline = "PC19^$here^$call^$conf^$ver^$_[-1]^"; + unless ($call eq $origin || $self->is_believed($call)) { + my $pt = $user->lastping($origin) || 0; + if ($pt+$investigation_int < $main::systime && !Investigate::get($call, $origin)) { + my $ivp = Investigate->new($call, $origin); + $ivp->version($ver); + $ivp->here($here); + $ivp->store_pcxx($pcno,$genline,$origin,'PC19',$here,$call,$conf,$ver,$_[-1]); + } else { + dbg("PCPROT: We don't believe $call on $origin") if isdbg('chanerr'); + } + $user->put; + next; + } + + if (eph_dup($genline)) { + dbg("PCPROT: dup PC19 for $call detected") if isdbg('chanerr'); + next; + } my $r = Route::Node::get($call); - my $flags = Route::here($here)|Route::conf($conf); + my $flags = $here; + # is he under the control of the new protocol? + if ($r && $r->np) { + dbg("PCPROT: $call aranea node, ignored") if isdbg('chanerr'); + next; + } # modify the routing table if it is in it, otherwise store it in the pc19list for now if ($r) { my $ar; @@ -941,15 +1061,10 @@ sub handle_19 next; } } - if ($r->version ne $ver || $r->flags != $flags) { - $r->version($ver); - $r->flags($flags); - push @rout, $r unless $ar; - } } else { # if he is directly connected or allowed then add him, otherwise store him up for later - if ($call eq $self->{call} || $user->wantroutepc19) { + if ($call eq $origin || $user->wantroutepc19) { my $new = Route->new($call); # throw away if ($self->in_filter_route($new)) { my $ar = $parent->add($call, $ver, $flags); @@ -961,7 +1076,7 @@ sub handle_19 } 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; + push @{$pc19list{$call}}, [$origin, $ver, $flags] unless grep $_->[0] eq $origin, @$nl; } } @@ -969,12 +1084,12 @@ sub handle_19 my $mref = DXMsg::get_busy($call); $mref->stop_msg($call) if $mref; - $user->lastin($main::systime) unless DXChannel->get($call); + $user->lastin($main::systime) unless DXChannel::get($call); $user->put; } - $self->route_pc19(@rout) if @rout; + $self->route_pc19($origin, $line, @rout) if @rout; } # send local configuration @@ -983,10 +1098,16 @@ sub handle_20 my $self = shift; my $pcno = shift; my $line = shift; + my $origin = shift; $self->send_local_config(); $self->send(pc22()); $self->state('normal'); $self->{lastping} = 0; + my $thing = Thingy::Rt->new(user=>$self->{call}); + my $nref = Route::Node::get($self->{call}); + $thing->copy_pc16_data($nref); + $thing->broadcast($self); + $self->lastcf($main::systime); } # delete a cluster from the list @@ -995,6 +1116,7 @@ sub handle_21 my $self = shift; my $pcno = shift; my $line = shift; + my $origin = shift; my $call = uc $_[1]; eph_del_regex("^PC1[679].*$call"); @@ -1006,17 +1128,29 @@ sub handle_21 return; } + RouteDB::delete($call, $origin); + + # check if we believe this + unless ($call eq $origin || $self->is_believed($call)) { + if (my $ivp = Investigate::get($call, $origin)) { + $ivp->store_pcxx($pcno,$line,$origin,@_); + } else { + dbg("PCPROT: We don't believe $call on $origin") if isdbg('chanerr'); + } + 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 ]; + $pc19list{$call} = [ grep {$_->[0] ne $origin} @$nl ]; delete $pc19list{$call} unless @{$pc19list{$call}}; } else { - my $parent = Route::Node::get($self->{call}); + my $parent = Route::Node::get($origin); unless ($parent) { - dbg("DXPROT: my parent $self->{call} has disappeared"); + dbg("DXPROT: my parent $origin has disappeared"); $self->disconnect; return; } @@ -1024,14 +1158,20 @@ sub handle_21 my $node = Route::Node::get($call); if ($node) { - my $dxchan = DXChannel->get($call); + 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'); + dbg("PCPROT: PC21 from $origin trying to alter locally connected $call, ignored!") if isdbg('chanerr'); return; } # input filter it return unless $self->in_filter_route($node); + + # is he under the control of the new protocol? + if ($node->np) { + dbg("PCPROT: $call aranea node, ignored") if isdbg('chanerr'); + return; + } # routing objects push @rout, $node->del($parent); @@ -1042,7 +1182,7 @@ sub handle_21 } } - $self->route_pc21(@rout) if @rout; + $self->route_pc21($origin, $line, @rout) if @rout; } @@ -1051,8 +1191,14 @@ sub handle_22 my $self = shift; my $pcno = shift; my $line = shift; + my $origin = shift; $self->state('normal'); $self->{lastping} = 0; + my $thing = Thingy::Rt->new(user=>$self->{call}); + my $nref = Route::Node::get($self->{call}); + $thing->copy_pc16_data($nref); + $thing->broadcast($self); + $self->lastcf($main::systime); } # WWV info @@ -1061,6 +1207,7 @@ sub handle_23 my $self = shift; my $pcno = shift; my $line = shift; + my $origin = shift; # route foreign' pc27s if ($pcno == 27) { @@ -1070,7 +1217,10 @@ sub handle_23 } } - return if $rspfcheck and !$self->rspfcheck(1, $_[8], $_[7]); + # only do a rspf check on PC23 (not 27) + if ($pcno == 23) { + return if $rspfcheck and !$self->rspfcheck(1, $_[8], $_[7]) + } # do some de-duping my $d = cltounix($_[1], sprintf("%02d18Z", $_[2])); @@ -1111,6 +1261,7 @@ sub handle_24 my $self = shift; my $pcno = shift; my $line = shift; + my $origin = shift; my $call = uc $_[1]; my ($nref, $uref); $nref = Route::Node::get($call); @@ -1127,7 +1278,7 @@ sub handle_24 my $ref = $nref || $uref; return unless $self->in_filter_route($ref); - $self->route_pc24($ref, $_[3]); + $self->route_pc24($origin, $line, $ref, $_[3]); } # merge request @@ -1136,6 +1287,7 @@ sub handle_25 my $self = shift; my $pcno = shift; my $line = shift; + my $origin = shift; if ($_[1] ne $main::mycall) { $self->route($_[1], $line); return; @@ -1175,6 +1327,7 @@ sub handle_28 my $self = shift; my $pcno = shift; my $line = shift; + my $origin = shift; if ($_[1] eq $main::mycall) { no strict 'refs'; my $sub = "DXMsg::handle_$pcno"; @@ -1195,6 +1348,7 @@ sub handle_34 my $self = shift; my $pcno = shift; my $line = shift; + my $origin = shift; if (eph_dup($line, $eph_pc34_restime)) { dbg("PCPROT: dupe PC34, ignored") if isdbg('chanerr'); } else { @@ -1208,6 +1362,7 @@ sub handle_35 my $self = shift; my $pcno = shift; my $line = shift; + my $origin = shift; eph_del_regex("^PC35\\^$_[2]\\^$_[1]\\^"); $self->process_rcmd_reply($_[1], $_[2], $_[1], $_[3]); } @@ -1220,7 +1375,14 @@ sub handle_37 my $self = shift; my $pcno = shift; my $line = shift; - DXDb::process($self, $line); + my $origin = shift; + if ($_[1] eq $main::mycall) { + no strict 'refs'; + my $sub = "DXDb::handle_$pcno"; + &$sub($self, @_); + } else { + $self->route($_[1], $line) unless $self->is_clx; + } } # node connected list from neighbour @@ -1229,6 +1391,7 @@ sub handle_38 my $self = shift; my $pcno = shift; my $line = shift; + my $origin = shift; } # incoming disconnect @@ -1237,7 +1400,8 @@ sub handle_39 my $self = shift; my $pcno = shift; my $line = shift; - if ($_[1] eq $self->{call}) { + my $origin = shift; + if ($_[1] eq $origin) { $self->disconnect(1); } else { dbg("PCPROT: came in on wrong channel") if isdbg('chanerr'); @@ -1252,6 +1416,7 @@ sub handle_41 my $self = shift; my $pcno = shift; my $line = shift; + my $origin = shift; my $call = $_[1]; my $l = $line; @@ -1328,6 +1493,7 @@ sub handle_49 my $self = shift; my $pcno = shift; my $line = shift; + my $origin = shift; if (eph_dup($line)) { dbg("PCPROT: Dup PC49 ignored\n") if isdbg('chanerr'); @@ -1347,17 +1513,21 @@ sub handle_50 my $self = shift; my $pcno = shift; my $line = shift; + my $origin = shift; my $call = $_[1]; + + RouteDB::update($call, $origin); + my $node = Route::Node::get($call); if ($node) { - return unless $node->call eq $self->{call}; + return unless $node->call eq $origin; $node->usercount($_[2]); # input filter if required return unless $self->in_filter_route($node); - $self->route_pc50($node, $_[2], $_[3]) unless eph_dup($line); + $self->route_pc50($origin, $line, $node, $_[2], $_[3]) unless eph_dup($line); } } @@ -1367,60 +1537,16 @@ sub handle_51 my $self = shift; my $pcno = shift; my $line = shift; - my $to = $_[1]; - my $from = $_[2]; - my $flag = $_[3]; + my $origin = shift; - - # is it for us? - if ($to eq $main::mycall) { - if ($flag == 1) { - $self->send(pc51($from, $to, '0')); - } else { - # it's a reply, look in the ping list for this one - my $ref = $pings{$from}; - if ($ref) { - my $tochan = DXChannel->get($from); - while (@$ref) { - my $r = shift @$ref; - my $dxchan = DXChannel->get($r->{call}); - next unless $dxchan; - my $t = tv_interval($r->{t}, [ gettimeofday ]); - if ($dxchan->is_user) { - my $s = sprintf "%.2f", $t; - my $ave = sprintf "%.2f", $tochan ? ($tochan->{pingave} || $t) : $t; - $dxchan->send($dxchan->msg('pingi', $from, $s, $ave)) - } elsif ($dxchan->is_node) { - if ($tochan) { - my $nopings = $tochan->user->nopings || $obscount; - push @{$tochan->{pingtime}}, $t; - shift @{$tochan->{pingtime}} if @{$tochan->{pingtime}} > 6; - - # cope with a missed ping, this means you must set the pingint large enough - if ($t > $tochan->{pingint} && $t < 2 * $tochan->{pingint} ) { - $t -= $tochan->{pingint}; - } - - # calc smoothed RTT a la TCP - if (@{$tochan->{pingtime}} == 1) { - $tochan->{pingave} = $t; - } else { - $tochan->{pingave} = $tochan->{pingave} + (($t - $tochan->{pingave}) / 6); - } - $tochan->{nopings} = $nopings; # pump up the timer - } - } - } - } - } - } else { - if (eph_dup($line)) { - dbg("PCPROT: dup PC51 detected") if isdbg('chanerr'); - return; - } - # route down an appropriate thingy - $self->route($to, $line); + if (eph_dup($line, 60)) { + dbg("PCPROT: dup PC51 detected") if isdbg('chanerr'); + return; } + + my $thing = Thingy::Ping->new(origin=>$main::mycall); + $thing->from_DXProt($self, $line, @_); + $thing->handle($self); } # dunno but route it @@ -1429,6 +1555,7 @@ sub handle_75 my $self = shift; my $pcno = shift; my $line = shift; + my $origin = shift; my $call = $_[1]; if ($call ne $main::mycall) { $self->route($call, $line); @@ -1441,6 +1568,7 @@ sub handle_73 my $self = shift; my $pcno = shift; my $line = shift; + my $origin = shift; my $call = $_[1]; # do some de-duping @@ -1474,6 +1602,7 @@ sub handle_84 my $self = shift; my $pcno = shift; my $line = shift; + my $origin = shift; $self->process_rcmd($_[1], $_[2], $_[3], $_[4]); } @@ -1483,9 +1612,10 @@ sub handle_85 my $self = shift; my $pcno = shift; my $line = shift; + my $origin = shift; $self->process_rcmd_reply($_[1], $_[2], $_[3], $_[4]); } - + # if get here then rebroadcast the thing with its Hop count decremented (if # there is one). If it has a hop count and it decrements to zero then don't # rebroadcast it. @@ -1499,6 +1629,7 @@ sub handle_default my $self = shift; my $pcno = shift; my $line = shift; + my $origin = shift; if (eph_dup($line)) { dbg("PCPROT: Ephemeral dup, dropped") if isdbg('chanerr'); @@ -1516,7 +1647,7 @@ sub handle_default sub process { my $t = time; - my @dxchan = DXChannel->get_all(); + my @dxchan = DXChannel::get_all(); my $dxchan; my $pc50s; @@ -1546,11 +1677,15 @@ sub process } } + Investigate::process(); + # every ten seconds if ($t - $last10 >= 10) { # clean out ephemera eph_clean(); + import_chat(); + $last10 = $t; } @@ -1569,41 +1704,12 @@ sub process # -sub send_dx_spot -{ - my $self = shift; - my $line = shift; - my @dxchan = DXChannel->get_all(); - my $dxchan; - - # send it if it isn't the except list and isn't isolated and still has a hop count - # taking into account filtering and so on - foreach $dxchan (@dxchan) { - next if $dxchan == $main::me; - next if $dxchan == $self && $self->is_node; - $dxchan->dx_spot($line, $self->{isolate}, @_, $self->{call}); - } -} - -sub dx_spot -{ - my $self = shift; - my $line = shift; - my $isolate = shift; - my ($filter, $hops); - - if ($self->{spotsfilter}) { - ($filter, $hops) = $self->{spotsfilter}->it(@_); - return unless $filter; - } - send_prot_line($self, $filter, $hops, $isolate, $line); -} - sub send_prot_line { my ($self, $filter, $hops, $isolate, $line) = @_; my $routeit; - + + if ($hops) { $routeit = $line; $routeit =~ s/\^H\d+\^\~$/\^H$hops\^\~/; @@ -1623,22 +1729,10 @@ sub send_wwv_spot { my $self = shift; my $line = shift; - my @dxchan = DXChannel->get_all(); + my @dxchan = DXChannel::get_all(); my $dxchan; - my ($wwv_dxcc, $wwv_itu, $wwv_cq, $org_dxcc, $org_itu, $org_cq) = (0..0); - my @dxcc = Prefix::extract($_[6]); - if (@dxcc > 0) { - $wwv_dxcc = $dxcc[1]->dxcc; - $wwv_itu = $dxcc[1]->itu; - $wwv_cq = $dxcc[1]->cq; - } - @dxcc = Prefix::extract($_[7]); - if (@dxcc > 0) { - $org_dxcc = $dxcc[1]->dxcc; - $org_itu = $dxcc[1]->itu; - $org_cq = $dxcc[1]->cq; - } - + my @dxcc = ((Prefix::cty_data($_[6]))[0..2], (Prefix::cty_data($_[7]))[0..2]); + # send it if it isn't the except list and isn't isolated and still has a hop count # taking into account filtering and so on foreach $dxchan (@dxchan) { @@ -1647,9 +1741,8 @@ sub send_wwv_spot my $routeit; my ($filter, $hops); - $dxchan->wwv($line, $self->{isolate}, @_, $self->{call}, $wwv_dxcc, $wwv_itu, $wwv_cq, $org_dxcc, $org_itu, $org_cq); + $dxchan->wwv($line, $self->{isolate}, @_, $self->{call}, @dxcc); } - } sub wwv @@ -1670,21 +1763,9 @@ sub send_wcy_spot { my $self = shift; my $line = shift; - my @dxchan = DXChannel->get_all(); + my @dxchan = DXChannel::get_all(); my $dxchan; - my ($wcy_dxcc, $wcy_itu, $wcy_cq, $org_dxcc, $org_itu, $org_cq) = (0..0); - my @dxcc = Prefix::extract($_[10]); - if (@dxcc > 0) { - $wcy_dxcc = $dxcc[1]->dxcc; - $wcy_itu = $dxcc[1]->itu; - $wcy_cq = $dxcc[1]->cq; - } - @dxcc = Prefix::extract($_[11]); - if (@dxcc > 0) { - $org_dxcc = $dxcc[1]->dxcc; - $org_itu = $dxcc[1]->itu; - $org_cq = $dxcc[1]->cq; - } + my @dxcc = ((Prefix::cty_data($_[10]))[0..2], (Prefix::cty_data($_[11]))[0..2]); # send it if it isn't the except list and isn't isolated and still has a hop count # taking into account filtering and so on @@ -1692,7 +1773,7 @@ sub send_wcy_spot next if $dxchan == $main::me; next if $dxchan == $self; - $dxchan->wcy($line, $self->{isolate}, @_, $self->{call}, $wcy_dxcc, $wcy_itu, $wcy_cq, $org_dxcc, $org_itu, $org_cq); + $dxchan->wcy($line, $self->{isolate}, @_, $self->{call}, @dxcc); } } @@ -1715,7 +1796,7 @@ sub send_announce { my $self = shift; my $line = shift; - my @dxchan = DXChannel->get_all(); + my @dxchan = DXChannel::get_all(); my $dxchan; my $target; my $to = 'To '; @@ -1736,28 +1817,13 @@ sub send_announce # obtain country codes etc - my ($ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq) = (0..0); - my ($ann_state, $org_state) = ("", ""); - my @dxcc = Prefix::extract($_[0]); - if (@dxcc > 0) { - $ann_dxcc = $dxcc[1]->dxcc; - $ann_itu = $dxcc[1]->itu; - $ann_cq = $dxcc[1]->cq; - $ann_state = $dxcc[1]->state; - } - @dxcc = Prefix::extract($_[4]); - if (@dxcc > 0) { - $org_dxcc = $dxcc[1]->dxcc; - $org_itu = $dxcc[1]->itu; - $org_cq = $dxcc[1]->cq; - $org_state = $dxcc[1]->state; - } - + my @a = Prefix::cty_data($_[0]); + my @b = Prefix::cty_data($_[4]); if ($self->{inannfilter}) { my ($filter, $hops) = $self->{inannfilter}->it(@_, $self->{call}, - $ann_dxcc, $ann_itu, $ann_cq, - $org_dxcc, $org_itu, $org_cq, $ann_state, $org_state); + @a[0..2], + @b[0..2], $a[3], $b[3]); unless ($filter) { dbg("PCPROT: Rejected by input announce filter") if isdbg('chanerr'); return; @@ -1776,7 +1842,8 @@ sub send_announce foreach $dxchan (@dxchan) { next if $dxchan == $main::me; next if $dxchan == $self && $self->is_node; - $dxchan->announce($line, $self->{isolate}, $to, $target, $text, @_, $self->{call}, $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq); + $dxchan->announce($line, $self->{isolate}, $to, $target, $text, @_, $self->{call}, + @a[0..2], @b[0..2]); } } @@ -1794,7 +1861,7 @@ sub send_chat { my $self = shift; my $line = shift; - my @dxchan = DXChannel->get_all(); + my @dxchan = DXChannel::get_all(); my $dxchan; my $target = $_[3]; my $text = unpad($_[2]); @@ -1806,28 +1873,13 @@ sub send_chat } # obtain country codes etc - my ($ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq) = (0..0); - my ($ann_state, $org_state) = ("", ""); - my @dxcc = Prefix::extract($_[0]); - if (@dxcc > 0) { - $ann_dxcc = $dxcc[1]->dxcc; - $ann_itu = $dxcc[1]->itu; - $ann_cq = $dxcc[1]->cq; - $ann_state = $dxcc[1]->state; - } - @dxcc = Prefix::extract($_[4]); - if (@dxcc > 0) { - $org_dxcc = $dxcc[1]->dxcc; - $org_itu = $dxcc[1]->itu; - $org_cq = $dxcc[1]->cq; - $org_state = $dxcc[1]->state; - } - + my @a = Prefix::cty_data($_[0]); + my @b = Prefix::cty_data($_[4]); if ($self->{inannfilter}) { my ($filter, $hops) = $self->{inannfilter}->it(@_, $self->{call}, - $ann_dxcc, $ann_itu, $ann_cq, - $org_dxcc, $org_itu, $org_cq, $ann_state, $org_state); + @a[0..2], + @b[0..2], $a[3], $b[3]); unless ($filter) { dbg("PCPROT: Rejected by input announce filter") if isdbg('chanerr'); return; @@ -1857,7 +1909,8 @@ sub send_chat } } - $dxchan->chat($is_ak1a ? $ak1a_line : $line, $self->{isolate}, $target, $_[1], $text, @_, $self->{call}, $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq); + $dxchan->chat($is_ak1a ? $ak1a_line : $line, $self->{isolate}, $target, $_[1], + $text, @_, $self->{call}, @a[0..2], @b[0..2]); } } @@ -1897,29 +1950,36 @@ sub send_local_config # send our nodes if ($self->{isolate}) { @localnodes = ( $main::routeroot ); + $self->send_route($main::mycall, \&pc19, 1, $main::routeroot); } else { # create a list of all the nodes that are not connected to this connection # and are not themselves isolated, this to make sure that isolated nodes # don't appear outside of this node - my @dxchan = grep { $_->call ne $main::mycall && $_ != $self && !$_->{isolate} } DXChannel::get_all_nodes(); + + # send locally connected nodes + my @dxchan = grep { $_->call ne $main::mycall && $_ != $self && !$_->{isolate} && ($_->is_node || $_->is_aranea) } DXChannel::get_all(); @localnodes = map { my $r = Route::Node::get($_->{call}); $r ? $r : () } @dxchan if @dxchan; - my @intcalls = map { $_->nodes } @localnodes if @localnodes; + $self->send_route($main::mycall, \&pc19, scalar(@localnodes)+1, $main::routeroot, @localnodes); + + my $node; + my @rawintcalls = map { $_->nodes } @localnodes if @localnodes; + my @intcalls; + for $node (@rawintcalls) { + push @intcalls, $node unless grep $node eq $_, @intcalls; + } my $ref = Route::Node::get($self->{call}); my @rnodes = $ref->nodes; - for my $node (@intcalls) { - push @remotenodes, Route::Node::get($node) unless grep $node eq $_, @rnodes; + for $node (@intcalls) { + push @remotenodes, Route::Node::get($node) unless grep $node eq $_, @rnodes, @remotenodes; } - unshift @localnodes, $main::routeroot; + $self->send_route($main::mycall, \&pc19, scalar(@remotenodes), @remotenodes); } - - $self->send_route(\&pc19, scalar(@localnodes)+scalar(@remotenodes), @localnodes, @remotenodes); - # get all the users connected on the above nodes and send them out - foreach $node (@localnodes, @remotenodes) { + foreach $node ($main::routeroot, @localnodes, @remotenodes) { if ($node) { my @rout = map {my $r = Route::User::get($_); $r ? ($r) : ()} $node->users; - $self->send_route(\&pc16, 1, $node, @rout) if @rout && $self->user->wantsendpc16; + $self->send_route($main::mycall, \&pc16, 1, $node, @rout) if @rout && $self->user->wantsendpc16; } else { dbg("sent a null value") if isdbg('chanerr'); } @@ -1931,6 +1991,7 @@ sub send_local_config # # is called route(to, pcline); # + sub route { my ($self, $call, $line) = @_; @@ -1941,8 +2002,10 @@ sub route } # always send it down the local interface if available - my $dxchan = DXChannel->get($call); - unless ($dxchan) { + my $dxchan = DXChannel::get($call); + if ($dxchan) { + dbg("route: $call -> $dxchan->{call} direct" ) if isdbg('route'); + } else { my $cl = Route::get($call); $dxchan = $cl->dxchan if $cl; if (ref $dxchan) { @@ -1950,8 +2013,23 @@ sub route dbg("PCPROT: Trying to route back to source, dropped") if isdbg('chanerr'); return; } + dbg("route: $call -> $dxchan->{call} using normal route" ) if isdbg('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) { @@ -1999,7 +2077,7 @@ sub adjust_hops $s =~ s/\^H(\d+)(\^~?)$/\^H$newhops$2/ if $newhops; } else { # simply decrement it - $hops--; +# $hops--; this is done on receipt now return "" if !$hops; $s =~ s/\^H(\d+)(\^~?)$/\^H$hops$2/ if $hops; } @@ -2023,14 +2101,10 @@ sub load_hops # add a ping request to the ping queues sub addping { - my ($from, $to) = @_; - my $ref = $pings{$to} || []; - my $r = {}; - $r->{call} = $from; - $r->{t} = [ gettimeofday ]; - route(undef, $to, pc51($to, $main::mycall, 1)); - push @$ref, $r; - $pings{$to} = $ref; + my ($from, $to, $via) = @_; + my $thing = Thingy::Ping->new_ping($from eq $main::mycall ? () : (user=>$from), $via ? (touser=> $to, group => $via) : (group => $to)); + $thing->remember; + $thing->broadcast; } sub process_rcmd @@ -2071,13 +2145,13 @@ sub process_rcmd_reply if ($tonode eq $main::mycall) { my $s = $rcmds{$fromnode}; if ($s) { - my $dxchan = DXChannel->get($s->{call}); - my $ref = $user eq $tonode ? $dxchan : (DXChannel->get($user) || $dxchan); + my $dxchan = DXChannel::get($s->{call}); + my $ref = $user eq $tonode ? $dxchan : (DXChannel::get($user) || $dxchan); $ref->send($line) if $ref; delete $rcmds{$fromnode} if !$dxchan; } else { # send unsolicited ones to the sysop - my $dxchan = DXChannel->get($main::myalias); + my $dxchan = DXChannel::get($main::myalias); $dxchan->send($line) if $dxchan; } } else { @@ -2155,6 +2229,8 @@ sub disconnect eph_del_regex("^PC1[679].*$c"); } } + + RouteDB::delete_interface($call); # remove them from the pc19list as well while (my ($k,$v) = each %pc19list) { @@ -2175,11 +2251,14 @@ sub disconnect # broadcast to all other nodes that all the nodes connected to via me are gone unless ($pc39flag && $pc39flag == 2) { - $self->route_pc21(@rout) if @rout; + my $thing = Thingy::Bye->new(user=>$call); + $thing->broadcast($self); + + $self->route_pc21($main::mycall, undef, @rout) if @rout; } # remove outstanding pings - delete $pings{$call}; + Thingy::Ping::forget($call); # I was the last node visited $self->user->node($main::mycall); @@ -2207,9 +2286,11 @@ sub talk # send it if it isn't the except list and isn't isolated and still has a hop count # taking into account filtering and so on + sub send_route { my $self = shift; + my $origin = shift; my $generate = shift; my $no = shift; # the no of things to filter on my $routeit; @@ -2244,6 +2325,7 @@ sub send_route $routeit = adjust_hops($self, $line); # adjust its hop count by node name next unless $routeit; } + $self->send($routeit); } } @@ -2252,10 +2334,11 @@ sub send_route sub broadcast_route { my $self = shift; + my $origin = shift; my $generate = shift; + my $line = shift; my @dxchan = DXChannel::get_all_nodes(); my $dxchan; - my $line; unless ($self->{isolate}) { foreach $dxchan (@dxchan) { @@ -2264,7 +2347,7 @@ sub broadcast_route next unless $dxchan->isa('DXProt'); next if ($generate == \&pc16 || $generate==\&pc17) && !$dxchan->user->wantsendpc16; - $dxchan->send_route($generate, @_); + $dxchan->send_route($origin, $generate, @_); } } } @@ -2273,44 +2356,58 @@ sub route_pc16 { my $self = shift; return unless $self->user->wantpc16; - broadcast_route($self, \&pc16, 1, @_); + my $origin = shift; + my $line = shift; + broadcast_route($self, $origin, \&pc16, $line, 1, @_); } sub route_pc17 { my $self = shift; return unless $self->user->wantpc16; - broadcast_route($self, \&pc17, 1, @_); + my $origin = shift; + my $line = shift; + broadcast_route($self, $origin, \&pc17, $line, 1, @_); } sub route_pc19 { my $self = shift; - broadcast_route($self, \&pc19, scalar @_, @_); + my $origin = shift; + my $line = shift; + broadcast_route($self, $origin, \&pc19, $line, scalar @_, @_); } sub route_pc21 { my $self = shift; - broadcast_route($self, \&pc21, scalar @_, @_); + my $origin = shift; + my $line = shift; + broadcast_route($self, $origin, \&pc21, $line, scalar @_, @_); } sub route_pc24 { my $self = shift; - broadcast_route($self, \&pc24, 1, @_); + my $origin = shift; + my $line = shift; + broadcast_route($self, $origin, \&pc24, $line, 1, @_); } sub route_pc41 { my $self = shift; - broadcast_route($self, \&pc41, 1, @_); + my $origin = shift; + my $line = shift; + broadcast_route($self, $origin, \&pc41, $line, 1, @_); } sub route_pc50 { my $self = shift; - broadcast_route($self, \&pc50, 1, @_); + my $origin = shift; + my $line = shift; + broadcast_route($self, $origin, \&pc50, $line, 1, @_); } sub in_filter_route @@ -2336,6 +2433,7 @@ sub eph_dup $s =~ s/\^H\d\d?\^?\~?$//; $r = 1 if exists $eph{$s}; # pump up the dup if it keeps circulating $eph{$s} = $main::systime + $t; + dbg("PCPROT: emphemeral duplicate") if $r && isdbg('chanerr'); return $r; } @@ -2376,5 +2474,69 @@ sub run_cmd { goto &DXCommandmode::run_cmd; } + + +# import any msgs in the chat directory +# the messages are sent to the chat group which forms the +# the first part of the name (eg: solar.1243.txt would be +# sent to chat group SOLAR) +# +# Each message found is sent: one non-blank line to one chat +# message. So 4 lines = 4 chat messages. +# +# The special name LOCAL is for local users ANN +# The special name ALL is for ANN/FULL +# The special name SYSOP is for ANN/SYSOP +# +sub import_chat +{ + # are there any to do in this directory? + return unless -d $chatimportfn; + unless (opendir(DIR, $chatimportfn)) { + dbg("can\'t open $chatimportfn $!") if isdbg('msg'); + Log('msg', "can\'t open $chatimportfn $!"); + return; + } + + my @names = readdir(DIR); + closedir(DIR); + my $name; + foreach $name (@names) { + next if $name =~ /^\./; + my $splitit = $name =~ /^split/; + my $fn = "$chatimportfn/$name"; + next unless -f $fn; + unless (open(MSG, $fn)) { + dbg("can\'t open import file $fn $!") if isdbg('msg'); + Log('msg', "can\'t open import file $fn $!"); + unlink($fn); + next; + } + my @msg = map { s/\r?\n$//; $_ } ; + close(MSG); + unlink($fn); + + my @cat = split /\./, $name; + my $target = uc $cat[0]; + + foreach my $text (@msg) { + next unless $text && $text !~ /^\s*#/; + if ($target eq 'ALL' || $target eq 'LOCAL' || $target eq 'SYSOP') { + my $sysopflag = $target eq 'SYSOP' ? '*' : ' '; + if ($target ne 'LOCAL') { + send_announce($main::me, pc12($main::mycall, $text, '*', $sysopflag), $main::mycall, '*', $text, $sysopflag, $main::mycall, '0'); + } else { + Log('ann', 'LOCAL', $main::mycall, $text); + DXChannel::broadcast_list("To LOCAL de ${main::mycall}: $text\a", 'ann', undef, DXCommandmode->get_all()); + } + } else { + my $msgid = nextchatmsgid(); + $text = "#$msgid $text"; + send_chat($main::me, pc12($main::mycall, $text, '*', $target), $main::mycall, '*', $text, $target, $main::mycall, '0'); + } + } + } +} + 1; __END__