X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProtHandle.pm;h=6dc13795deccd8ff99c2c8530e961536155baec9;hb=f18ba64dd93bbf7c47e6b5143bfc99af817888e8;hp=e108666c9283adad0cf6e4106369a3970ed53da5;hpb=65f4d068c56ddb6e25d1f62b7ca6fd43741386b3;p=spider.git diff --git a/perl/DXProtHandle.pm b/perl/DXProtHandle.pm index e108666c..6dc13795 100644 --- a/perl/DXProtHandle.pm +++ b/perl/DXProtHandle.pm @@ -222,8 +222,33 @@ sub handle_11 } # add it + $spot[14] =~ s/^::ffff:// if exists $spot[14]; # remove rubbish ipv4 addresses dressed up as ipv6 Spot::add(@spot); + # create a spotter if doesn't exit and there is an ip available and in anycase remember the IP address + my $user = DXUser::get_current($spot[4]); + $user = DXUser->new($spot[4]) unless $user; + my $r = Route::get($spot[4]); + my $ip = $spot[14] if exists $spot[14]; + my $implied = ''; + if ($ip) { + $ip =~ s/[\(\)\*]+//g; # strip these off :-) + $user->ip($spot[7], $ip); + $user->put; + $r->ip($spot[7], $ip) if $r; + } else { + $ip ||= $r->ip($spot[7]) if $r; + $ip ||= $user->ip($spot[7]); + $implied = '*' if $ip; + } + + if (isdbg('progress')) { + my $sip = $ip ? sprintf "($ip$implied)" : ''; + my $s = sprintf "SPOT: $spot[1] on $spot[0] \@ %s by $spot[4]$sip\@$spot[7]", cldatetime($spot[2]); + $s .= " '$spot[3]'" if $spot[3]; + dbg($s); + } + # # @spot at this point contains:- # freq, spotted call, time, text, spotter, spotted cc, spotters cc, orig node @@ -231,8 +256,8 @@ sub handle_11 # 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)) { @@ -961,6 +986,7 @@ sub handle_23 # note this only takes the first one it gets Geomag::update($d, $pc->[2], $sfi, $k, $i, @$pc[6..8], $r); + dbg("WWV: $d $pc->[2], sfi:$sfi k:$k info:$i $pc->[6] $pc->[7] $pc->[8] $r") if isdbg('progress'); if (defined &Local::wwv) { my $rep; @@ -1364,6 +1390,7 @@ sub handle_73 } my $wcy = WCY::update($d, @$pc[2..12]); + dbg("WCY: " . join ', ', @$pc[2..12]) if isdbg('progress'); if (defined &Local::wcy) { my $rep; @@ -1470,25 +1497,45 @@ sub _add_thingy if ($call) { my $ncall = $parent->call; + my $user = DXUser::get_current($call); + my $r; + my $newuser = !$user; + $user = DXUser->new($call) unless $user; + $user->homenode($parent->call) unless $user->homenode; + $user->node($parent->call); + $user->lastin($main::systime) unless DXChannel::get($ncall); if ($is_node) { dbg("ROUTE: added node $call to $ncall") if isdbg('routelow'); @rout = $parent->add($call, $version, Route::here($here), $ip); - my $r = Route::Node::get($call); + $r = Route::Node::get($call); $r->PC92C_dxchan($dxchan->call, $hops) if $r; - if ($ip) { - $r->ip($ip); - Log('DXProt', "PC92A $call -> $ip on $ncall"); + if ($newuser) { + $user->sort('S') unless $user->sort; + $user->priv(1) unless exists $user->{priv}; + $user->lockout(1) unless exists $user->{lookout} || $main::me->call eq $call || DXChannel::get($call) || Msg::get($call); } } else { dbg("ROUTE: added user $call to $ncall") if isdbg('routelow'); @rout = $parent->add_user($call, Route::here($here), $ip); $dxchan->tell_buddies('loginb', $call, $ncall) if $dxchan; - my $r = Route::User::get($call); - if ($ip) { - $r->ip($ip); - Log('DXProt', "PC92A $call -> $ip on $ncall"); + $r = Route::User::get($call); + if ($newuser) { + $user->sort('U') unless $user->sort; } } + $ip ||= $user->ip($ncall); + if ($ip) { + $ip =~ s/^::ffff://; # remove ipv6 stuff from the front of an ipv4 address + $user->ip($ncall, $ip); + $r->ip($ncall, $ip); + my $s = "PC92A $call -> $ip on $ncall"; + Log('DXProt', $s); + dbg($s) if isdbg('routelow'); + } + $user->put; + + # create a node user if required + if ($pc92_slug_changes && $parent == $main::routeroot) { $things_add{$call} = Route::get($call); delete $things_del{$call}; @@ -2004,6 +2051,12 @@ sub handle_93 return; } + if (isdbg('progress')) { + my $vs = $via ne '*' ? " via $via" : ''; + my $s = "ANNTALK: $from\@$onode$vs -> $to '$text'"; + dbg($s); + } + # will we allow it at all? if ($censorpc) { my @bad;