From: dirk Date: Thu, 14 Jun 2007 22:03:30 +0000 (+0200) Subject: Merge /scm/spider into SIMPLEROUTE X-Git-Tag: 1.55~160^2~12^2~1 X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=commitdiff_plain;h=d7dbb7fe3680afb068ffc585b1f95690008a9a7d;hp=8e466de8babc0d464a1064c1921e3d1ded78209a;p=spider.git Merge /scm/spider into SIMPLEROUTE Conflicts: .gitignore Changes cmd/Aliases data/.gitignore filter/.gitignore msg/.gitignore perl/DXChannel.pm perl/DXProt.pm perl/DXSql/SQLite.pm perl/DXSql/mysql.pm perl/DXXml.pm perl/DXXml/Cmd.pm perl/DXXml/IM.pm perl/DXXml/Text.pm perl/Msg.pm perl/Route/Node.pm perl/Version.pm Fix merge into existing tree --- diff --git a/.gitignore b/.gitignore index 37eee138..1ca43b05 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,16 @@ local* *~ *.[oa] +*.tmp CVS +tmp +*.bak +.#* +*# +*gz +*zip +.* +!.gitignore +packclus +tutor* +db diff --git a/Changes b/Changes index b1cbb1c9..edf2bfe3 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,8 @@ +13Jun06======================================================================= +1. start using git. +2. change all the version / build numbering. 14Jun07======================================================================= -1. prepare for git repository and moving of anon cvs repository to +1. prepare for git repository and moving of anon cvs repository to scm.tobit.co.uk. 11Jun07======================================================================= 1. Change the frequency normalisation for DX Spot dupe checks so that any @@ -14,12 +17,12 @@ decimal part is thrown away (in other words: truncate the freq to integer khz) 04Mar07======================================================================= 1. add CTY 1702 prefix data files 22Feb07======================================================================= -1. add show/myfdx to Aliases. +1. add show/myfdx to Aliases. 15Feb07======================================================================= 1. allow convkeps.pl to parse NORAD keps files. 22Jan07======================================================================= 1. disable default propagation of PC9x sentences -2. simplify PC17 handling +2. simplify PC17 handling 16Jan07======================================================================= 1. back ported a change to PC16 handling so that a locally connected node's info clears out and generally overrides any residual PC16 info gathered from @@ -27,7 +30,7 @@ elsewhere. 15Jan07======================================================================= 1. added CTY-1701 07Jan07======================================================================= -1. use IO::Socket blocking where available and switch off or ignore all +1. use IO::Socket blocking where available and switch off or ignore all attempts to block. 05Jan07======================================================================= 1. increase default ephemeral deduping on PC15 to 6 minutes (from 2). diff --git a/cmd/Aliases b/cmd/Aliases index 62842671..6656c67b 100644 --- a/cmd/Aliases +++ b/cmd/Aliases @@ -131,12 +131,11 @@ package CmdAlias; '^sho?w?/myd?x?/(\d+)-(\d+)', 'show/dx filter $1-$2', 'show/mydx', '^sho?w?/myd?x?/(\d+)', 'show/dx filter $1', 'show/mydx', '^sho?w?/myd?x?/d(\d+)', 'show/dx filter from $1', 'show/mydx', - '^sho?w?/myd?x?', 'show/dx filter', 'show/mydx', - '^sho?w?/myfd?x?/(\d+)-(\d+)', 'show/dx filter real $1-$2', 'show/mydx', - '^sho?w?/myfd?x?/(\d+)', 'show/dx filter real $1', 'show/mydx', - '^sho?w?/myfd?x?/d(\d+)', 'show/dx filter real from $1', 'show/mydx', - '^sho?w?/myfd?x?', 'show/dx filter real', 'show/mydx', - + '^sho?w?/myd?x?', 'show/dx filter real', 'show/mydx', + '^sho?w?/myfd?x?/(\d+)-(\d+)', 'show/dx filter real $1-$2', 'show/mydx', + '^sho?w?/myfd?x?/(\d+)', 'show/dx filter real $1', 'show/mydx', + '^sho?w?/myfd?x?/d(\d+)', 'show/dx filter real from $1', 'show/mydx', + '^sho?w?/myfd?x?', 'show/dx filter real', 'show/mydx', '^sho?w?/newco?n?\w*/n', 'show/newconfiguration node', 'show/newconfiguration', '^sho?w?/sta?$', 'show/station', 'show/station', '^sho?w?/tnc', 'who', 'who', diff --git a/cmd/announce.pl b/cmd/announce.pl index a3ccb5b0..a3d3fd61 100644 --- a/cmd/announce.pl +++ b/cmd/announce.pl @@ -22,32 +22,25 @@ return (1, $self->msg('e9')) if !@f; return (1, $self->msg('e28')) unless $self->registered; my $sort = uc $f[0]; -my @locals = DXCommandmode->get_all(); -my $to; +my $to = '*'; my $from = $self->call; my $t = ztime(time); my $tonode; my $toflag = '*'; my $sysopflag; +my $via = 'LOCAL'; if ($sort eq "FULL") { $line =~ s/^$f[0]\s+//; # remove it - $to = "ALL"; + $via = $to = "*"; } elsif ($sort eq "SYSOP") { $line =~ s/^$f[0]\s+//; # remove it - @locals = map { $_->priv >= 5 ? $_ : () } @locals; $to = "SYSOP"; - $sysopflag = '*'; + $via = $sysopflag = '*'; } elsif ($sort eq "LOCAL") { $line =~ s/^$f[0]\s+//; # remove it - $to = "LOCAL"; -} else { - $to = "LOCAL"; } -# change ^ into : for transmission -$line =~ s/\^/:/og; - # if this is a 'bad spotter' user then ignore it my $nossid = $from; my $drop = 0; @@ -67,16 +60,18 @@ if (@bad = BadWords::check($line)) { if ($drop) { Log('ann', $to, $from, "[to $from only] $line"); - $self->send("To $to de $from <$t>: $line"); + $self->send("To $to de $from: $line"); return (1, ()); } return (1, $self->msg('dup')) if $self->priv < 5 && AnnTalk::dup($from, $toflag, $line); Log('ann', $to, $from, $line); -DXChannel::broadcast_list("To $to de $from ($t): $line\a", 'ann', undef, @locals); -if ($to ne "LOCAL") { - my $pc = DXProt::pc12($from, $line, $tonode, $sysopflag, 0); - DXChannel::broadcast_nodes($pc); -} +$main::me->normal(DXProt::pc93($to, $from, $via, $line)); + +#DXChannel::broadcast_list("To $to de $from ($t): $line\a", 'ann', undef, @locals); +#if ($to ne "LOCAL") { +# my $pc = DXProt::pc12($from, $line, $tonode, $sysopflag, 0); +# DXChannel::broadcast_nodes($pc); +#} return (1, ()); diff --git a/cmd/chat.pl b/cmd/chat.pl index 41cbb5ca..874f6ac1 100644 --- a/cmd/chat.pl +++ b/cmd/chat.pl @@ -38,6 +38,8 @@ if (@bad = BadWords::check($line)) { my $msgid = DXProt::nextchatmsgid(); $text = "#$msgid $text"; -DXProt::send_chat($self, DXProt::pc12($from, $text, '*', $target), $from, '*', $text, $target, $main::mycall, '0'); +$main::me->normal(DXProt::pc93($target, $from, undef, $text)); + +#DXProt:):send_chat($self, 1, DXProt::pc12($from, $text, '*', $target), $from, '*', $text, $target, $main::mycall, '0'); return (1, ()); diff --git a/cmd/links.pl b/cmd/links.pl index df4476c0..207bf7a7 100644 --- a/cmd/links.pl +++ b/cmd/links.pl @@ -16,7 +16,7 @@ my @out; my $nowt = time; push @out, " Ave Obs Ping Sec Since"; -push @out, " Callsign Type Started RTT count Int. Last Ping"; +push @out, " Callsign Type Started RTT count Int. Last Ping PC92"; foreach $dxchan ( sort {$a->call cmp $b->call} DXChannel::get_all_nodes ) { my $call = $dxchan->call(); @@ -34,7 +34,8 @@ foreach $dxchan ( sort {$a->call cmp $b->call} DXChannel::get_all_nodes ) { $sort = "DXNT" if $dxchan->is_dxnet; $sort = "AR-C" if $dxchan->is_arcluster; $sort = "AK1A" if $dxchan->is_ak1a; - push @out, sprintf "%10s $sort $t$ping $obscount %5d %5d", $call, $pingint, $lastt; + my $pc92 = $dxchan->do_pc9x ? 'Y' : ''; + push @out, sprintf "%10s $sort $t$ping $obscount %5d %5d $pc92", $call, $pingint, $lastt; } return (1, @out) diff --git a/cmd/talk.pl b/cmd/talk.pl index 66d3cd2c..4673392a 100644 --- a/cmd/talk.pl +++ b/cmd/talk.pl @@ -33,9 +33,14 @@ $via = uc $via if $via; my $call = $via ? $via : $to; my $clref = Route::get($call); # try an exact call my $dxchan = $clref->dxchan if $clref; -return (1, $self->msg('e7', $call)) unless $dxchan; +#return (1, $self->msg('e7', $call)) unless $dxchan; return (1, $self->msg('e28')) unless $self->registered || $to eq $main::myalias; +$DB::single = 1; + +# default the 'via' +#$via ||= '*'; + # if there is a line send it, otherwise add this call to the talk list # and set talk mode for command mode if ($line) { @@ -44,21 +49,21 @@ if ($line) { $self->badcount(($self->badcount||0) + @bad); LogDbg('DXCommand', "$self->{call} swore: $line (with words:" . join(',', @bad) . ")"); } else { - $dxchan->talk($self->call, $to, $via, $line) if $dxchan; + $main::me->normal(DXProt::pc93($to, $self->call, $via, $line)); } } else { my $s = $to; - $s .= ">$via" if $via; + $s .= ">$via" if $via && $via ne '*'; my $ref = $self->talklist; if ($ref) { unless (grep { $_ eq $s } @$ref) { - $dxchan->talk($self->call, $to, $via, $self->msg('talkstart')); + $main::me->normal(DXProt::pc93($to, $self->call, $via, $self->msg('talkstart'))); $self->state('talk'); push @$ref, $s; } } else { $self->talklist([ $s ]); - $dxchan->talk($self->call, $to, $via, $self->msg('talkstart')); + $main::me->normal(DXProt::pc93($to, $self->call, $via, $self->msg('talkstart'))); push @out, $self->msg('talkinst'); $self->state('talk'); } diff --git a/cmd/wx.pl b/cmd/wx.pl index 22b5e0cc..02572936 100644 --- a/cmd/wx.pl +++ b/cmd/wx.pl @@ -17,32 +17,52 @@ my ($self, $line) = @_; my @f = split /\s+/, $line; my $sort = uc $f[0]; -my @locals = DXCommandmode->get_all(); my $to; my $from = $self->call; my $t = ztime(time); my $tonode; -my $sysopflag; +my $via; return (1, $self->msg('e5')) if $self->remotecmd || $self->inscript; return (1, $self->msg('e28')) unless $self->registered; if ($sort eq "FULL") { $line =~ s/^$f[0]\s+//; # remove it - $to = "ALL"; -} elsif ($sort eq "SYSOP") { - $line =~ s/^$f[0]\s+//; # remove it - @locals = map { $_->priv >= 5 ? $_ : () } @locals; - $to = "SYSOP"; - $sysopflag = '*'; } else { - $to = "LOCAL"; + $via = "LOCAL"; } +$to = 'WX'; -DXChannel::broadcast_list("WX de $from <$t>: $line", 'wx', undef, @locals); -if ($to ne "LOCAL") { - $line =~ s/\^//og; # remove ^ characters! - my $pc = DXProt::pc12($from, $line, $tonode, $sysopflag, 1); - DXChannel::broadcast_nodes($pc, $main::me); +# if this is a 'bad spotter' user then ignore it +my $nossid = $from; +my $drop = 0; +$nossid =~ s/-\d+$//; +if ($DXProt::badspotter->in($nossid)) { + LogDbg('DXCommand', "bad spotter ($self->{call}) made announcement: $line"); + $drop++; } +# have they sworn? +my @bad; +if (@bad = BadWords::check($line)) { + $self->badcount(($self->badcount||0) + @bad); + LogDbg('DXCommand', "$self->{call} swore: $line (with words:" . join(',', @bad) . ")"); + $drop++; +} + +if ($drop) { + Log('ann', $to, $from, "[to $from only] $line"); + $self->send("WX de $from: $line"); + return (1, ()); +} + +Log('ann', $via ? $via : '*', $from, $line); +$main::me->normal(DXProt::pc93($to, $from, $via, $line)); + +#DXChannel::broadcast_list("WX de $from <$t>: $line", 'wx', undef, @locals); +#if ($to ne "LOCAL") { +# $line =~ s/\^//og; # remove ^ characters! +# my $pc = DXProt::pc12($from, $line, $tonode, $sysopflag, 1); +# DXChannel::broadcast_nodes($pc, $main::me); +#} + return (1, ()); diff --git a/connect/.gitignore b/connect/.gitignore new file mode 100644 index 00000000..16112e11 --- /dev/null +++ b/connect/.gitignore @@ -0,0 +1,3 @@ +* +!.gitignore +!*.issue diff --git a/data/.gitignore b/data/.gitignore index 0a6c856e..6027afdc 100644 --- a/data/.gitignore +++ b/data/.gitignore @@ -8,3 +8,6 @@ dupefile log wwv wcy +motd* +issue +logout diff --git a/data/prefix_data.pl b/data/prefix_data.pl index 4ebb4951..2bd4c84a 100644 --- a/data/prefix_data.pl +++ b/data/prefix_data.pl @@ -278,6 +278,7 @@ '9L' => '301', '9M0' => '261', '9M2' => '302', + '9M2/PG5M' => '261', '9M4' => '302', '9M4SAB' => '303,527', '9M4SDX' => '261', @@ -962,6 +963,7 @@ 'GB0SSF' => '64,351', 'GB0TCH' => '62', 'GB0TD' => '66', + 'GB0TTT' => '66', 'GB0WCY' => '61', 'GB0WOA' => '62', 'GB0WRC' => '66', @@ -970,6 +972,7 @@ 'GB100LP' => '66', 'GB100MAS' => '64,351', 'GB100MER' => '61', + 'GB100TT' => '61', 'GB125BRC' => '64,351', 'GB125SR' => '61', 'GB150NRL' => '64,351', @@ -1567,6 +1570,7 @@ 'KH7K' => '108', 'KH8' => '109,333', 'KH8/S' => '333', + 'KH8S/K3UY' => '333', 'KH8SI' => '333', 'KH9' => '110', 'KI0' => '467,473,477,484,485,489,490,502', @@ -2347,6 +2351,7 @@ 'OG0' => '126', 'OH' => '125,399', 'OH0' => '126', + 'OH0JJS/1' => '125,399', 'OH0M' => '127', 'OI' => '125', 'OI0' => '126', @@ -2497,6 +2502,7 @@ 'R375I' => '176,425,430', 'R3F/9' => '176,425,430', 'R4' => '420', + 'R40WK' => '176,425,430', 'R6' => '421', 'R60A' => '175', 'R60F' => '175', @@ -3758,6 +3764,7 @@ 'WH5' => '105', 'WH5K' => '106', 'WH6' => '387,388', + 'WH6ASW/M' => '220', 'WH7' => '387,388', 'WH7K' => '108', 'WH8' => '109', diff --git a/filter/.gitignore b/filter/.gitignore index 150f68c8..bbfa3dce 100644 --- a/filter/.gitignore +++ b/filter/.gitignore @@ -1 +1,2 @@ -*/* +*.pl +*.pl.o diff --git a/gtkconsole/gtkconsole b/gtkconsole/gtkconsole index ad2d05a3..c02f8075 100755 --- a/gtkconsole/gtkconsole +++ b/gtkconsole/gtkconsole @@ -49,6 +49,8 @@ our ($dx, $cmd, $ann, $wcy, $wwv); # scrolling list windows our $bot; # the cmd entry window our $date; # the current date +require "$root/local/DXVars.pm" if -e "$root/local/DXVars.pm"; + # read in the user data our $userfn = "$ENV{HOME}/.gtkconsole_data"; our $user = read_user_data(); @@ -80,7 +82,7 @@ unless ($call && $host) { my $node = $user->{clusters}->{$user->{node}}; if ($node->{call} || $user->{call}) { - $call = $node->{call} || $user->{call}; + $call = $node->{call} || $user->{call} || $main::myalias; $host = $node->{passwd}; $host = $node->{host}; $port = $node->{port}; @@ -88,15 +90,13 @@ unless ($call && $host) { } unless ($call && $host) { - if (-e "$root/local/DXVars.pm") { - require "$root/local/DXVars.pm"; - $call = $main::myalias; - $call = $main::myalias; # for the warning - } if (-e "$root/local/Listeners.pm") { require "$root/local/Listeners.pm"; $host = $main::listen->[0]->[0]; $port = $main::listen->[0]->[1]; + $host ||= '127.0.0.1'; + $host = "127.0.0.1" if $host eq '0.0.0.0'; + $port ||= 7300; } } @@ -365,11 +365,13 @@ sub read_user_data $u = { clusters => { + 'LOCAL' => {host => '127.0.0.1', port => 7300}, 'GB7DJK' => {host => 'gb7djk.dxcluster.net', port => 7300}, 'WR3D' => {host => 'wr3d.dxcluster.net', port => 7300}, 'GB7BAA' => {host => 'gb7baa.dxcluster.net', port => 7300}, }, - node => 'GB7DJK', + node => 'LOCAL', + call => $main::myalias, }; write_user_data($u); } diff --git a/html/.gitignore b/html/.gitignore new file mode 100644 index 00000000..4cb187e5 --- /dev/null +++ b/html/.gitignore @@ -0,0 +1,2 @@ +mrtg +client diff --git a/html/home.html b/html/home.html index e77c09cd..dd6fcc1f 100644 --- a/html/home.html +++ b/html/home.html @@ -25,7 +25,6 @@ Here are various jumping off points:-

 

Copyright © 1998 by Dirk Koopman G1TLH. All Rights Reserved
- $Id: index.html,v 1.19 2001/04/17 20:44:11 - g0vgs Exp $ + $Id$ diff --git a/html/newprot.html b/html/newprot.html index 1bb84fe2..a0e40c86 100644 --- a/html/newprot.html +++ b/html/newprot.html @@ -208,6 +208,5 @@ sufficient!

Copyright © 2001 by Dirk Koopman G1TLH. All Rights Reserved
-$Id: index.html,v 1.19 2001/04/17 20:44:11 g0vgs Exp -$ +$Id$ diff --git a/mrtg/.gitignore b/mrtg/.gitignore new file mode 100644 index 00000000..d6b7ef32 --- /dev/null +++ b/mrtg/.gitignore @@ -0,0 +1,2 @@ +* +!.gitignore diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 699e87a8..8ab5a6fb 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -119,6 +119,7 @@ $count = 0; lastmsgpoll => '0,Last Msg Poll,atime', inscript => '9,In a script,yesno', handle_xml => '9,Handles XML,yesno', + do_pc9x => '9,Handles PC9x,yesno', inqueue => '9,Input Queue,parray', ); @@ -466,7 +467,7 @@ sub disconnect my $user = $self->{user}; $user->close() if defined $user; - $self->{conn}->disconnect; + $self->{conn}->disconnect if $self->{conn}; $self->del(); } diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 6fbd9f21..f2899786 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -69,7 +69,10 @@ sub new # ALWAYS output the user my $ref = Route::User::get($call); - $main::me->route_pc16($main::mycall, undef, $main::routeroot, $ref) if $ref; + if ($ref) { + $main::me->route_pc16($main::mycall, undef, $main::routeroot, $ref); + $main::me->route_pc92a($main::mycall, undef, $main::routeroot, $ref); + } return $self; } @@ -378,11 +381,11 @@ sub send_talks my ($to, $via) = $ent =~ /(\S+)>(\S+)/; $to = $ent unless $to; - my $call = $via ? $via : $to; + my $call = $via && $via ne '*' ? $via : $to; my $clref = Route::get($call); my $dxchan = $clref->dxchan if $clref; if ($dxchan) { - $dxchan->talk($self->{call}, $to, $via, $line); + $dxchan->talk($self->{call}, $to, undef, $line); } else { $self->send($self->msg('disc2', $via ? $via : $to)); my @l = grep { $_ ne $ent } @{$self->{talklist}}; @@ -571,6 +574,7 @@ sub disconnect # issue a pc17 to everybody interested $main::me->route_pc17($main::mycall, undef, $main::routeroot, $uref); + $main::me->route_pc92d($main::mycall, undef, $main::routeroot, $uref); } else { confess "trying to disconnect a non existant user $call"; } @@ -1167,5 +1171,12 @@ sub import_cmd } } } + +sub print_find_reply +{ + my ($self, $node, $target, $flag, $ms) = @_; + my $sort = $flag == 2 ? "External" : "Local"; + $self->send("$sort $target found at $node in $ms ms" ); +} 1; __END__ diff --git a/perl/DXLog.pm b/perl/DXLog.pm index e2ffaa28..bdf441bb 100644 --- a/perl/DXLog.pm +++ b/perl/DXLog.pm @@ -200,7 +200,7 @@ sub Log sub LogDbg { - DXDebug::dbg($_[$#_]); + DXDebug::dbg($_) for @_; Log(@_); } diff --git a/perl/DXProt.pm b/perl/DXProt.pm index e7fdff90..0cf46bb9 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -32,9 +32,8 @@ use DXHash; use Route; use Route::Node; use Script; -use Investigate; use RouteDB; - +use DXProtHandle; use strict; @@ -44,7 +43,8 @@ use vars qw($pc11_max_age $pc23_max_age $last_pc50 $eph_restime $eph_info_restim $investigation_int $pc19_version $myprot_version %nodehops $baddx $badspotter $badnode $censorpc $rspfcheck $allowzero $decode_dk0wcy $send_opernam @checklist - $eph_pc15_restime + $eph_pc15_restime $pc92_update_period $last_pc92_update + %pc92_find $pc92_find_timeout ); $pc11_max_age = 1*3600; # the maximum age for an incoming 'real-time' pc11 @@ -73,6 +73,12 @@ $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 +$pc92_update_period = 30*60; # the period between PC92 C updates +$last_pc92_update = time + int rand(180); # the last time a PC92 config update +%pc92_find = (); # outstanding pc92 find operations +$pc92_find_timeout = 30; # maximum time to wait for a reply + + @checklist = ( @@ -216,6 +222,7 @@ sub init $main::me->{registered} = 1; $main::me->{version} = $main::version; $main::me->{build} = $main::build; + $main::me->{do_pc9x} = 1; } # @@ -276,1426 +283,113 @@ sub start # get the output filters $self->{spotsfilter} = Filter::read_in('spots', $call, 0) || Filter::read_in('spots', 'node_default', 0); $self->{wwvfilter} = Filter::read_in('wwv', $call, 0) || Filter::read_in('wwv', 'node_default', 0); - $self->{wcyfilter} = Filter::read_in('wcy', $call, 0) || Filter::read_in('wcy', 'node_default', 0); - $self->{annfilter} = Filter::read_in('ann', $call, 0) || Filter::read_in('ann', 'node_default', 0) ; - $self->{routefilter} = Filter::read_in('route', $call, 0) || Filter::read_in('route', 'node_default', 0) unless $self->{isolate} ; - - - # get the INPUT filters (these only pertain to Clusters) - $self->{inspotsfilter} = Filter::read_in('spots', $call, 1) || Filter::read_in('spots', 'node_default', 1); - $self->{inwwvfilter} = Filter::read_in('wwv', $call, 1) || Filter::read_in('wwv', 'node_default', 1); - $self->{inwcyfilter} = Filter::read_in('wcy', $call, 1) || Filter::read_in('wcy', 'node_default', 1); - $self->{inannfilter} = Filter::read_in('ann', $call, 1) || Filter::read_in('ann', 'node_default', 1); - $self->{inroutefilter} = Filter::read_in('route', $call, 1) || Filter::read_in('route', 'node_default', 1) unless $self->{isolate}; - - # set unbuffered and no echo - $self->send_now('B',"0"); - $self->send_now('E',"0"); - $self->conn->echo(0) if $self->conn->can('echo'); - - # ping neighbour node stuff - my $ping = $user->pingint; - $ping = $pingint unless defined $ping; - $self->{pingint} = $ping; - $self->{nopings} = $user->nopings || $obscount; - $self->{pingtime} = [ ]; - $self->{pingave} = 999; - $self->{metric} ||= 100; - $self->{lastping} = $main::systime; - - # send initialisation string - unless ($self->{outbound}) { - $self->sendinit; - } - - $self->state('init'); - $self->{pc50_t} = $main::systime; - - # send info to all logged in thingies - $self->tell_login('loginn'); - - # 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; -} - -# -# send outgoing 'challenge' -# - -sub sendinit -{ - my $self = shift; - $self->send(pc18()); -} - -# -# This is the normal pcxx despatcher -# -sub normal -{ - my ($self, $line) = @_; - - if ($line =~ '^<\w+\s' && $main::do_xml) { - DXXml::normal($self, $line); - return; - } - - my @field = split /\^/, $line; - return unless @field; - - pop @field if $field[-1] eq '~'; - -# 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 - unless (defined $pcno && $pcno >= 10 && $pcno <= 89) { # reject PC9x messages - dbg("PCPROT: unknown protocol") if isdbg('chanerr'); - return; - } - - # check for and dump bad protocol messages - my $n = check($pcno, @field); - if ($n) { - dbg("PCPROT: bad field $n, dumped (" . parray($checklist[$pcno-10]) . ")") if isdbg('chanerr'); - return; - } - - my $origin = $self->{call}; - no strict 'subs'; - my $sub = "handle_$pcno"; - - if ($self->can($sub)) { - $self->$sub($pcno, $line, $origin, @field); - } else { - $self->handle_default($pcno, $line, $origin, @field); - } -} - -# incoming talk commands -sub handle_10 -{ - my $self = shift; - my $pcno = shift; - my $line = shift; - my $origin = shift; - - # rsfp check - return if $rspfcheck and !$self->rspfcheck(0, $_[6], $_[1]); - - # will we allow it at all? - if ($censorpc) { - my @bad; - if (@bad = BadWords::check($_[3])) { - dbg("PCPROT: Bad words: @bad, dropped") if isdbg('chanerr'); - return; - } - } - - # is it for me or one of mine? - my ($from, $to, $via, $call, $dxchan); - $from = $_[1]; - if ($_[5] gt ' ') { - $via = $_[2]; - $to = $_[5]; - } else { - $to = $_[2]; - } - - # if this is a 'nodx' node then ignore it - if ($badnode->in($_[6]) || ($via && $badnode->in($via))) { - dbg("PCPROT: Bad Node, dropped") if isdbg('chanerr'); - return; - } - - # if this is a 'bad spotter' user then ignore it - my $nossid = $from; - $nossid =~ s/-\d+$//; - if ($badspotter->in($nossid)) { - dbg("PCPROT: Bad Spotter, dropped") if isdbg('chanerr'); - return; - } - - # if we are converting announces to talk is it a dup? - if ($ann_to_talk) { - if (AnnTalk::is_talk_candidate($from, $_[3]) && AnnTalk::dup($from, $to, $_[3])) { - dbg("DXPROT: Dupe talk from announce, dropped") if isdbg('chanerr'); - return; - } - } - - # remember a route to this node and also the node on which this user is - RouteDB::update($_[6], $self->{call}); -# 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; - if ($dxchan && $dxchan->is_user) { - $_[3] =~ s/\%5E/^/g; - $dxchan->talk($from, $to, $via, $_[3]); - return; - } - - # is it elsewhere, visible on the cluster via the to address? - # note: this discards the via unless the to address is on - # the via address - my ($ref, $vref); - if ($ref = Route::get($to)) { - $vref = Route::Node::get($via) if $via; - $vref = undef unless $vref && grep $to eq $_, $vref->users; - $ref->dxchan->talk($from, $to, $vref ? $via : undef, $_[3], $_[6]); - return; - } - - # can we see an interface to send it down? - - # not visible here, send a message of condolence - $vref = undef; - $ref = Route::get($from); - $vref = $ref = Route::Node::get($_[6]) unless $ref; - if ($ref) { - $dxchan = $ref->dxchan; - $dxchan->talk($main::mycall, $from, $vref ? $vref->call : undef, $dxchan->msg('talknh', $to) ); - } -} - -# DX Spot handling -sub handle_11 -{ - my $self = shift; - my $pcno = shift; - my $line = shift; - my $origin = shift; - - # route 'foreign' pc26s - if ($pcno == 26) { - if ($_[7] ne $main::mycall) { - $self->route($_[7], $line); - return; - } - } - - # rsfp check - # return if $rspfcheck and !$self->rspfcheck(1, $_[7], $_[6]); - - # is the spotted callsign blank? This should really be trapped earlier but it - # could break other protocol sentences. Also check for lower case characters. - if ($_[2] =~ /^\s*$/) { - dbg("PCPROT: blank callsign, dropped") if isdbg('chanerr'); - return; - } - if ($_[2] =~ /[a-z]/) { - dbg("PCPROT: lowercase characters, dropped") if isdbg('chanerr'); - return; - } - - - # if this is a 'nodx' node then ignore it - if ($badnode->in($_[7])) { - dbg("PCPROT: Bad Node, dropped") if isdbg('chanerr'); - return; - } - - # if this is a 'bad spotter' user then ignore it - my $nossid = $_[6]; - $nossid =~ s/-\d+$//; - if ($badspotter->in($nossid)) { - dbg("PCPROT: Bad Spotter, dropped") if isdbg('chanerr'); - return; - } - - # convert the date to a unix date - my $d = cltounix($_[3], $_[4]); - # bang out (and don't pass on) if date is invalid or the spot is too old (or too young) - if (!$d || ($pcno == 11 && ($d < $main::systime - $pc11_max_age || $d > $main::systime + 900))) { - dbg("PCPROT: Spot ignored, invalid date or out of range ($_[3] $_[4])\n") if isdbg('chanerr'); - return; - } - - # is it 'baddx' - if ($baddx->in($_[2]) || BadWords::check($_[2]) || $_[2] =~ /COCK/) { - dbg("PCPROT: Bad DX spot, ignored") if isdbg('chanerr'); - return; - } - - # do some de-duping - $_[5] =~ s/^\s+//; # take any leading blanks off - $_[2] = unpad($_[2]); # take off leading and trailing blanks from spotted callsign - if ($_[2] =~ /BUST\w*$/) { - dbg("PCPROT: useless 'BUSTED' spot") if isdbg('chanerr'); - return; - } - if ($censorpc) { - my @bad; - if (@bad = BadWords::check($_[5])) { - dbg("PCPROT: Bad words: @bad, dropped") if isdbg('chanerr'); - return; - } - } - - # remember a route -# RouteDB::update($_[7], $self->{call}); -# RouteDB::update($_[6], $_[7]); - - my @spot = Spot::prepare($_[1], $_[2], $d, $_[5], $nossid, $_[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; - } - } - - # 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(@spot[0..4,5])) { - 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 - # then spotted itu, spotted cq, spotters itu, spotters cq - # you should be able to route on any of these - # - - # fix up qra locators of known users - my $user = DXUser->get_current($spot[4]); - if ($user) { - my $qra = $user->qra; - unless ($qra && is_qra($qra)) { - my $lat = $user->lat; - my $long = $user->long; - if (defined $lat && defined $long) { - $user->qra(DXBearing::lltoqra($lat, $long)); - $user->put; - } - } - - # send a remote command to a distant cluster if it is visible and there is no - # qra locator and we havn't done it for a month. - - unless ($user->qra) { - my $node; - my $to = $user->homenode; - my $last = $user->lastoper || 0; - if ($send_opernam && $to && $to ne $main::mycall && $main::systime > $last + $DXUser::lastoperinterval && ($node = Route::Node::get($to)) ) { - my $cmd = "forward/opernam $spot[4]"; - # send the rcmd but we aren't interested in the replies... - my $dxchan = $node->dxchan; - if ($dxchan && $dxchan->is_clx) { - route(undef, $to, pc84($main::mycall, $to, $main::mycall, $cmd)); - } else { - route(undef, $to, pc34($main::mycall, $to, $cmd)); - } - if ($to ne $_[7]) { - $to = $_[7]; - $node = Route::Node::get($to); - if ($node) { - $dxchan = $node->dxchan; - if ($dxchan && $dxchan->is_clx) { - route(undef, $to, pc84($main::mycall, $to, $main::mycall, $cmd)); - } else { - route(undef, $to, pc34($main::mycall, $to, $cmd)); - } - } - } - $user->lastoper($main::systime); - $user->put; - } - } - } - - # 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 -sub handle_12 -{ - my $self = shift; - my $pcno = shift; - my $line = shift; - my $origin = shift; - - # return if $rspfcheck and !$self->rspfcheck(1, $_[5], $_[1]); - - # announce duplicate checking - $_[3] =~ s/^\s+//; # remove leading blanks - - if ($censorpc) { - my @bad; - if (@bad = BadWords::check($_[3])) { - dbg("PCPROT: Bad words: @bad, dropped") if isdbg('chanerr'); - return; - } - } - - # if this is a 'nodx' node then ignore it - if ($badnode->in($_[5])) { - dbg("PCPROT: Bad Node, dropped") if isdbg('chanerr'); - return; - } - - # if this is a 'bad spotter' user then ignore it - my $nossid = $_[1]; - $nossid =~ s/-\d+$//; - if ($badspotter->in($nossid)) { - dbg("PCPROT: Bad Spotter, dropped") if isdbg('chanerr'); - return; - } - - - my $dxchan; - - 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 '*') { - dbg('PCPROT: Probable chat rewrite, dropped') if isdbg('chanerr'); - return; - } - - # here's a bit of fun, convert incoming ann with a callsign in the first word - # or one saying 'to ' to a talk if we can route to the recipient - if ($ann_to_talk) { - my $call = AnnTalk::is_talk_candidate($_[1], $_[3]); - if ($call) { - my $ref = Route::get($call); - if ($ref) { - $dxchan = $ref->dxchan; - $dxchan->talk($_[1], $call, undef, $_[3], $_[5]) if $dxchan != $self; - return; - } - } - } - - # send it - $self->send_announce($line, @_[1..6]); - } else { - $self->route($_[2], $line); - } -} - - -sub handle_15 -{ - my $self = shift; - my $pcno = shift; - my $line = shift; - my $origin = shift; - - if (eph_dup($line, $eph_pc15_restime)) { - dbg("PCPROT: Ephemeral dup, dropped") if isdbg('chanerr'); - } else { - unless ($self->{isolate}) { - DXChannel::broadcast_nodes($line, $self) if $line =~ /\^H\d+\^?~?$/; # send it to everyone but me - } - } -} - -# incoming user -sub handle_16 -{ - my $self = shift; - my $pcno = shift; - my $line = shift; - my $origin = shift; - - # general checks - my $dxchan; - my $ncall = $_[1]; - my $newline = "PC16^"; - - # dos I want users from this channel? - unless ($self->user->wantpc16) { - 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 my config from outside!") if isdbg('chanerr'); - return; - } - if (DXChannel::get($ncall) && $ncall ne $self->{call}) { - dbg("PCPROT: trying to alter locally connected $ncall from $self->{call}, ignored") 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, - # 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); - } - - 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; - } - - # input filter if required - return unless $self->in_filter_route($parent); - } - - 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; - if ($r || ($u && $u->is_node)) { - dbg("PCPROT: $call is a node") if isdbg('chanerr'); - 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); - } - - # send info to all logged in thingies - $self->tell_login('loginu', "$ncall: $call") if DXUser->get_current($ncall)->is_local_node; - $self->tell_buddies('loginb', $call, $ncall); - - # 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->put; - } - $self->route_pc16($origin, $line, $parent, @rout) if @rout; -} - -# remove a user -sub handle_17 -{ - my $self = shift; - my $pcno = shift; - my $line = shift; - my $origin = shift; - my $dxchan; - my $ncall = $_[2]; - my $ucall = $_[1]; - - eph_del_regex("^PC16\\^$ncall.*$ucall"); - - # do I want users from this channel? - unless ($self->user->wantpc16) { - dbg("PCPROT: don't send users to $self->{call}") if isdbg('chanerr'); - return; - } - if ($ncall eq $main::mycall) { - dbg("PCPROT: trying to alter config on this node from outside!") if isdbg('chanerr'); - 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 = DXChannel::get($ncall); - 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 -# return unless $self->in_filter_route($parent); - $parent->del_user($uref); - - # send info to all logged in thingies - $self->tell_login('logoutu', "$ncall: $ucall") if DXUser->get_current($ncall)->is_local_node; - $self->tell_buddies('logoutb', $ucall, $ncall); - - if (eph_dup($line)) { - dbg("PCPROT: dup PC17 detected") if isdbg('chanerr'); - return; - } - - $self->route_pc17($origin, $line, $parent, $uref); -} - -# link request -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->build(0 + $2); - $self->user->build(0 + $2); - unless ($self->is_spider) { - $self->user->sort('S'); - $self->user->put; - $self->sort('S'); - } - $self->{handle_xml}++ if DXXml::available() && $_[1] =~ /\bxml\b/; - } else { - $self->version(50.0); - $self->version($_[2] / 100) if $_[2] && $_[2] =~ /^\d+$/; - $self->user->version($self->version); - } - - # first clear out any nodes on this dxchannel - my $parent = Route::Node::get($self->{call}); - my @rout = $parent->del_nodes; - $self->route_pc21($origin, $line, @rout, $parent) if @rout; - $self->send_local_config(); - $self->send(pc20()); -} - -# incoming cluster list -sub handle_19 -{ - my $self = shift; - my $pcno = shift; - my $line = shift; - my $origin = shift; - - my $i; - my $newline = "PC19^"; - - # new routing list - my @rout; - - # first get the INTERFACE node - my $parent = Route::Node::get($self->{call}); - unless ($parent) { - dbg("DXPROT: my parent $self->{call} 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, Route::here(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]; - my $call = uc $_[$i+1]; - my $conf = $_[$i+2]; - 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 unless $ver && $ver =~ /^\d+$/; - 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; - } - - # add this station to the user database, if required (don't remove SSID from nodes) - my $user = DXUser->get_current($call); - if (!$user) { - $user = DXUser->new($call); - $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, $self->{call}); - - # do we believe this call? - my $genline = "PC19^$here^$call^$conf^$ver^$_[-1]^"; - unless ($call eq $self->{call} || $self->is_believed($call)) { - my $pt = $user->lastping($self->{call}) || 0; - if ($pt+$investigation_int < $main::systime && !Investigate::get($call, $self->{call})) { - my $ivp = Investigate->new($call, $self->{call}); - $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 $self->{call}") 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); - - # 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 { - - # 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; - } - } - - # unbusy and stop and outgoing mail (ie if somehow we receive another PC19 without a disconnect) - my $mref = DXMsg::get_busy($call); - $mref->stop_msg($call) if $mref; - - $user->lastin($main::systime) unless DXChannel::get($call); - $user->put; - } - - - $self->route_pc19($origin, $line, @rout) if @rout; -} - -# send local configuration -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; -} - -# delete a cluster from the list -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"); - - # if I get a PC21 from the same callsign as self then treat it - # as a PC39: I have gone away - if ($call eq $self->call) { - $self->disconnect(1); - return; - } - - RouteDB::delete($call, $self->{call}); - - # check if we believe this - unless ($call eq $self->{call} || $self->is_believed($call)) { - if (my $ivp = Investigate::get($call, $self->{call})) { - $ivp->store_pcxx($pcno,$line,$origin,@_); - } else { - dbg("PCPROT: We don't believe $call on $self->{call}") 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 ]; - 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; - } - } - - $self->route_pc21($origin, $line, @rout) if @rout; -} - - -sub handle_22 -{ - my $self = shift; - my $pcno = shift; - my $line = shift; - my $origin = shift; - $self->state('normal'); - $self->{lastping} = 0; -} - -# WWV info -sub handle_23 -{ - my $self = shift; - my $pcno = shift; - my $line = shift; - my $origin = shift; - - # route foreign' pc27s - if ($pcno == 27) { - if ($_[8] ne $main::mycall) { - $self->route($_[8], $line); - return; - } - } - - # 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])); - my $sfi = unpad($_[3]); - my $k = unpad($_[4]); - my $i = unpad($_[5]); - my ($r) = $_[6] =~ /R=(\d+)/; - $r = 0 unless $r; - if (($pcno == 23 && $d < $main::systime - $pc23_max_age) || $d > $main::systime + 1500 || $_[2] < 0 || $_[2] > 23) { - dbg("PCPROT: WWV Date ($_[1] $_[2]) out of range") if isdbg('chanerr'); - return; - } - - # global wwv filtering on INPUT - my @dxcc = ((Prefix::cty_data($_[7]))[0..2], (Prefix::cty_data($_[8]))[0..2]); - if ($self->{inwwvfilter}) { - my ($filter, $hops) = $self->{inwwvfilter}->it(@_[7,8], $origin, @dxcc); - unless ($filter) { - dbg("PCPROT: Rejected by input wwv filter") if isdbg('chanerr'); - return; - } - } - $_[7] =~ s/-\d+$//o; # remove spotter's ssid - if (Geomag::dup($d,$sfi,$k,$i,$_[6],$_[7])) { - dbg("PCPROT: Dup WWV Spot ignored\n") if isdbg('chanerr'); - return; - } - - # note this only takes the first one it gets - Geomag::update($d, $_[2], $sfi, $k, $i, @_[6..8], $r); - - my $rep; - eval { - $rep = Local::wwv($self, $_[1], $_[2], $sfi, $k, $i, @_[6..8], $r); - }; - # dbg("Local::wwv2 error $@") if isdbg('local') if $@; - return if $rep; - - # DON'T be silly and send on PC27s! - return if $pcno == 27; - - # broadcast to the eager world - send_wwv_spot($self, $line, $d, $_[2], $sfi, $k, $i, @_[6..8]); -} - -# set here status -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); - $uref = Route::User::get($call); - return unless $nref || $uref; # if we don't know where they are, it's pointless sending it on - - if (eph_dup($line)) { - dbg("PCPROT: Dup PC24 ignored\n") if isdbg('chanerr'); - return; - } - - $nref->here($_[2]) if $nref; - $uref->here($_[2]) if $uref; - my $ref = $nref || $uref; - return unless $self->in_filter_route($ref); - - $self->route_pc24($origin, $line, $ref, $_[3]); -} - -# merge request -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; - } - if ($_[2] eq $main::mycall) { - dbg("PCPROT: Trying to merge to myself, ignored") if isdbg('chanerr'); - return; - } - - Log('DXProt', "Merge request for $_[3] spots and $_[4] WWV from $_[2]"); - - # spots - if ($_[3] > 0) { - my @in = reverse Spot::search(1, undef, undef, 0, $_[3]); - my $in; - foreach $in (@in) { - $self->send(pc26(@{$in}[0..4], $_[2])); - } - } - - # wwv - if ($_[4] > 0) { - my @in = reverse Geomag::search(0, $_[4], time, 1); - my $in; - foreach $in (@in) { - $self->send(pc27(@{$in}[0..5], $_[2])); - } - } -} - -sub handle_26 {goto &handle_11} -sub handle_27 {goto &handle_23} - -# mail/file handling -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"; - &$sub($self, @_); - } else { - $self->route($_[1], $line) unless $self->is_clx; - } -} - -sub handle_29 {goto &handle_28} -sub handle_30 {goto &handle_28} -sub handle_31 {goto &handle_28} -sub handle_32 {goto &handle_28} -sub handle_33 {goto &handle_28} - -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 { - $self->process_rcmd($_[1], $_[2], $_[2], $_[3]); - } -} - -# remote command replies -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]); -} - -sub handle_36 {goto &handle_34} - -# database stuff -sub handle_37 -{ - my $self = shift; - my $pcno = shift; - my $line = shift; - 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 -sub handle_38 -{ - my $self = shift; - my $pcno = shift; - my $line = shift; - my $origin = shift; -} - -# incoming disconnect -sub handle_39 -{ - my $self = shift; - my $pcno = shift; - my $line = shift; - my $origin = shift; - if ($_[1] eq $self->{call}) { - $self->disconnect(1); - } else { - dbg("PCPROT: came in on wrong channel") if isdbg('chanerr'); - } -} - -sub handle_40 {goto &handle_28} - -# user info -sub handle_41 -{ - my $self = shift; - my $pcno = shift; - my $line = shift; - my $origin = shift; - my $call = $_[1]; - - my $l = $line; - $l =~ s/[\x00-\x20\x7f-\xff]+//g; # remove all funny characters and spaces for dup checking - if (eph_dup($l, $eph_info_restime)) { - dbg("PCPROT: dup PC41, ignored") if isdbg('chanerr'); - return; - } - - # input filter if required - # my $ref = Route::get($call) || Route->new($call); - # return unless $self->in_filter_route($ref); - - if ($_[3] eq $_[2] || $_[3] =~ /^\s*$/) { - dbg('PCPROT: invalid value') if isdbg('chanerr'); - return; - } - - # add this station to the user database, if required - my $user = DXUser->get_current($call); - $user = DXUser->new($call) unless $user; - - if ($_[2] == 1) { - if (($_[3] =~ /spotter/i || $_[3] =~ /self/i) && $user->name && $user->name ne $_[3]) { - dbg("PCPROT: invalid name") if isdbg('chanerr'); - return; - } - $user->name($_[3]); - } elsif ($_[2] == 2) { - $user->qth($_[3]); - } elsif ($_[2] == 3) { - if (is_latlong($_[3])) { - my ($lat, $long) = DXBearing::stoll($_[3]); - $user->lat($lat); - $user->long($long); - $user->qra(DXBearing::lltoqra($lat, $long)); - } else { - dbg('PCPROT: not a valid lat/long') if isdbg('chanerr'); - return; - } - } elsif ($_[2] == 4) { - $user->homenode($_[3]); - } elsif ($_[2] == 5) { - if (is_qra(uc $_[3])) { - my ($lat, $long) = DXBearing::qratoll(uc $_[3]); - $user->lat($lat); - $user->long($long); - $user->qra(uc $_[3]); - } else { - dbg('PCPROT: not a valid QRA locator') if isdbg('chanerr'); - return; - } - } - $user->lastoper($main::systime); # to cut down on excessive for/opers being generated - $user->put; - - unless ($self->{isolate}) { - DXChannel::broadcast_nodes($line, $self); # send it to everyone but me - } - - # perhaps this IS what we want after all - # $self->route_pc41($ref, $call, $_[2], $_[3], $_[4]); -} - -sub handle_42 {goto &handle_28} - - -# database -sub handle_44 {goto &handle_37} -sub handle_45 {goto &handle_37} -sub handle_46 {goto &handle_37} -sub handle_47 {goto &handle_37} -sub handle_48 {goto &handle_37} - -# message and database -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'); - return; - } - - if ($_[1] eq $main::mycall) { - DXMsg::handle_49($self, @_); - } else { - $self->route($_[1], $line) unless $self->is_clx; - } -} - -# keep alive/user list -sub handle_50 -{ - my $self = shift; - my $pcno = shift; - my $line = shift; - my $origin = shift; - - my $call = $_[1]; - - RouteDB::update($call, $self->{call}); - - my $node = Route::Node::get($call); - if ($node) { - return unless $node->call eq $self->{call}; - $node->usercount($_[2]); + $self->{wcyfilter} = Filter::read_in('wcy', $call, 0) || Filter::read_in('wcy', 'node_default', 0); + $self->{annfilter} = Filter::read_in('ann', $call, 0) || Filter::read_in('ann', 'node_default', 0) ; + $self->{routefilter} = Filter::read_in('route', $call, 0) || Filter::read_in('route', 'node_default', 0) unless $self->{isolate} ; - # input filter if required - return unless $self->in_filter_route($node); - $self->route_pc50($origin, $line, $node, $_[2], $_[3]) unless eph_dup($line); + # get the INPUT filters (these only pertain to Clusters) + $self->{inspotsfilter} = Filter::read_in('spots', $call, 1) || Filter::read_in('spots', 'node_default', 1); + $self->{inwwvfilter} = Filter::read_in('wwv', $call, 1) || Filter::read_in('wwv', 'node_default', 1); + $self->{inwcyfilter} = Filter::read_in('wcy', $call, 1) || Filter::read_in('wcy', 'node_default', 1); + $self->{inannfilter} = Filter::read_in('ann', $call, 1) || Filter::read_in('ann', 'node_default', 1); + $self->{inroutefilter} = Filter::read_in('route', $call, 1) || Filter::read_in('route', 'node_default', 1) unless $self->{isolate}; + + # set unbuffered and no echo + $self->send_now('B',"0"); + $self->send_now('E',"0"); + $self->conn->echo(0) if $self->conn->can('echo'); + + # ping neighbour node stuff + my $ping = $user->pingint; + $ping = $pingint unless defined $ping; + $self->{pingint} = $ping; + $self->{nopings} = $user->nopings || $obscount; + $self->{pingtime} = [ ]; + $self->{pingave} = 999; + $self->{metric} ||= 100; + $self->{lastping} = $main::systime; + + # send initialisation string + unless ($self->{outbound}) { + $self->sendinit; } -} - -# incoming ping requests/answers -sub handle_51 -{ - my $self = shift; - my $pcno = shift; - my $line = shift; - my $origin = shift; - my $to = $_[1]; - my $from = $_[2]; - my $flag = $_[3]; - - - # is it for us? - if ($to eq $main::mycall) { - if ($flag == 1) { - $self->send(pc51($from, $to, '0')); - } else { - DXXml::Ping::handle_ping_reply($self, $from); - } - } else { + + $self->state('init'); + $self->{pc50_t} = $main::systime; - RouteDB::update($from, $self->{call}); + # send info to all logged in thingies + $self->tell_login('loginn'); - if (eph_dup($line)) { - dbg("PCPROT: dup PC51 detected") if isdbg('chanerr'); - return; - } - # route down an appropriate thingy - $self->route($to, $line); - } + # 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; } -# dunno but route it -sub handle_75 +# +# send outgoing 'challenge' +# + +sub sendinit { my $self = shift; - my $pcno = shift; - my $line = shift; - my $origin = shift; - my $call = $_[1]; - if ($call ne $main::mycall) { - $self->route($call, $line); - } + $self->send(pc18()); } -# WCY broadcasts -sub handle_73 +# +# This is the normal pcxx despatcher +# +sub normal { - my $self = shift; - my $pcno = shift; - my $line = shift; - my $origin = shift; - my $call = $_[1]; - - # do some de-duping - my $d = cltounix($call, sprintf("%02d18Z", $_[2])); - if (($pcno == 23 && $d < $main::systime - $pc23_max_age) || $d > $main::systime + 1500 || $_[2] < 0 || $_[2] > 23) { - dbg("PCPROT: WCY Date ($call $_[2]) out of range") if isdbg('chanerr'); + my ($self, $line) = @_; + + if ($line =~ '^<\w+\s' && $main::do_xml) { + DXXml::normal($self, $line); return; } - @_ = map { unpad($_) } @_; - if (WCY::dup($d)) { - dbg("PCPROT: Dup WCY Spot ignored\n") if isdbg('chanerr'); + + my @field = split /\^/, $line; + return unless @field; + + pop @field if $field[-1] eq '~'; + +# 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 + unless (defined $pcno && $pcno >= 10 && $pcno <= 99) { + dbg("PCPROT: unknown protocol") if isdbg('chanerr'); return; } - - my $wcy = WCY::update($d, @_[2..12]); - - my $rep; - eval { - $rep = Local::wcy($self, @_[1..12]); - }; - # dbg("Local::wcy error $@") if isdbg('local') if $@; - return if $rep; - - # broadcast to the eager world - send_wcy_spot($self, $line, $d, @_[2..12]); -} - -# remote commands (incoming) -sub handle_84 -{ - my $self = shift; - my $pcno = shift; - my $line = shift; - my $origin = shift; - $self->process_rcmd($_[1], $_[2], $_[3], $_[4]); -} -# remote command replies -sub handle_85 -{ - my $self = shift; - my $pcno = shift; - my $line = shift; - my $origin = shift; - $self->process_rcmd_reply($_[1], $_[2], $_[3], $_[4]); -} + # check for and dump bad protocol messages + my $n = check($pcno, @field); + if ($n) { + dbg("PCPROT: bad field $n, dumped (" . parray($checklist[$pcno-10]) . ")") if isdbg('chanerr'); + return; + } -# 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. -# -# NOTE - don't arrive here UNLESS YOU WANT this lump of protocol to be -# REBROADCAST!!!! -# + # modify the hop count here + if ($self != $main::me) { + if (my ($hops, $trail) = $line =~ /\^H(\d+)(\^?\~?)?$/) { + $trail ||= ''; + $hops--; + return if $hops < 0; + $line =~ s/\^H(\d+)(\^?\~?)?$/sprintf('^H%d%s', $hops, $trail)/e; + $field[-1] = "H$hops"; + } + } -sub handle_default -{ - my $self = shift; - my $pcno = shift; - my $line = shift; - my $origin = shift; + # send it out for processing + my $origin = $self->{call}; + no strict 'subs'; + my $sub = "handle_$pcno"; - if (eph_dup($line)) { - dbg("PCPROT: Ephemeral dup, dropped") if isdbg('chanerr'); + if ($self->can($sub)) { + $self->$sub($pcno, $line, $origin, @field); } else { - unless ($self->{isolate}) { - DXChannel::broadcast_nodes($line, $self) if $line =~ /\^H\d+\^?~?$/; # send it to everyone but me - } + $self->handle_default($pcno, $line, $origin, @field); } } @@ -1739,6 +433,7 @@ sub process } Investigate::process(); + clean_pc92_find(); # every ten seconds if ($t - $last10 >= 10) { @@ -1746,8 +441,14 @@ sub process eph_clean(); import_chat(); - + if ($main::systime >= $last_pc92_update + $pc92_update_period) { + dbg("ROUTE: sending pc92 update") if isdbg('route'); + send_pc92_update(); + time_out_pc92_routes(); + $last_pc92_update = $main::systime + int rand(5*60); + } + $last10 = $t; } @@ -1886,10 +587,11 @@ sub wcy sub send_announce { my $self = shift; + my $from_pc9x = shift; my $line = shift; my @dxchan = DXChannel::get_all(); my $dxchan; - my $target; + my $target = $_[6]; my $to = 'To '; my $text = unpad($_[2]); @@ -1898,7 +600,7 @@ sub send_announce } elsif ($_[3] gt ' ') { # speciality list handling my ($name) = split /\./, $_[3]; $target = "$name"; # put the rest in later (if bothered) - } + } if ($_[5] eq '1') { $target = "WX"; @@ -1933,6 +635,8 @@ sub send_announce foreach $dxchan (@dxchan) { next if $dxchan == $main::me; next if $dxchan == $self && $self->is_node; + next if $from_pc9x && $dxchan->{do_pc9x}; + next if $target eq 'LOCAL' && $dxchan->is_node; $dxchan->announce($line, $self->{isolate}, $to, $target, $text, @_, $self->{call}, @a[0..2], @b[0..2]); } @@ -1951,6 +655,7 @@ sub nextchatmsgid sub send_chat { my $self = shift; + my $from_pc9x = shift; my $line = shift; my @dxchan = DXChannel::get_all(); my $dxchan; @@ -1993,10 +698,11 @@ sub send_chat if ($dxchan->is_node) { next if $dxchan == $main::me; next if $dxchan == $self; + next if $from_pc9x && $dxchan->{do_pc9x}; next unless $dxchan->is_spider || $is_ak1a; next if $target eq 'LOCAL'; if (!$ak1a_line && $is_ak1a) { - $ak1a_line = DXProt::pc12($_[0], $text, $_[1], "$target.LST"); + $ak1a_line = pc12($_[0], $text, $_[1], "$target.LST"); } } @@ -2031,50 +737,169 @@ sub chat sub send_local_config { my $self = shift; - my $node; - my @nodes; - my @localnodes; - my @remotenodes; dbg('DXProt::send_local_config') if isdbg('trace'); - + # send our nodes - if ($self->{isolate}) { - @localnodes = ( $main::routeroot ); - $self->send_route($main::mycall, \&pc19, 1, $main::routeroot); + if ($self->{do_pc9x}) { + $self->send_pc92_config; } 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 $node; + my @nodes; + my @localnodes; + my @remotenodes; + + 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 - # send locally connected nodes - my @dxchan = grep { $_->call ne $main::mycall && $_ != $self && !$_->{isolate} } DXChannel::get_all_nodes(); - @localnodes = map { my $r = Route::Node::get($_->{call}); $r ? $r : () } @dxchan if @dxchan; - $self->send_route($main::mycall, \&pc19, scalar(@localnodes)+1, $main::routeroot, @localnodes); + # send locally connected nodes + my @dxchan = grep { $_->call ne $main::mycall && $_ != $self && !$_->{isolate} } DXChannel::get_all_nodes(); + @localnodes = map { my $r = Route::Node::get($_->{call}); $r ? $r : () } @dxchan if @dxchan; + $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 $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 $node (@intcalls) { + push @remotenodes, Route::Node::get($node) unless grep $node eq $_, @rnodes, @remotenodes; + } + $self->send_route($main::mycall, \&pc19, scalar(@remotenodes), @remotenodes); + } + + # get all the users connected on the above nodes and send them out + foreach $node ($main::routeroot, @localnodes, @remotenodes) { + if ($node) { + my @rout = map {my $r = Route::User::get($_); $r ? ($r) : ()} $node->users; + $self->send_route($main::mycall, \&pc16, 1, $node, @rout) if @rout && $self->user->wantsendpc16; + } else { + dbg("sent a null value") if isdbg('chanerr'); + } } - my $ref = Route::Node::get($self->{call}); - my @rnodes = $ref->nodes; - for $node (@intcalls) { - push @remotenodes, Route::Node::get($node) unless grep $node eq $_, @rnodes, @remotenodes; + } +} + +sub gen_my_pc92_config +{ + my $node = shift; + + if ($node->{call} eq $main::mycall) { + my @dxchan = grep { $_->call ne $main::mycall && !$_->{isolate} } DXChannel::get_all(); + dbg("ROUTE: all dxchan: " . join(',', map{$_->{call}} @dxchan)) if isdbg('routelow'); + my @localnodes = map { my $r = Route::get($_->{call}); $r ? $r : () } @dxchan; + dbg("ROUTE: localnodes: " . join(',', map{$_->{call}} @localnodes)) if isdbg('routelow'); + return pc92c($main::routeroot, @localnodes); + } else { + my @rout = map {my $r = Route::User::get($_); $r ? ($r) : ()} $node->users; + return pc92c($node, @rout); + } +} + +sub gen_pc92_update +{ + my $self = shift; + my $with_pc92_nodes = shift; + my $node; + my @lines; + my @dxchan; + my @localnodes; + + dbg('ROUTE: DXProt::gen_pc92_update start') if isdbg('routelow'); + + # send 'my' configuration for all channels + push @lines, gen_my_pc92_config($main::routeroot); + + if ($with_pc92_nodes) { + # send out the configuration of all the directly connected PC92 nodes with current configuration + # but with the dates that the last config came in with. + @dxchan = grep { $_->call ne $main::mycall && $_ != $self && !$_->{isolate} && $_->{do_pc9x} } DXChannel::get_all_nodes(); + dbg("ROUTE: pc92 dxchan: " . join(',', map{$_->{call}} @dxchan)) if isdbg('routelow'); + @localnodes = map { my $r = Route::Node::get($_->{call}); $r ? $r : () } @dxchan; + dbg("ROUTE: pc92 localnodes: " . join(',', map{$_->{call}} @localnodes)) if isdbg('routelow'); + foreach $node (@localnodes) { + if ($node && $node->lastid->{92}) { + my @rout = map {my $r = Route::get($_); $r ? ($r) : ()} $node->nodes, $node->users; + push @lines, gen_pc92_with_time($node->call, 'C', $node->lastid->{92}, @rout); + } } - $self->send_route($main::mycall, \&pc19, scalar(@remotenodes), @remotenodes); } - # get all the users connected on the above nodes and send them out - foreach $node ($main::routeroot, @localnodes, @remotenodes) { + # send the configuration of all the directly connected 'external' nodes that don't handle PC92 + # out with the 'external' marker on the first node. + @dxchan = grep { $_->call ne $main::mycall && $_ != $self && !$_->{isolate} && !$_->{do_pc9x} } DXChannel::get_all_nodes(); + dbg("ROUTE: non pc92 dxchan: " . join(',', map{$_->{call}} @dxchan)) if isdbg('routelow'); + @localnodes = map { my $r = Route::Node::get($_->{call}); $r ? $r : () } @dxchan; + dbg("ROUTE: non pc92 localnodes: " . join(',', map{$_->{call}} @localnodes)) if isdbg('routelow'); + foreach $node (@localnodes) { if ($node) { - my @rout = map {my $r = Route::User::get($_); $r ? ($r) : ()} $node->users; - $self->send_route($main::mycall, \&pc16, 1, $node, @rout) if @rout && $self->user->wantsendpc16; + push @lines, gen_my_pc92_config($node); + } + } + + dbg('ROUTE: DXProt::gen_pc92_update end with ' . scalar @lines . ' lines') if isdbg('routelow'); + return @lines; +} + + +sub send_pc92_config +{ + my $self = shift; + + dbg('DXProt::send_pc92_config') if isdbg('trace'); + + my @out = $self->gen_pc92_update(1); + + # send the complete config out on this interface + for (@out) { + $self->send($_); + } +} + +sub send_pc92_update +{ + my @out = $main::me->gen_pc92_update(0); + + # broadcast the lines to all PC92 nodes + for (@out) { + $main::me->broadcast_route_pc9x($main::mycall, undef, $_, 0); + } +} + +sub time_out_pc92_routes +{ + my @nodes = grep {$_->call ne $main::mycall && ($_->do_pc9x || $_->via_pc92)} Route::Node::get_all(); + my @rdel; + foreach my $n (@nodes) { + my $o = $n->dec_obs; + if ($o <= 0) { + if (my $dxchan = DXChannel::get($n->call)) { + dbg("ROUTE: disconnecting local pc92 $dxchan->{call} on obscount") if isdbg('route'); + $dxchan->disconnect; + next; + } + my @parents = map {Route::Node::get($_)} $n->parents; + for (@parents) { + if ($_) { + dbg("ROUTE: deleting pc92 $_->{call} from $n->{call} on obscount") if isdbg('route'); + push @rdel, $n->del($_); + } + } } else { - dbg("sent a null value") if isdbg('chanerr'); + dbg("ROUTE: obscount on $n->{call} now $o") if isdbg('route'); } } + for (@rdel) { + $main::me->route_pc21($main::mycall, undef, $_) if $_; + } } # @@ -2155,7 +980,7 @@ sub adjust_hops my $call = $self->{call}; my $hops; - if (($hops) = $s =~ /\^H(\d+)\^~?$/o) { + if (($hops) = $s =~ /\^H(\d+)\^?~?$/o) { my ($pcno) = $s =~ /^PC(\d\d)/o; confess "$call called adjust_hops with '$s'" unless $pcno; my $ref = $nodehops{$call} if %nodehops; @@ -2166,11 +991,6 @@ sub adjust_hops return "" if defined $newhops && $newhops == 0; $newhops = $hops if !$newhops; $s =~ s/\^H(\d+)(\^~?)$/\^H$newhops$2/ if $newhops; - } else { - # simply decrement it - $hops--; - return "" if !$hops; - $s =~ s/\^H(\d+)(\^~?)$/\^H$hops$2/ if $hops; } } return $s; @@ -2313,26 +1133,14 @@ sub disconnect RouteDB::delete_interface($call); - # remove them from the pc19list as well - while (my ($k,$v) = each %pc19list) { - my @l = grep {$_->[0] ne $call} @{$pc19list{$k}}; - if (@l) { - $pc19list{$k} = \@l; - } else { - delete $pc19list{$k}; - } - - # and the ephemera - eph_del_regex("^PC1[679].*$k"); - } - # unbusy and stop and outgoing mail my $mref = DXMsg::get_busy($call); $mref->stop_msg($call) if $mref; # broadcast to all other nodes that all the nodes connected to via me are gone - unless ($pc39flag && $pc39flag == 2) { + unless ($pc39flag && $pc39flag == 2) { $self->route_pc21($main::mycall, undef, @rout) if @rout; + $self->route_pc92d($main::mycall, undef, $main::routeroot, $node) if $node; } # remove outstanding pings @@ -2357,8 +1165,11 @@ sub talk { my ($self, $from, $to, $via, $line, $origin) = @_; - $line =~ s/\^/\\5E/g; # remove any ^ characters - $self->send(DXProt::pc10($from, $to, $via, $line, $origin)); + if ($self->{do_pc9x}) { + $self->send(pc93($to, $from, $via, $line)); + } else { + $self->send(pc10($from, $to, $via, $line, $origin)); + } Log('talk', $to, $from, $via?$via:$self->call, $line) unless $origin && $origin ne $main::mycall; } @@ -2417,12 +1228,17 @@ sub broadcast_route my $line = shift; my @dxchan = DXChannel::get_all_nodes(); my $dxchan; - + + if ($line) { + $line =~ /\^H(\d+)\^?\~?$/; + return unless $1 > 0; + } unless ($self->{isolate}) { foreach $dxchan (@dxchan) { next if $dxchan == $self; next if $dxchan == $main::me; next unless $dxchan->isa('DXProt'); + next if $dxchan->{do_pc9x}; next if ($generate == \&pc16 || $generate==\&pc17) && !$dxchan->user->wantsendpc16; $dxchan->send_route($origin, $generate, @_); @@ -2430,6 +1246,49 @@ sub broadcast_route } } +# this is only used for next door nodes on init +sub send_route_pc92 +{ + my $self = shift; + + return unless $self->{do_pc9x}; + + my $origin = shift; + my $generate = shift; + my $no = shift; # the no of things to filter on + my $line; + + $line = &$generate(@_); + $self->send($line); +} + +sub broadcast_route_pc9x +{ + my $self = shift; + my $origin = shift; + my $generate = shift; + my $line = shift; + my $no = shift; + my @dxchan = DXChannel::get_all_nodes(); + my $dxchan; + + if ($origin eq $main::mycall && $generate && !$line) { + $line = &$generate(@_); + } + + $line =~ /\^H(\d+)\^\~?$/; + unless ($1 > 0 && $self->{isolate}) { + foreach $dxchan (@dxchan) { + next if $dxchan == $self || $dxchan == $main::me; + next if $origin eq $dxchan->{call}; # don't route some from this call back again. + next unless $dxchan->{do_pc9x}; + next unless $dxchan->isa('DXProt'); + + $dxchan->send($line); + } + } +} + sub route_pc16 { my $self = shift; @@ -2488,6 +1347,30 @@ sub route_pc50 broadcast_route($self, $origin, \&pc50, $line, 1, @_); } +sub route_pc92c +{ + my $self = shift; + my $origin = shift; + my $line = shift; + broadcast_route_pc9x($self, $origin, \&pc92c, $line, 1, @_); +} + +sub route_pc92a +{ + my $self = shift; + my $origin = shift; + my $line = shift; + broadcast_route_pc9x($self, $origin, \&pc92a, $line, 1, @_); +} + +sub route_pc92d +{ + my $self = shift; + my $origin = shift; + my $line = shift; + broadcast_route_pc9x($self, $origin, \&pc92d, $line, 1, @_); +} + sub in_filter_route { my $self = shift; @@ -2616,5 +1499,28 @@ sub import_chat } } +# start a pc92 find operation +sub start_pc92_find +{ + my $dxchan = shift; + my $target = shift; + my $key = "$dxchan->{call}|$target"; + if ($pc92_find{$key}) { + + } +} + +# function (not method) to handle pc92 find returns +sub handle_pc92_find_reply +{ + my ($dxchan, $node, $from, $target, $flag, $ms) = @_; + + $dxchan->print_pc92_find_reply($node, $target, $flag, $ms) if $dxchan->can('print_pc92_find_return'); +} + +sub clean_pc92_find +{ + +} 1; __END__ diff --git a/perl/DXProtHandle.pm b/perl/DXProtHandle.pm new file mode 100644 index 00000000..cc223148 --- /dev/null +++ b/perl/DXProtHandle.pm @@ -0,0 +1,1804 @@ +# +# +# This module impliments the handlers for the protocal mode for a dx cluster +# +# Copyright (c) 1998-2006 Dirk Koopman G1TLH +# +# $Id$ +# + +package DXProt; + +@ISA = qw(DXChannel); + +use DXUtil; +use DXChannel; +use DXUser; +use DXM; +use DXProtVars; +use DXCommandmode; +use DXLog; +use Spot; +use DXProtout; +use DXDebug; +use Filter; +use Local; +use DXDb; +use AnnTalk; +use Geomag; +use WCY; +use BadWords; +use DXHash; +use Route; +use Route::Node; +use Script; +use RouteDB; + + +use strict; + +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 $chatimportfn + $investigation_int $pc19_version $myprot_version + %nodehops $baddx $badspotter $badnode $censorpc $rspfcheck + $allowzero $decode_dk0wcy $send_opernam @checklist + $eph_pc15_restime $pc9x_past_age $pc9x_future_age + ); + +$pc9x_past_age = 15*60; # maximum age in the past of a px9x +$pc9x_future_age = 5*60; # maximum age in the future ditto + +# incoming talk commands +sub handle_10 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + my $origin = shift; + + # rsfp check + return if $rspfcheck and !$self->rspfcheck(0, $_[6], $_[1]); + + # will we allow it at all? + if ($censorpc) { + my @bad; + if (@bad = BadWords::check($_[3])) { + dbg("PCPROT: Bad words: @bad, dropped") if isdbg('chanerr'); + return; + } + } + + # is it for me or one of mine? + my ($from, $to, $via, $call, $dxchan); + $from = $_[1]; + if ($_[5] gt ' ') { + $via = $_[2]; + $to = $_[5]; + } else { + $to = $_[2]; + } + + # if this is a 'nodx' node then ignore it + if ($badnode->in($_[6]) || ($via && $badnode->in($via))) { + dbg("PCPROT: Bad Node, dropped") if isdbg('chanerr'); + return; + } + + # if this is a 'bad spotter' user then ignore it + my $nossid = $from; + $nossid =~ s/-\d+$//; + if ($badspotter->in($nossid)) { + dbg("PCPROT: Bad Spotter, dropped") if isdbg('chanerr'); + return; + } + + # if we are converting announces to talk is it a dup? + if ($ann_to_talk) { + if (AnnTalk::is_talk_candidate($from, $_[3]) && AnnTalk::dup($from, $to, $_[3])) { + dbg("DXPROT: Dupe talk from announce, dropped") if isdbg('chanerr'); + return; + } + } + + # remember a route to this node and also the node on which this user is + RouteDB::update($_[6], $self->{call}); +# RouteDB::update($to, $_[6]); + + # convert this to a PC93 and process it as such + $self->normal(pc93($to, $from, $via, $_[3], $_[6])); + return; + + # this is all redundant but kept for now for reference + + # it is here and logged on + $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]); + return; + } + + # is it elsewhere, visible on the cluster via the to address? + # note: this discards the via unless the to address is on + # the via address + my ($ref, $vref); + if ($ref = Route::get($to)) { + $vref = Route::Node::get($via) if $via; + $vref = undef unless $vref && grep $to eq $_, $vref->users; + $ref->dxchan->talk($from, $to, $vref ? $via : undef, $_[3], $_[6]); + return; + } + + # can we see an interface to send it down? + + # not visible here, send a message of condolence + $vref = undef; + $ref = Route::get($from); + $vref = $ref = Route::Node::get($_[6]) unless $ref; + if ($ref) { + $dxchan = $ref->dxchan; + $dxchan->talk($main::mycall, $from, $vref ? $vref->call : undef, $dxchan->msg('talknh', $to) ); + } +} + +# DX Spot handling +sub handle_11 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + my $origin = shift; + + # route 'foreign' pc26s + if ($pcno == 26) { + if ($_[7] ne $main::mycall) { + $self->route($_[7], $line); + return; + } + } + + # rsfp check + # return if $rspfcheck and !$self->rspfcheck(1, $_[7], $_[6]); + + # is the spotted callsign blank? This should really be trapped earlier but it + # could break other protocol sentences. Also check for lower case characters. + if ($_[2] =~ /^\s*$/) { + dbg("PCPROT: blank callsign, dropped") if isdbg('chanerr'); + return; + } + if ($_[2] =~ /[a-z]/) { + dbg("PCPROT: lowercase characters, dropped") if isdbg('chanerr'); + return; + } + + + # if this is a 'nodx' node then ignore it + if ($badnode->in($_[7])) { + dbg("PCPROT: Bad Node, dropped") if isdbg('chanerr'); + return; + } + + # if this is a 'bad spotter' user then ignore it + my $nossid = $_[6]; + $nossid =~ s/-\d+$//; + if ($badspotter->in($nossid)) { + dbg("PCPROT: Bad Spotter, dropped") if isdbg('chanerr'); + return; + } + + # convert the date to a unix date + my $d = cltounix($_[3], $_[4]); + # bang out (and don't pass on) if date is invalid or the spot is too old (or too young) + if (!$d || ($pcno == 11 && ($d < $main::systime - $pc11_max_age || $d > $main::systime + 900))) { + dbg("PCPROT: Spot ignored, invalid date or out of range ($_[3] $_[4])\n") if isdbg('chanerr'); + return; + } + + # is it 'baddx' + if ($baddx->in($_[2]) || BadWords::check($_[2]) || $_[2] =~ /COCK/) { + dbg("PCPROT: Bad DX spot, ignored") if isdbg('chanerr'); + return; + } + + # do some de-duping + $_[5] =~ s/^\s+//; # take any leading blanks off + $_[2] = unpad($_[2]); # take off leading and trailing blanks from spotted callsign + if ($_[2] =~ /BUST\w*$/) { + dbg("PCPROT: useless 'BUSTED' spot") if isdbg('chanerr'); + return; + } + if ($censorpc) { + my @bad; + if (@bad = BadWords::check($_[5])) { + dbg("PCPROT: Bad words: @bad, dropped") if isdbg('chanerr'); + return; + } + } + + # remember a route +# RouteDB::update($_[7], $self->{call}); +# RouteDB::update($_[6], $_[7]); + + my @spot = Spot::prepare($_[1], $_[2], $d, $_[5], $nossid, $_[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; + } + } + + # 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(@spot[0..4,5])) { + 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 + # then spotted itu, spotted cq, spotters itu, spotters cq + # you should be able to route on any of these + # + + # fix up qra locators of known users + my $user = DXUser->get_current($spot[4]); + if ($user) { + my $qra = $user->qra; + unless ($qra && is_qra($qra)) { + my $lat = $user->lat; + my $long = $user->long; + if (defined $lat && defined $long) { + $user->qra(DXBearing::lltoqra($lat, $long)); + $user->put; + } + } + + # send a remote command to a distant cluster if it is visible and there is no + # qra locator and we havn't done it for a month. + + unless ($user->qra) { + my $node; + my $to = $user->homenode; + my $last = $user->lastoper || 0; + if ($send_opernam && $to && $to ne $main::mycall && $main::systime > $last + $DXUser::lastoperinterval && ($node = Route::Node::get($to)) ) { + my $cmd = "forward/opernam $spot[4]"; + # send the rcmd but we aren't interested in the replies... + my $dxchan = $node->dxchan; + if ($dxchan && $dxchan->is_clx) { + route(undef, $to, pc84($main::mycall, $to, $main::mycall, $cmd)); + } else { + route(undef, $to, pc34($main::mycall, $to, $cmd)); + } + if ($to ne $_[7]) { + $to = $_[7]; + $node = Route::Node::get($to); + if ($node) { + $dxchan = $node->dxchan; + if ($dxchan && $dxchan->is_clx) { + route(undef, $to, pc84($main::mycall, $to, $main::mycall, $cmd)); + } else { + route(undef, $to, pc34($main::mycall, $to, $cmd)); + } + } + } + $user->lastoper($main::systime); + $user->put; + } + } + } + + # 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 +sub handle_12 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + my $origin = shift; + + # return if $rspfcheck and !$self->rspfcheck(1, $_[5], $_[1]); + + # announce duplicate checking + $_[3] =~ s/^\s+//; # remove leading blanks + + if ($censorpc) { + my @bad; + if (@bad = BadWords::check($_[3])) { + dbg("PCPROT: Bad words: @bad, dropped") if isdbg('chanerr'); + return; + } + } + + # if this is a 'nodx' node then ignore it + if ($badnode->in($_[5])) { + dbg("PCPROT: Bad Node, dropped") if isdbg('chanerr'); + return; + } + + # if this is a 'bad spotter' user then ignore it + my $nossid = $_[1]; + $nossid =~ s/-\d+$//; + if ($badspotter->in($nossid)) { + dbg("PCPROT: Bad Spotter, dropped") if isdbg('chanerr'); + return; + } + + + my $dxchan; + + if ((($dxchan = DXChannel::get($_[2])) && $dxchan->is_user) || $_[4] =~ /^[\#\w.]+$/){ + $self->send_chat(0, $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 '*') { + dbg('PCPROT: Probable chat rewrite, dropped') if isdbg('chanerr'); + return; + } + + # here's a bit of fun, convert incoming ann with a callsign in the first word + # or one saying 'to ' to a talk if we can route to the recipient + if ($ann_to_talk) { + my $call = AnnTalk::is_talk_candidate($_[1], $_[3]); + if ($call) { + my $ref = Route::get($call); + if ($ref) { + $dxchan = $ref->dxchan; + $dxchan->talk($_[1], $call, undef, $_[3], $_[5]) if $dxchan != $self; + return; + } + } + } + + # send it + $self->send_announce(0, $line, @_[1..6]); + } else { + $self->route($_[2], $line); + } +} + +sub handle_15 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + my $origin = shift; + + if (eph_dup($line, $eph_pc15_restime)) { + dbg("PCPROT: Ephemeral dup, dropped") if isdbg('chanerr'); + } else { + unless ($self->{isolate}) { + DXChannel::broadcast_nodes($line, $self) if $line =~ /\^H\d+\^?~?$/; # send it to everyone but me + } + } +} + +# incoming user +sub handle_16 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + my $origin = shift; + + # general checks + my $dxchan; + my $ncall = $_[1]; + my $newline = "PC16^"; + + # dos I want users from this channel? + unless ($self->user->wantpc16) { + 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 $h; + $h = 1 if DXChannel::get($ncall); + RouteDB::update($ncall, $self->{call}, $h); + if ($h && $self->{call} ne $ncall) { + dbg("PCPROT: trying to update a local node, ignored") if isdbg('chanerr'); + return; + } + + if (eph_dup($line)) { + dbg("PCPROT: dup PC16 detected") if isdbg('chanerr'); + return; + } + + my $parent = Route::Node::get($ncall); + + if ($parent) { + $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; + } + + # input filter if required + return unless $self->in_filter_route($parent); + } else { + $parent = Route::Node->new($ncall); + } + + unless ($h) { + if ($parent->via_pc92) { + dbg("PCPROT: non-local node controlled by PC92, 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; + if ($r || ($u && $u->is_node)) { + dbg("PCPROT: $call is a node") if isdbg('chanerr'); + 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 $h && $au; + } else { + my @ans = $parent->add_user($call, $flags); + push @rout, @ans if $h && @ans; + } + + # send info to all logged in thingies + $self->tell_login('loginu', "$ncall: $call") if DXUser->get_current($ncall)->is_local_node; + $self->tell_buddies('loginb', $call, $ncall); + + # 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->put; + } + if (@rout) { + $self->route_pc16($origin, $line, $parent, @rout) if @rout; +# $self->route_pc92a($main::mycall, undef, $parent, @rout) if $h && $self->{state} eq 'normal'; + } +} + +# remove a user +sub handle_17 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + my $origin = shift; + my $dxchan; + my $ncall = $_[2]; + my $ucall = $_[1]; + + eph_del_regex("^PC16\\^$ncall.*$ucall"); + + # do I want users from this channel? + unless ($self->user->wantpc16) { + dbg("PCPROT: don't send users to $self->{call}") if isdbg('chanerr'); + return; + } + + if ($ncall eq $main::mycall) { + dbg("PCPROT: trying to alter config on this node from outside!") if isdbg('chanerr'); + return; + } + + RouteDB::delete($ncall, $self->{call}); + + 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 = DXChannel::get($ncall); + if ($dxchan && $dxchan ne $self) { + dbg("PCPROT: PC17 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr'); + return; + } + + unless ($dxchan) { + if ($parent->via_pc92) { + dbg("PCPROT: non-local node controlled by PC92, ignored") if isdbg('chanerr'); + return; + } + } + + if (DXChannel::get($ucall)) { + dbg("PCPROT: trying do disconnect local user, ignored") if isdbg('chanerr'); + return; + } + + # input filter if required and then remove user if present +# return unless $self->in_filter_route($parent); + $parent->del_user($uref); + + # send info to all logged in thingies + $self->tell_login('logoutu', "$ncall: $ucall") if DXUser->get_current($ncall)->is_local_node; + $self->tell_buddies('logoutb', $ucall, $ncall); + + if (eph_dup($line)) { + dbg("PCPROT: dup PC17 detected") if isdbg('chanerr'); + return; + } + + $self->route_pc17($origin, $line, $parent, $uref); +# $self->route_pc92d($main::mycall, undef, $parent, $uref) if $dxchan; +} + +# link request +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->build(0 + $2); + $self->user->build(0 + $2); + unless ($self->is_spider) { + $self->user->sort('S'); + $self->user->put; + $self->sort('S'); + } + $self->{handle_xml}++ if DXXml::available() && $_[1] =~ /\bxml/; + if ($_[1] =~ /\bpc9x/) { + $self->{do_pc9x} = 1; + dbg("Do px9x set on $self->{call}"); + } + } else { + $self->version(50.0); + $self->version($_[2] / 100) if $_[2] && $_[2] =~ /^\d+$/; + $self->user->version($self->version); + } + + # first clear out any nodes on this dxchannel + my $parent = Route::Node::get($self->{call}); + my @rout = $parent->del_nodes; + $self->route_pc21($origin, $line, @rout, $parent) if @rout; + $self->send_local_config(); + $self->send(pc20()); +} + +sub check_add_node +{ + my $call = shift; + + # add this station to the user database, if required (don't remove SSID from nodes) + my $user = DXUser->get_current($call); + if (!$user) { + $user = DXUser->new($call); + $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; + return $user; +} + +# incoming cluster list +sub handle_19 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + my $origin = shift; + + my $i; + my $newline = "PC19^"; + + # new routing list + my (@rout, @pc92out); + + # first get the INTERFACE node + my $parent = Route::Node::get($self->{call}); + unless ($parent) { + dbg("DXPROT: my parent $self->{call} has disappeared"); + $self->disconnect; + return; + } + + my $h; + + # parse the PC19 + # + # We are making a major change from now on. We are only going to accept + # PC19s from directly connected nodes. This means that we are probably + # going to throw away most of the data that we are being sent. + # + # The justification for this is that most of it is wrong or out of date + # anyway. + # + # From now on we are only going to believe PC92 data and locally connected + # non-pc92 nodes. + # + for ($i = 1; $i < $#_-1; $i += 4) { + my $here = $_[$i]; + my $call = uc $_[$i+1]; + my $conf = $_[$i+2]; + 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 unless $ver && $ver =~ /^\d+$/; + 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 + $h = 0; + my $dxchan = DXChannel::get($call); + if ($dxchan) { + if ($dxchan == $self) { + $h = 1; + } else { + dbg("PCPROT: PC19 from $self->{call} trying to alter wrong locally connected $call, ignored!") if isdbg('chanerr'); + next; + } + } + + my $user = check_add_node($call); + +# if (eph_dup($genline)) { +# dbg("PCPROT: dup PC19 for $call detected") if isdbg('chanerr'); +# next; +# } + + RouteDB::update($call, $self->{call}, $dxchan ? 1 : undef); + + unless ($h) { + if ($parent->via_pc92) { + dbg("PCPROT: non-local node controlled by PC92, ignored") if isdbg('chanerr'); + next; + } + } + + 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; + } else { + 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; + push @pc92out, $r if $h; + } else { + next; + } + } + } + + # unbusy and stop and outgoing mail (ie if somehow we receive another PC19 without a disconnect) + my $mref = DXMsg::get_busy($call); + $mref->stop_msg($call) if $mref; + + $user->lastin($main::systime) unless DXChannel::get($call); + $user->put; + } + + # we are not automatically sending out PC19s, we send out a composite PC21,PC19 instead + # but remember there will only be one (pair) these because any extras will be + # thrown away. + if (@rout) { +# $self->route_pc21($self->{call}, $line, @rout); + $self->route_pc19($self->{call}, $line, @rout); + } + if (@pc92out) { + $self->route_pc92a($main::mycall, $line, $main::routeroot, @pc92out) if $self->{state} eq 'normal'; + } +} + +sub send_delayed_pc92 +{ + my $self = shift; + + # send out new PC92 config to everyone else + my $line = gen_my_pc92_config($main::me); + $self->broadcast_route_pc9x($main::mycall, undef, $line, 0); + + # if this is an external node then send out the external config + unless ($self->{do_pc9x}) { + $line = gen_my_pc92_config(Route::Node::get($self->{call})); + $self->broadcast_route_pc9x($main::mycall, undef, $line, 0); + } +} + +# send local configuration +sub handle_20 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + my $origin = shift; + + if ($self->{do_pc9x} && $self->{state} ne 'init92') { + dbg("PCPROT: disconnecting because login call not sent in any pc92") if isdbg('chanerr'); + $self->send("**** You logged in with $self->{call} but that is NOT your \$mycall"); + $self->disconnect; + return; + } + $self->send_local_config(); + $self->send(pc22()); + $self->state('normal'); + $self->{lastping} = 0; + $self->send_delayed_pc92; +} + +# delete a cluster from the list +# +# This should never occur for directly connected nodes. +# +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"); + + # if I get a PC21 from the same callsign as self then ignore it + if ($call eq $self->call) { + dbg("PCPROT: self referencing PC21 from $self->{call}"); + return; + } + + RouteDB::delete($call, $self->{call}); + + my $parent = Route::Node::get($self->{call}); + unless ($parent) { + dbg("PCPROT: my parent $self->{call} has disappeared"); + $self->disconnect; + return; + } + + my @rout; + + if ($call ne $main::mycall) { # don't allow malicious buggers to disconnect me! + my $node = Route::Node::get($call); + if ($node) { + + if ($node->via_pc92) { + dbg("PCPROT: controlled by PC92, ignored") if isdbg('chanerr'); + return; + } + + 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, force a PC21 if it is local + push @rout, $node->del($parent); + push @rout, $call if $dxchan && @rout == 0; + } + } else { + dbg("PCPROT: I WILL _NOT_ be disconnected!") if isdbg('chanerr'); + return; + } + + if (eph_dup($line)) { + dbg("PCPROT: dup PC21 detected") if isdbg('chanerr'); + return; + } + + if (@rout) { + $self->route_pc21($origin, $line, @rout); +# $self->route_pc92d($main::mycall, $line, $main::routeroot, @rout); + } +} + + +sub handle_22 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + my $origin = shift; + + if ($self->{do_pc9x}) { + if ($self->{state} ne 'init92') { + dbg("PCPROT: disconnecting because login call not sent in any pc92") if isdbg('chanerr'); + $self->send("**** You logged in with $self->{call} but that is NOT your \$mycall"); + $self->disconnect; + return; + } + } + $self->{lastping} = 0; + $self->state('normal'); + $self->send_delayed_pc92; +} + +# WWV info +sub handle_23 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + my $origin = shift; + + # route foreign' pc27s + if ($pcno == 27) { + if ($_[8] ne $main::mycall) { + $self->route($_[8], $line); + return; + } + } + + # 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])); + my $sfi = unpad($_[3]); + my $k = unpad($_[4]); + my $i = unpad($_[5]); + my ($r) = $_[6] =~ /R=(\d+)/; + $r = 0 unless $r; + if (($pcno == 23 && $d < $main::systime - $pc23_max_age) || $d > $main::systime + 1500 || $_[2] < 0 || $_[2] > 23) { + dbg("PCPROT: WWV Date ($_[1] $_[2]) out of range") if isdbg('chanerr'); + return; + } + + # global wwv filtering on INPUT + my @dxcc = ((Prefix::cty_data($_[7]))[0..2], (Prefix::cty_data($_[8]))[0..2]); + if ($self->{inwwvfilter}) { + my ($filter, $hops) = $self->{inwwvfilter}->it(@_[7,8], $origin, @dxcc); + unless ($filter) { + dbg("PCPROT: Rejected by input wwv filter") if isdbg('chanerr'); + return; + } + } + $_[7] =~ s/-\d+$//o; # remove spotter's ssid + if (Geomag::dup($d,$sfi,$k,$i,$_[6],$_[7])) { + dbg("PCPROT: Dup WWV Spot ignored\n") if isdbg('chanerr'); + return; + } + + # note this only takes the first one it gets + Geomag::update($d, $_[2], $sfi, $k, $i, @_[6..8], $r); + + my $rep; + eval { + $rep = Local::wwv($self, $_[1], $_[2], $sfi, $k, $i, @_[6..8], $r); + }; + # dbg("Local::wwv2 error $@") if isdbg('local') if $@; + return if $rep; + + # DON'T be silly and send on PC27s! + return if $pcno == 27; + + # broadcast to the eager world + send_wwv_spot($self, $line, $d, $_[2], $sfi, $k, $i, @_[6..8]); +} + +# set here status +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); + $uref = Route::User::get($call); + return unless $nref || $uref; # if we don't know where they are, it's pointless sending it on + + if (eph_dup($line)) { + dbg("PCPROT: Dup PC24 ignored\n") if isdbg('chanerr'); + return; + } + + $nref->here($_[2]) if $nref; + $uref->here($_[2]) if $uref; + my $ref = $nref || $uref; + return unless $self->in_filter_route($ref); + + $self->route_pc24($origin, $line, $ref, $_[3]); +} + +# merge request +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; + } + if ($_[2] eq $main::mycall) { + dbg("PCPROT: Trying to merge to myself, ignored") if isdbg('chanerr'); + return; + } + + Log('DXProt', "Merge request for $_[3] spots and $_[4] WWV from $_[2]"); + + # spots + if ($_[3] > 0) { + my @in = reverse Spot::search(1, undef, undef, 0, $_[3]); + my $in; + foreach $in (@in) { + $self->send(pc26(@{$in}[0..4], $_[2])); + } + } + + # wwv + if ($_[4] > 0) { + my @in = reverse Geomag::search(0, $_[4], time, 1); + my $in; + foreach $in (@in) { + $self->send(pc27(@{$in}[0..5], $_[2])); + } + } +} + +sub handle_26 {goto &handle_11} +sub handle_27 {goto &handle_23} + +# mail/file handling +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"; + &$sub($self, @_); + } else { + $self->route($_[1], $line) unless $self->is_clx; + } +} + +sub handle_29 {goto &handle_28} +sub handle_30 {goto &handle_28} +sub handle_31 {goto &handle_28} +sub handle_32 {goto &handle_28} +sub handle_33 {goto &handle_28} + +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 { + $self->process_rcmd($_[1], $_[2], $_[2], $_[3]); + } +} + +# remote command replies +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]); +} + +sub handle_36 {goto &handle_34} + +# database stuff +sub handle_37 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + 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 +sub handle_38 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + my $origin = shift; +} + +# incoming disconnect +sub handle_39 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + my $origin = shift; + if ($_[1] eq $self->{call}) { + $self->disconnect(1); + } else { + dbg("PCPROT: came in on wrong channel") if isdbg('chanerr'); + } +} + +sub handle_40 {goto &handle_28} + +# user info +sub handle_41 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + my $origin = shift; + my $call = $_[1]; + my $sort = $_[2]; + my $val = $_[3]; + + my $l = "PC41^$call^$sort"; + if (eph_dup($l, $eph_info_restime)) { + dbg("PCPROT: dup PC41, ignored") if isdbg('chanerr'); + return; + } + + # input filter if required + # my $ref = Route::get($call) || Route->new($call); + # return unless $self->in_filter_route($ref); + + if ($val eq $sort || $val =~ /^\s*$/) { + dbg('PCPROT: invalid value') if isdbg('chanerr'); + return; + } + + # add this station to the user database, if required + my $user = DXUser->get_current($call); + $user = DXUser->new($call) unless $user; + + if ($sort == 1) { + if (($val =~ /spotter/i || $val =~ /self/i) && $user->name && $user->name ne $val) { + dbg("PCPROT: invalid name") if isdbg('chanerr'); + if ($main::mycall eq 'GB7DJK' || $main::mycall eq 'GB7BAA' || $main::mycall eq 'WR3D') { + DXChannel::broadcast_nodes(pc41($_[1], 1, $user->name)); # send it to everyone including me + } + return; + } + $user->name($val); + } elsif ($sort == 2) { + $user->qth($val); + } elsif ($sort == 3) { + if (is_latlong($val)) { + my ($lat, $long) = DXBearing::stoll($val); + $user->lat($lat) if $lat; + $user->long($long) if $long; + $user->qra(DXBearing::lltoqra($lat, $long)) unless $user->qra; + } else { + dbg('PCPROT: not a valid lat/long') if isdbg('chanerr'); + return; + } + } elsif ($sort == 4) { + $user->homenode($val); + } elsif ($sort == 5) { + if (is_qra(uc $val)) { + my ($lat, $long) = DXBearing::qratoll(uc $val); + $user->lat($lat) if $lat && !$user->lat; + $user->long($long) if $long && !$user->long; + $user->qra(uc $val); + } else { + dbg('PCPROT: not a valid QRA locator') if isdbg('chanerr'); + return; + } + } + $user->lastoper($main::systime); # to cut down on excessive for/opers being generated + $user->put; + + unless ($self->{isolate}) { + DXChannel::broadcast_nodes($line, $self); # send it to everyone but me + } + + # perhaps this IS what we want after all + # $self->route_pc41($ref, $call, $sort, $val, $_[4]); +} + +sub handle_42 {goto &handle_28} + + +# database +sub handle_44 {goto &handle_37} +sub handle_45 {goto &handle_37} +sub handle_46 {goto &handle_37} +sub handle_47 {goto &handle_37} +sub handle_48 {goto &handle_37} + +# message and database +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'); + return; + } + + if ($_[1] eq $main::mycall) { + DXMsg::handle_49($self, @_); + } else { + $self->route($_[1], $line) unless $self->is_clx; + } +} + +# keep alive/user list +sub handle_50 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + my $origin = shift; + + my $call = $_[1]; + + RouteDB::update($call, $self->{call}); + + my $node = Route::Node::get($call); + if ($node) { + return unless $node->call eq $self->{call}; + $node->usercount($_[2]); + + # input filter if required + return unless $self->in_filter_route($node); + + $self->route_pc50($origin, $line, $node, $_[2], $_[3]) unless eph_dup($line); + } +} + +# incoming ping requests/answers +sub handle_51 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + my $origin = shift; + my $to = $_[1]; + my $from = $_[2]; + my $flag = $_[3]; + + + # is it for us? + if ($to eq $main::mycall) { + if ($flag == 1) { + $self->send(pc51($from, $to, '0')); + } else { + DXXml::Ping::handle_ping_reply($self, $from); + } + } else { + + RouteDB::update($from, $self->{call}); + + if (eph_dup($line)) { + dbg("PCPROT: dup PC51 detected") if isdbg('chanerr'); + return; + } + # route down an appropriate thingy + $self->route($to, $line); + } +} + +# dunno but route it +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); + } +} + +# WCY broadcasts +sub handle_73 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + my $origin = shift; + my $call = $_[1]; + + # do some de-duping + my $d = cltounix($call, sprintf("%02d18Z", $_[2])); + if (($pcno == 23 && $d < $main::systime - $pc23_max_age) || $d > $main::systime + 1500 || $_[2] < 0 || $_[2] > 23) { + dbg("PCPROT: WCY Date ($call $_[2]) out of range") if isdbg('chanerr'); + return; + } + @_ = map { unpad($_) } @_; + if (WCY::dup($d)) { + dbg("PCPROT: Dup WCY Spot ignored\n") if isdbg('chanerr'); + return; + } + + my $wcy = WCY::update($d, @_[2..12]); + + my $rep; + eval { + $rep = Local::wcy($self, @_[1..12]); + }; + # dbg("Local::wcy error $@") if isdbg('local') if $@; + return if $rep; + + # broadcast to the eager world + send_wcy_spot($self, $line, $d, @_[2..12]); +} + +# remote commands (incoming) +sub handle_84 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + my $origin = shift; + $self->process_rcmd($_[1], $_[2], $_[3], $_[4]); +} + +# remote command replies +sub handle_85 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + my $origin = shift; + $self->process_rcmd_reply($_[1], $_[2], $_[3], $_[4]); +} + +# decode a pc92 call: flag call : version : build +sub _decode_pc92_call +{ + my $icall = shift; + my @part = split /:/, $icall; + my ($flag, $call) = unpack "A A*", $part[0]; + return () unless defined $flag && $flag ge '0' && $flag le '7'; + return () unless $call && is_callsign($call); + my $is_node = $flag & 4; + my $is_extnode = $flag & 2; + my $here = $flag & 1; + return ($call, $is_node, $is_extnode, $here, $part[1], $part[2]); +} + +# decode a pc92 call: flag call : version : build +sub _encode_pc92_call +{ + my $ref = shift; + + # plain call or value + return $ref unless ref $ref; + + my $ext = shift; + my $flag = 0; + my $call = $ref->call; + my $extra = ''; + $flag |= $ref->here ? 1 : 0; + if ($ref->isa('Route::Node') || $ref->isa('DXProt')) { + $flag |= 4; + my $dxchan = DXChannel::get($call); + $flag |= 2 if $call ne $main::mycall && $dxchan && !$dxchan->{do_pc9x}; + if ($ext) { + if ($ref->version) { + my $version = $ref->version || 1.0; + $version = $version * 100 + 5300 if $version < 50; + $extra .= ":" . $version; + } + } + } + return "$flag$call$extra"; +} + +sub _add_thingy +{ + my $parent = shift; + my $s = shift; + my ($call, $is_node, $is_extnode, $here, $version, $build) = @$s; + my @rout; + + if ($call) { + if ($is_node) { + dbg("ROUTE: added node $call to " . $parent->call) if isdbg('routelow'); + @rout = $parent->add($call, $version, Route::here($here)); + } else { + dbg("ROUTE: added user $call to " . $parent->call) if isdbg('routelow'); + @rout = $parent->add_user($call, Route::here($here)); + } + } + return @rout; +} + +sub _del_thingy +{ + my $parent = shift; + my $s = shift; + my ($call, $is_node, $is_extnode, $here, $version, $build) = @$s; + my @rout; + if ($call) { + if ($is_node) { + my $nref = Route::Node::get($call); + dbg("ROUTE: deleting node $call from " . $parent->call) if isdbg('routelow'); + @rout = $nref->del($parent) if $nref; + } else { + my $uref = Route::User::get($call); + dbg("ROUTE: deleting user $call from " . $parent->call) if isdbg('routelow'); + @rout = $parent->del_user($uref) if $uref; + } + } + return @rout; +} + +my $_last_time; +my $_last_occurs; + +sub gen_pc9x_t +{ + if (!$_last_time || $_last_time != $main::systime) { + $_last_time = $main::systime; + $_last_occurs = 0; + return $_last_time - $main::systime_daystart; + } else { + $_last_occurs++; + return sprintf "%d.%02d", $_last_time - $main::systime_daystart, $_last_occurs; + } +} + +sub check_pc9x_t +{ + my $call = shift; + my $t = shift; + my $pc = shift; + my $create = shift; + + my $parent = ref $call ? $call : Route::Node::get($call); + if ($parent) { + # we only do this for external calls whose routing table + # record come and go. The reference for mycall is permanent + # and not that frequently used, it also never times out, so + # the id on it is completely unreliable. Besides, only commands + # originating on this box will go through this code... + if ($parent->call ne $main::mycall) { + my $lastid = $parent->lastid->{$pc} || 0; + if ($t < $lastid) { + if (my $d = $lastid-86400+$t > $pc9x_past_age) { + dbg("PCPROT: $call id $t <= $lastid, ignored") if isdbg('chanerr'); + return; + } + } + if ($lastid == $t) { + dbg("PCPROT: dup id on $call = $lastid, ignored") if isdbg('chanerr'); + return; + } + } + } elsif ($create) { + $parent = Route::Node->new($call); + } + $parent->lastid->{$pc} = $t; + + return $parent; +} + +# DXSpider routing entries +sub handle_92 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + my $origin = shift; + + my (@radd, @rdel); + + my $pcall = $_[1]; + unless ($pcall) { + dbg("PCPROT: invalid callsign string '$_[1]', ignored") if isdbg('chanerr'); + return; + } + my $t = $_[2]; + my $sort = $_[3]; + + if ($pcall eq $main::mycall) { + dbg("PCPROT: looped back, ignored") if isdbg('chanerr'); + return; + } + + if ($pcall eq $self->{call} && $self->{state} eq 'init') { + $self->state('init92'); + $self->{do_pc9x} = 1; + dbg("Do pc9x set on $pcall"); + } + unless ($self->{do_pc9x}) { + dbg("PCPROT: PC9x come in from non-PC9x node, ignored") if isdbg('chanerr'); + return; + } + + my $parent = check_pc9x_t($pcall, $t, 92, 1) || return; + my $oparent = $parent; + + $parent->do_pc9x(1); + $parent->via_pc92(1); + + if ($sort eq 'F' || $sort eq 'R') { + + # this is the route finding section + # here is where the consequences of the 'find' command + # are dealt with + + my $from = $_[4]; + my $target = $_[5]; + + if ($sort eq 'F') { + my $flag; + my $ref; + my $dxchan; + if ($ref = DXChannel::get($target)) { + $flag = 1; # we are directly connected + } else { + $ref = Route::get($target); + $dxchan = $ref->dxchan; + $flag = 2; + } + if ($ref && $flag && $dxchan) { + $self->send(pc92r($from, $target, $flag, int($dxchan->{pingave}*1000))); + return; + } + } elsif ($sort eq 'R') { + if (my $dxchan = DXChannel::get($from)) { + handle_pc92_find_reply($dxchan, $pcall, $from, $target, @_[6,7]); + } else { + my $ref = Route::get($from); + if ($ref) { + my @dxchan = grep {$_->do_pc9x} $ref->alldxchan; + if (@dxchan) { + $_->send($line) for @dxchan; + } else { + dbg("PCPROT: no return route, ignored") if isdbg('chanerr') + } + } else { + dbg("PCPROT: no return route, ignored") if isdbg('chanerr') + } + } + return; + } + } elsif ($sort eq 'A' || $sort eq 'D' || $sort eq 'C') { + + # this is the main route section + # here is where all the routes are created and destroyed + + my @ent = map {[ _decode_pc92_call($_) ]} grep {$_ && /^[0-7]/} @_[4 .. $#_]; + if (@ent) { + + # look at the first one which will always be a node of some sort + # and update any information that needs to be done. + my ($call, $is_node, $is_extnode, $here, $version, $build) = @{$ent[0]}; + if ($call && $is_node) { + if ($call eq $main::mycall) { + dbg("PCPROT: looped back on node entry, ignored") if isdbg('chanerr'); + return; + } + if ($is_extnode) { + # this is only accepted from my "self" + if (DXChannel::get($call) && $call ne $self->{call}) { + dbg("PCPROT: locally connected node config for $call from other another node $self->{call}, ignored") if isdbg('chanerr'); + return; + } + # reparent to external node (note that we must have received a 'C' or 'A' record + # from the true parent node for this external before we get one for the this node + unless ($parent = Route::Node::get($call)) { + dbg("PCPROT: no previous C or A for this external node received, ignored") if isdbg('chanerr'); + return; + } + $parent = check_pc9x_t($call, $t, 92) || return; + $parent->via_pc92(1); + } + } else { + dbg("PCPROT: must be mycall or external node as first entry, ignored") if isdbg('chanerr'); + return; + } + $parent->here(Route::here($here)); + $parent->version($version) if $version && $version > $parent->version; + $parent->build($build) if $build && $build > $parent->build; + shift @ent; + } + + # do a pass through removing any references to either locally connected nodes or mycall + my @nent; + for (@ent) { + next unless $_; + if ($_->[0] eq $main::mycall || DXChannel::get($_->[0])) { + dbg("PCPROT: $_->[0] refers to locally connected node, ignored") if isdbg('chanerr'); + next; + } + push @nent, $_; + } + + if ($sort eq 'A') { + for (@nent) { + push @radd, _add_thingy($parent, $_); + } + } elsif ($sort eq 'D') { + for (@nent) { + push @rdel, _del_thingy($parent, $_); + } + } elsif ($sort eq 'C') { + my (@nodes, @users); + + # we only reset obscounts on config records + $oparent->reset_obs; + dbg("ROUTE: reset obscount on $pcall now " . $oparent->obscount) if isdbg('route'); + if ($oparent != $parent) { + $parent->reset_obs; + dbg("ROUTE: reset obscount on $parent->{call} now " . $parent->obscount) if isdbg('route'); + } + + # + foreach my $r (@nent) { + # my ($call, $is_node, $is_extnode, $here, $version, $build) = _decode_pc92_call($_); + if ($r->[0]) { + if ($r->[1]) { + push @nodes, $r->[0]; + } else { + push @users, $r->[0]; + } + } else { + dbg("DXPROT: pc92 call entry '$_' not decoded, ignored") if isdbg('chanerr'); + } + } + + my ($dnodes, $dusers, $nnodes, $nusers) = $parent->calc_config_changes(\@nodes, \@users); + + # add users here + foreach my $r (@nent) { + my $call = $r->[0]; + if ($call) { + push @radd,_add_thingy($parent, $r) if grep $call eq $_, (@$nnodes, @$nusers); + } + } + # del users here + foreach my $r (@$dnodes) { + push @rdel,_del_thingy($parent, [$r, 1]); + } + foreach my $r (@$dusers) { + push @rdel,_del_thingy($parent, [$r, 0]); + } + } else { + dbg("PCPROT: unknown action '$sort', ignored") if isdbg('chanerr'); + return; + } + + foreach my $r (@rdel) { + next unless $r; + + $self->route_pc21($pcall, undef, $r) if $r->isa('Route::Node'); + $self->route_pc17($pcall, undef, $parent, $r) if $r->isa('Route::User'); + } + my @pc19 = grep { $_ && $_->isa('Route::Node') } @radd; + my @pc16 = grep { $_ && $_->isa('Route::User') } @radd; + unshift @pc19, $parent if $self->{state} eq 'init92' && $oparent == $parent; + $self->route_pc19($pcall, undef, @pc19) if @pc19; + $self->route_pc16($pcall, undef, $parent, @pc16) if @pc16; + } + + # broadcast it if we get here + $self->broadcast_route_pc9x($pcall, undef, $line, 0); +} + + +sub handle_93 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + my $origin = shift; + +# $self->{do_pc9x} ||= 1; + + my $pcall = $_[1]; + unless (is_callsign($pcall)) { + dbg("PCPROT: invalid callsign string '$_[1]', ignored") if isdbg('chanerr'); + return; + } + my $t = $_[2]; + my $parent = check_pc9x_t($pcall, $t, 93, 1) || return; + + my $to = $_[3]; + my $from = $_[4]; + my $via = $_[5]; + my $text = $_[6]; + my $onode = $_[7]; + $onode = $pcall if @_ <= 8; + + # will we allow it at all? + if ($censorpc) { + my @bad; + if (@bad = BadWords::check($text)) { + dbg("PCPROT: Bad words: @bad, dropped") if isdbg('chanerr'); + return; + } + } + + # if this is a 'bad spotter' user then ignore it + my $nossid = $from; + $nossid =~ s/-\d+$//; + if ($badspotter->in($nossid)) { + dbg("PCPROT: Bad Spotter, dropped") if isdbg('chanerr'); + return; + } + + if (is_callsign($to)) { + # local talks + my $dxchan; + $dxchan = DXChannel::get($main::myalias) if $to eq $main::mycall; + $dxchan = DXChannel::get($to) unless $dxchan; + if ($dxchan && $dxchan->is_user) { + $dxchan->talk($from, $to, $via, $text, $onode); + return; + } + + # convert to PC10 talks where appropriate + my $ref = Route::get($to); + if ($ref) { + my @dxchan = $ref->alldxchan; + for $dxchan (@dxchan) { + if ($dxchan->{do_pc9x}) { + $dxchan->send($line); + } else { + $dxchan->talk($from, $to, $via, $text, $onode); + } + } + return; + } + + # otherwise, drop through and allow it to be broadcast + } elsif ($to eq '*' || uc $to eq 'SYSOP' || uc $to eq 'WX') { + # announces + my $sysop = uc $to eq 'SYSOP' ? '*' : ' '; + my $wx = uc $to eq 'WX' ? '1' : '0'; + my $local = $via eq 'LOCAL' ? '*' : $via; + + $self->send_announce(1, pc12($from, $text, $local, $via, $sysop, $wx, $pcall), $from, $local, $text, $sysop, $pcall, $wx, $via eq 'LOCAL' ? $via : undef); + return if $via eq 'LOCAL'; + } else { + # chat messages to non-pc9x nodes + $self->send_chat(1, pc12($from, $text, undef, $to, undef, $pcall), $from, '*', $text, $to, $pcall, '0'); + } + $self->broadcast_route_pc9x($pcall, undef, $line, 0); +} + +# 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. +# +# NOTE - don't arrive here UNLESS YOU WANT this lump of protocol to be +# REBROADCAST!!!! +# + +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'); + } else { + if ($pcno >= 90) { + my $pcall = $_[1]; + unless (is_callsign($pcall)) { + dbg("PCPROT: invalid callsign string '$_[1]', ignored") if isdbg('chanerr'); + return; + } + my $t = $_[2]; + my $parent = check_pc9x_t($pcall, $t, $pcno, 1) || return; + $self->broadcast_route_pc9x($pcall, undef, $line, 0); + } else { + unless ($self->{isolate}) { + DXChannel::broadcast_nodes($line, $self) if $line =~ /\^H\d+\^?~?$/; # send it to everyone but me + } + } + } +} + +1; diff --git a/perl/DXProtout.pm b/perl/DXProtout.pm index 82905dad..e00e1d72 100644 --- a/perl/DXProtout.pm +++ b/perl/DXProtout.pm @@ -32,7 +32,7 @@ sub pc10 { my ($from, $to, $via, $text, $origin) = @_; my ($user1, $user2); - if ($via && $via ne $to) { + if ($via && $via ne $to && $via ne '*') { $user1 = $via; $user2 = $to; } else { @@ -117,7 +117,7 @@ sub pc17 # Request init string sub pc18 { - my $flags = ""; + my $flags = " pc9x"; $flags .= " xml" if DXXml::available(); return "PC18^DXSpider Version: $main::version Build: $main::build$flags^$DXProt::myprot_version^"; } @@ -368,9 +368,84 @@ sub pc85 return "PC85^$tonode^$fromnode^$call^$msg^~"; } -# spider route broadcast -sub pc90 +# spider route broadcasts +# + + +sub _gen_pc92 +{ + my $sort = shift; + my $ext = shift; + my $s = "PC92^$main::mycall^" . gen_pc9x_t() . "^$sort"; + for (@_) { + $s .= "^" . _encode_pc92_call($_, $ext); + } + return $s . '^H99^'; +} + +sub gen_pc92_with_time +{ + my $call = shift; + my $sort = shift; + my $t = shift; + my $ext = 1; + my $s = "PC92^$call^$t^$sort"; + for (@_) { + $s .= "^" . _encode_pc92_call($_, $ext); + } + return $s . '^H99^'; +} + +# add a local one +sub pc92a +{ + return _gen_pc92('A', 0, @_); +} + +# delete a local one +sub pc92d +{ + return _gen_pc92('D', 0, @_); +} + +# send a config +sub pc92c +{ + return _gen_pc92('C', 1, @_); +} + +# send a 'find' message +sub pc92f { + my $target = shift; + my $from = shift; + return "PC92^$main::mycall^" . gen_pc9x_t() . "^F^$from^$target^H99^" +} + +# send a 'reply' message +sub pc92r +{ + my $to = shift; + my $target = shift; + my $flag = shift; + my $ms = shift; + return "PC92^$main::mycall^" . gen_pc9x_t() . "^R^$to^$target^$flag^$ms^H99^" +} + +sub pc93 +{ + my $to = shift; # *, callsign, chat group name, sysop + my $from = shift; # from user callsign + my $via = shift || '*'; # *, node call + my $line = shift; # the text + my $origin = shift; # this will be present on proxying from PC10 + + $line = unpad($line); + $line =~ s/\^/\\5E/g; # remove any ^ characters + my $s = "PC93^$main::mycall^" . gen_pc9x_t() . "^$to^$from^$via^$line"; + $s .= "^$origin" if $origin; + $s .= "^H99^"; + return $s; } 1; diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index e3056e95..2e7536ac 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -434,3 +434,4 @@ sub deleteitem @$list = grep {$_ ne $item } @$list; return $n - @$list; } + diff --git a/perl/DXXml/Cmd.pm b/perl/DXXml/Cmd.pm index 864b0506..7369d40d 100644 --- a/perl/DXXml/Cmd.pm +++ b/perl/DXXml/Cmd.pm @@ -17,7 +17,7 @@ use Investigate; use DXXml::Text; use DXLog; -use vars qw(@ISA %pings); +use vars qw(@ISA); @ISA = qw(DXXml); sub handle_input diff --git a/perl/DXXml/IM.pm b/perl/DXXml/IM.pm index 0c41aec7..1a3c1fff 100644 --- a/perl/DXXml/IM.pm +++ b/perl/DXXml/IM.pm @@ -16,7 +16,7 @@ use IsoTime; use Investigate; use Time::HiRes qw(gettimeofday tv_interval); -use vars qw(@ISA %pings); +use vars qw(@ISA); @ISA = qw(DXXml); # diff --git a/perl/DXXml/Text.pm b/perl/DXXml/Text.pm index 2410824f..b4a95b44 100644 --- a/perl/DXXml/Text.pm +++ b/perl/DXXml/Text.pm @@ -14,7 +14,7 @@ use DXDebug; use DXProt; use DXLog; -use vars qw(@ISA %pings); +use vars qw(@ISA); @ISA = qw(DXXml); sub handle_input diff --git a/perl/EphMsg.pm b/perl/EphMsg.pm new file mode 100644 index 00000000..eabba932 --- /dev/null +++ b/perl/EphMsg.pm @@ -0,0 +1,186 @@ +# +# This class is the internal subclass that deals with 'Ephmeral' +# communications like: querying http servers and other network +# connected data services and using Msg.pm +# +# An instance of this is setup by a command together with a load +# of callbacks and then runs with a state machine until completion +# +# $Id$ +# +# Copyright (c) 2001 - Dirk Koopman G1TLH +# + +package EphMsg; + +use strict; +use Msg; +use DXVars; +use DXUtil; +use DXDebug; +use IO::File; +use IO::Socket; +use IPC::Open3; + +use vars qw(@ISA $deftimeout); + +@ISA = qw(Msg); +$deftimeout = 60; + + +sub new +{ + +} + +# we probably won't use the normal format +sub enqueue +{ + my ($conn, $msg) = @_; + push (@{$conn->{outqueue}}, $msg . $conn->{lineend}); +} + +sub dequeue +{ + my $conn = shift; + my $msg; + + if ($conn->{csort} eq 'ax25' && exists $conn->{msg}) { + $conn->{msg} =~ s/\cM/\cJ/g; + } + + if ($conn->{state} eq 'WC') { + $conn->to_connected($conn->{call}, 'O', $conn->{csort}); + } + + if ($conn->{msg} =~ /\cJ/) { + my @lines = $conn->{msg} =~ /([^\cM\cJ]*)\cM?\cJ/g; + if ($conn->{msg} =~ /\cJ$/) { + delete $conn->{msg}; + } else { + $conn->{msg} =~ s/([^\cM\cJ]*)\cM?\cJ//g; + } + + while (defined ($msg = shift @lines)) { + dbg("connect $conn->{cnum}: $msg") if $conn->{state} ne 'C' && isdbg('connect'); + + $msg =~ s/\xff\xfa.*\xff\xf0|\xff[\xf0-\xfe].//g; # remove telnet options + + &{$conn->{rproc}}($conn, $msg); + } + } +} + +sub to_connected +{ + my ($conn, $call, $dir, $sort) = @_; + $conn->{state} = 'C'; + $conn->conns($call); + delete $conn->{cmd}; + $conn->{timeout}->del if $conn->{timeout}; + delete $conn->{timeout}; + $conn->nolinger; + &{$conn->{rproc}}($conn, "$dir$call|$sort"); +} + + +sub start_connect +{ + my $call = shift; + my $fn = shift; + my $conn = ExtMsg->new(\&main::new_channel); + $conn->{outgoing} = 1; + $conn->conns($call); + + my $f = new IO::File $fn; + push @{$conn->{cmd}}, <$f>; + $f->close; + $conn->{state} = 'WC'; + $conn->_dotimeout($deftimeout); +} + +sub _doconnect +{ + my ($conn, $sort, $line) = @_; + my $r; + + $sort = lc $sort; # in this case telnet, ax25 or prog + dbg("CONNECT $conn->{cnum} sort: $sort command: $line") if isdbg('connect'); + if ($sort eq 'telnet') { + # this is a straight network connect + my ($host, $port) = split /\s+/, $line; + $port = 23 if !$port; + $r = $conn->connect($host, $port); + if ($r) { + dbg("Connected $conn->{cnum} to $host $port") if isdbg('connect'); + } else { + dbg("***Connect $conn->{cnum} Failed to $host $port $!") if isdbg('connect'); + } + } elsif ($sort eq 'prog') { + $r = $conn->start_program($line, $sort); + } else { + dbg("invalid type of connection ($sort)"); + } + $conn->disconnect unless $r; + return $r; +} + +sub _doabort +{ + my $conn = shift; + my $string = shift; + dbg("connect $conn->{cnum}: abort $string") if isdbg('connect'); + $conn->{abort} = $string; +} + +sub _dotimeout +{ + my $conn = shift; + my $val = shift; + dbg("connect $conn->{cnum}: timeout set to $val") if isdbg('connect'); + $conn->{timeout}->del if $conn->{timeout}; + $conn->{timeval} = $val; + $conn->{timeout} = Timer->new($val, sub{ &_timedout($conn) }); +} + + +sub _timedout +{ + my $conn = shift; + dbg("connect $conn->{cnum}: timed out after $conn->{timeval} seconds") if isdbg('connect'); + $conn->disconnect; +} + +# handle callsign and connection type firtling +sub _doclient +{ + my $conn = shift; + my $line = shift; + my @f = split /\s+/, $line; + my $call = uc $f[0] if $f[0]; + $conn->conns($call); + $conn->{csort} = $f[1] if $f[1]; + $conn->{state} = 'C'; + &{$conn->{rproc}}($conn, "O$call|$conn->{csort}"); + delete $conn->{cmd}; + $conn->{timeout}->del if $conn->{timeout}; +} + +sub _send_file +{ + my $conn = shift; + my $fn = shift; + + if (-e $fn) { + my $f = new IO::File $fn; + if ($f) { + while (<$f>) { + chomp; + my $l = $_; + dbg("connect $conn->{cnum}: $l") if isdbg('connll'); + $conn->send_raw($l . $conn->{lineend}); + } + $f->close; + } + } +} diff --git a/perl/Msg.pm b/perl/Msg.pm index 70009d74..2e568bb6 100644 --- a/perl/Msg.pm +++ b/perl/Msg.pm @@ -12,6 +12,8 @@ package Msg; use strict; +use DXUtil; + use IO::Select; use IO::Socket; use DXDebug; diff --git a/perl/Route.pm b/perl/Route.pm index 8f354524..c2627c9c 100644 --- a/perl/Route.pm +++ b/perl/Route.pm @@ -17,6 +17,7 @@ package Route; use DXDebug; use DXChannel; use Prefix; +use DXUtil; use strict; @@ -193,8 +194,12 @@ sub config } if ($printit) { - $line = ' ' x ($level*2) . "$call"; - $call = ' ' x length $call; + my $pcall = $call; + $pcall .= ":" . $self->obscount if $self->via_pc92; + + + $line = ' ' x ($level*2) . "$pcall"; + $call = ' ' x length $pcall; # recursion detector if ((DXChannel::get($self->{call}) && $level > 1) || grep $self->{call} eq $_, @$seen) { diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm index f80e58e3..4b08de3b 100644 --- a/perl/Route/Node.pm +++ b/perl/Route/Node.pm @@ -11,10 +11,11 @@ package Route::Node; use DXDebug; use Route; use Route::User; +use DXUtil; use strict; -use vars qw(%list %valid @ISA $max $filterdef); +use vars qw(%list %valid @ISA $max $filterdef $obscount); @ISA = qw(Route); %valid = ( @@ -26,11 +27,15 @@ use vars qw(%list %valid @ISA $max $filterdef); handle_xml => '0,Using XML,yesno', lastmsg => '0,Last Route Msg,atime', lastid => '0,Last Route MsgID', + do_pc9x => '0,Uses pc9x,yesno', + via_pc92 => '0,Came in via pc92,yesno', + obscount => '0,Obscount', ); $filterdef = $Route::filterdef; %list = (); $max = 0; +$obscount = 3; sub count { @@ -220,6 +225,38 @@ sub rnodes return @out; } +# this takes in a list of node and user calls (not references) from +# a config type update for a node and returns +# the differences as lists of things that have gone away +# and things that have been added. +sub calc_config_changes +{ + my $self = shift; + my %nodes = map {$_ => 1} @{$self->{nodes}}; + my %users = map {$_ => 1} @{$self->{users}}; + my $cnodes = shift; + my $cusers = shift; + if (isdbg('route')) { + dbg("ROUTE: start calc_config_changes"); + dbg("ROUTE: incoming nodes on $self->{call}: " . join(',', sort @$cnodes)); + dbg("ROUTE: incoming users on $self->{call}: " . join(',', sort @$cusers)); + dbg("ROUTE: existing nodes on $self->{call}: " . join(',', sort keys %nodes)); + dbg("ROUTE: existing users on $self->{call}: " . join(',', sort keys %users)); + } + my (@dnodes, @dusers, @nnodes, @nusers); + push @nnodes, map {my @r = $nodes{$_} ? () : $_; delete $nodes{$_}; @r} @$cnodes; + push @dnodes, keys %nodes; + push @nusers, map {my @r = $users{$_} ? () : $_; delete $users{$_}; @r} @$cusers; + push @dusers, keys %users; + if (isdbg('route')) { + dbg("ROUTE: deleted nodes on $self->{call}: " . join(',', sort @dnodes)); + dbg("ROUTE: deleted users on $self->{call}: " . join(',', sort @dusers)); + dbg("ROUTE: added nodes on $self->{call}: " . join(',', sort @nnodes)); + dbg("ROUTE: added users on $self->{call}: " . join(',', sort @nusers)); + dbg("ROUTE: end calc_config_changes"); + } + return (\@dnodes, \@dusers, \@nnodes, \@nusers); +} sub new { @@ -230,10 +267,12 @@ sub new my $self = $pkg->SUPER::new($call); $self->{parent} = ref $pkg ? [ $pkg->{call} ] : [ ]; - $self->{version} = shift; - $self->{flags} = shift; + $self->{version} = shift || 5401; + $self->{flags} = shift || Route::here(1); $self->{users} = []; $self->{nodes} = []; + $self->{lastid} = {}; + $self->reset_obs; # by definition $list{$call} = $self; @@ -292,6 +331,19 @@ sub _deluser return $self->_dellist('users', @_); } +sub dec_obs +{ + my $self = shift; + $self->{obscount}--; + return $self->{obscount}; +} + +sub reset_obs +{ + my $self = shift; + $self->{obscount} = $obscount; +} + sub DESTROY { my $self = shift; diff --git a/perl/Route/User.pm b/perl/Route/User.pm index 3dfb18ce..551b32e6 100644 --- a/perl/Route/User.pm +++ b/perl/Route/User.pm @@ -10,6 +10,7 @@ package Route::User; use DXDebug; use Route; +use DXUtil; use strict; @@ -47,7 +48,7 @@ sub new my $self = $pkg->SUPER::new($call); $self->{parent} = [ $ncall ]; - $self->{flags} = $flags; + $self->{flags} = $flags || Route::here(1); $list{$call} = $self; return $self; diff --git a/perl/RouteDB.pm b/perl/RouteDB.pm index 0fe3ac25..6a23a827 100644 --- a/perl/RouteDB.pm +++ b/perl/RouteDB.pm @@ -20,12 +20,14 @@ package RouteDB; use DXDebug; use DXChannel; +use DXUtil; use Prefix; use strict; use vars qw(%list %valid $default); + %list = (); $default = 99; # the number of hops to use if we don't know %valid = ( @@ -84,7 +86,7 @@ sub update my $interface = shift; my $hops = shift || $default; my $ref = $list{$call} || RouteDB->new($call); - my $iref = $ref->{item}->{$interface} ||= RouteDB::Item->new($interface); + my $iref = $ref->{item}->{$interface} ||= RouteDB::Item->new($interface, $hops); $iref->{count}++; $iref->{hops} = $hops if $hops < $iref->{hops}; $iref->{t} = shift || $main::systime; @@ -136,7 +138,8 @@ sub new { my $pkg = shift; my $call = shift; - return bless {call => $call, hops => $RouteDB::default}, (ref $pkg || $pkg); + my $hops = shift || $RouteDB::default; + return bless {call => $call, hops => $hops}, (ref $pkg || $pkg); } 1; diff --git a/perl/Version.pm b/perl/Version.pm index 42a2c0f4..230b4a83 100644 --- a/perl/Version.pm +++ b/perl/Version.pm @@ -9,7 +9,7 @@ package main; use vars qw($version $build); -$version = '1.53'; -$build = '10'; +$version = '1.54'; +$build = '3'; 1; diff --git a/perl/cluster.pl b/perl/cluster.pl index 37ace021..3c4548b6 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -114,10 +114,10 @@ use Local; package main; use strict; -use vars qw(@inqueue $systime $version $starttime $lockfn @outstanding_connects +use vars qw(@inqueue $systime $starttime $lockfn @outstanding_connects $zombies $root @listeners $lang $myalias @debug $userfn $clusteraddr $clusterport $mycall $decease $is_win $routeroot $me $reqreg $bumpexisting - $allowdxby $dbh $dsn $dbuser $dbpass $do_xml + $allowdxby $dbh $dsn $dbuser $dbpass $do_xml $systime_days $systime_daystart ); @inqueue = (); # the main input queue, an array of hashes @@ -323,6 +323,8 @@ sub AGWrestart ############################################################# $starttime = $systime = time; +$systime_days = int ($systime / 86400); +$systime_daystart = $systime_days * 86400; $lang = 'en' unless $lang; unless ($DB::VERSION) { @@ -450,6 +452,8 @@ DXProt->init(); # put in a DXCluster node for us here so we can add users and take them away $routeroot = Route::Node->new($mycall, $version*100+5300, Route::here($main::me->here)|Route::conf($main::me->conf)); +$routeroot->do_pc9x(1); +$routeroot->via_pc92(1); # make sure that there is a routing OUTPUT node default file #unless (Filter::read_in('route', 'node_default', 0)) { @@ -498,7 +502,13 @@ for (;;) { # do timed stuff, ongoing processing happens one a second if ($timenow != $systime) { reap() if $zombies; - IsoTime::update($systime = $timenow); + $systime = $timenow; + my $days = int ($systime / 86400); + if ($systime_days != $days) { + $systime_days = $days; + $systime_daystart = $days * 86400; + } + IsoTime::update($systime); DXCron::process(); # do cron jobs DXCommandmode::process(); # process ongoing command mode stuff DXXml::process(); diff --git a/scripts/.gitignore b/scripts/.gitignore new file mode 100644 index 00000000..4b9ad3b3 --- /dev/null +++ b/scripts/.gitignore @@ -0,0 +1,3 @@ +* +!.gitignore +*.issue diff --git a/src/.gitignore b/src/.gitignore new file mode 100644 index 00000000..c5926d96 --- /dev/null +++ b/src/.gitignore @@ -0,0 +1,2 @@ +client +dbg diff --git a/techdoc/.gitignore b/techdoc/.gitignore new file mode 100644 index 00000000..1abc35ad --- /dev/null +++ b/techdoc/.gitignore @@ -0,0 +1,4 @@ +* +!Makefile +!*.pod +!.gitignore