From: Dirk Koopman Date: Wed, 3 Mar 2010 14:50:44 +0000 (+0000) Subject: Merge commit '64461bf14f8ce1a' X-Git-Tag: 1.56~39 X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=commitdiff_plain;h=cf3be2ab23c544fdb17d40cbff47f8a6631e9fdb;hp=64461bf14f8ce1a01d420a01f1cf056f13b7385b;p=spider.git Merge commit '64461bf14f8ce1a' merge in 500khz changes Conflicts: Changes perl/Version.pm --- diff --git a/Changes b/Changes index 252d316d..3ae1e065 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,10 @@ +03Mar10======================================================================= +1. add IP addresses to connecting PC92 A addresses and log them 27Nov09======================================================================= 1. Add 500khz band as suggested by Béla, HA5DI. 2. Add CTY-1923 prefixes +26Nov09======================================================================= +1. add ip address to PC92 A records 25Nov09======================================================================= 1. Change sh/qrz to use the xml interface. You will have to subscribe to the xml interface - see http://www.qrz.com/XML/index.html for more info. diff --git a/cmd/clear/cmd_cache.pl b/cmd/clear/cmd_cache.pl new file mode 120000 index 00000000..d070a0f7 --- /dev/null +++ b/cmd/clear/cmd_cache.pl @@ -0,0 +1 @@ +../load/cmd_cache.pl \ No newline at end of file diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 6fde1742..87182fc6 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -65,7 +65,7 @@ sub new my $pkg = shift; my $call = shift; # my @rout = $main::routeroot->add_user($call, Route::here(1)); - DXProt::_add_thingy($main::routeroot, [$call, 0, 0, 1]); + DXProt::_add_thingy($main::routeroot, [$call, 0, 0, 1, undef, undef, $self->{conn}->peerhost], ); # ALWAYS output the user my $ref = Route::User::get($call); @@ -89,7 +89,7 @@ sub start my $name = $user->{name}; # log it - my $host = $self->{conn}->{peerhost}; + my $host = $self->{conn}->peerhost; $host ||= "AGW Port #$self->{conn}->{agwport}" if exists $self->{conn}->{agwport}; $host ||= "unknown"; LogDbg('DXCommand', "$call connected from $host"); diff --git a/perl/DXProt.pm b/perl/DXProt.pm index bc27395b..dae0b3c7 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -269,7 +269,7 @@ sub new my @rout = $ref->delete; $self->route_pc21($main::mycall, undef, @rout) if @rout; } - $main::routeroot->add($call, '5000', Route::here(1)) if $call ne $main::mycall; + $main::routeroot->add($call, '5000', Route::here(1), $self->{conn}->peerhost) if $call ne $main::mycall; return $self; } @@ -284,7 +284,7 @@ sub start my $user = $self->{user}; # log it - my $host = $self->{conn}->{peerhost}; + my $host = $self->{conn}->peerhost; $host ||= "AGW Port #$self->{conn}->{agwport}" if exists $self->{conn}->{agwport}; $host ||= "unknown"; diff --git a/perl/DXProtHandle.pm b/perl/DXProtHandle.pm index 8d766732..c5d4bf4e 100644 --- a/perl/DXProtHandle.pm +++ b/perl/DXProtHandle.pm @@ -1353,7 +1353,10 @@ sub _decode_pc92_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]); + my $ip = $part[3]; + $ip ||= $part[1] if $part[1] && ($part[1] =~ /^(?:\d+\.)+/ || $part[1] =~ /^(?:(?:[abcdef\d]+)?,)+/); + $ip =~ s/,/:/g if $ip; + return ($call, $is_node, $is_extnode, $here, $part[1], $part[2], $ip); } # decode a pc92 call: flag call : version : build @@ -1364,7 +1367,7 @@ sub _encode_pc92_call # plain call or value return $ref unless ref $ref; - my $ext = shift; + my $ext = shift || 0; my $flag = 0; my $call = $ref->call; my $extra = ''; @@ -1373,14 +1376,17 @@ sub _encode_pc92_call $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; - } + if (($ext & 1) && $ref->version) { + my $version = $ref->version || 1.0; + $version = $version * 100 + 5300 if $version < 50; + $extra .= ":" . $version; } } + if (($ext & 2) && $ref->ip) { + my $ip = $ref->ip; + $ip =~ s/:/,/g; + $extra .= ':' . $ip; + } return "$flag$call$extra"; } @@ -1394,19 +1400,29 @@ sub _add_thingy my $dxchan = shift; my $hops = shift; - my ($call, $is_node, $is_extnode, $here, $version, $build) = @$s; + my ($call, $is_node, $is_extnode, $here, $version, $build, $ip) = @$s; my @rout; if ($call) { + my $ncall = $parent->call; if ($is_node) { - dbg("ROUTE: added node $call to " . $parent->call) if isdbg('routelow'); - @rout = $parent->add($call, $version, Route::here($here)); + 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->PC92C_dxchan($dxchan->call, $hops) if $r; + if ($ip) { + $r->ip($ip); + Log('DXProt', "PC92A $call -> $ip on $ncall"); + } } else { - dbg("ROUTE: added user $call to " . $parent->call) if isdbg('routelow'); - @rout = $parent->add_user($call, Route::here($here)); - $dxchan->tell_buddies('loginb', $call, $parent->call) if $dxchan; + 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"); + } } if ($pc92_slug_changes && $parent == $main::routeroot) { $things_add{$call} = Route::get($call); diff --git a/perl/DXProtout.pm b/perl/DXProtout.pm index 6ee0c498..f01a1481 100644 --- a/perl/DXProtout.pm +++ b/perl/DXProtout.pm @@ -385,7 +385,7 @@ sub _gen_pc92 } for (@_) { $s .= '^' . _encode_pc92_call($_, $ext); - $ext = 0; # only the first slot has an ext. + $ext = 0 unless $sort eq 'A'; # only the first slot has an ext. } return $s . '^H99^'; } @@ -410,7 +410,7 @@ sub gen_pc92_with_time # add a local one sub pc92a { - return _gen_pc92('A', 0, @_); + return _gen_pc92('A', 2, @_); } # delete a local one diff --git a/perl/Msg.pm b/perl/Msg.pm index b60ece8a..531bff73 100644 --- a/perl/Msg.pm +++ b/perl/Msg.pm @@ -193,6 +193,16 @@ sub pid_gone } } +sub peerhost +{ + my $self = shift; + my $ip; + unless ($self->{peerhost}) { + $self->{peerhost} = $self->{sock}->peerhost; + } + return $self->{peerhost}; +} + #----------------------------------------------------------------- # Send side routines sub connect { @@ -225,7 +235,8 @@ sub connect { return undef unless $r || _err_will_block($!); $conn->{sock} = $sock; - + $conn->{peerhost} = $sock->peerhost; # for consistency + if ($conn->{rproc}) { my $callback = sub {$conn->_rcv}; set_event_handler ($sock, read => $callback); diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm index 123f21f9..617a0aed 100644 --- a/perl/Route/Node.pm +++ b/perl/Route/Node.pm @@ -33,6 +33,7 @@ use vars qw(%list %valid @ISA $max $filterdef $obscount); obscount => '0,Obscount', last_PC92C => '9,Last PC92C', PC92C_dxchan => '9,Channel of PC92C,phash', + ip => '0,IP Address', ); $filterdef = $Route::filterdef; @@ -166,6 +167,8 @@ sub add_user { my $self = shift; my $ucall = shift; + my $here = shift; + my $ip = shift; confess "Trying to add NULL User call to routing tables" unless $ucall; @@ -174,7 +177,7 @@ sub add_user if ($uref) { @out = $uref->addparent($self); } else { - $uref = Route::User->new($ucall, $self->{call}, @_); + $uref = Route::User->new($ucall, $self->{call}, $here, $ip); @out = $uref; } $self->_adduser($uref); @@ -281,6 +284,8 @@ sub new $self->{users} = []; $self->{nodes} = []; $self->{PC92C_dxchan} = {}; + my $ip = shift; + $self->{ip} = $ip if defined $ip; $self->reset_obs; # by definition $list{$call} = $self; diff --git a/perl/Route/User.pm b/perl/Route/User.pm index e25c199c..de24f906 100644 --- a/perl/Route/User.pm +++ b/perl/Route/User.pm @@ -19,6 +19,7 @@ use vars qw(%list %valid @ISA $max $filterdef); %valid = ( parent => '0,Parent Calls,parray', + ip => '0,IP Address', ); $filterdef = $Route::filterdef; @@ -44,11 +45,14 @@ sub new my $call = uc shift; my $ncall = uc shift; my $flags = shift; + my $ip = shift; + confess "already have $call in $pkg" if $list{$call}; my $self = $pkg->SUPER::new($call); $self->{parent} = [ $ncall ]; $self->{flags} = $flags || Route::here(1); + $self->{ip} = $ip if defined $ip; $list{$call} = $self; return $self; diff --git a/perl/Version.pm b/perl/Version.pm index 55bcb950..55e38233 100644 --- a/perl/Version.pm +++ b/perl/Version.pm @@ -9,8 +9,8 @@ package main; use vars qw($version $subversion $build); -$version = '1.55'; +$version = ''; $subversion = '0'; -$build = '55'; +$build = '1'; 1; diff --git a/perl/cluster.pl b/perl/cluster.pl index bec09782..059a24a9 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -175,7 +175,7 @@ sub new_channel return; } if ($bumpexisting) { - my $ip = $conn->{peerhost} || 'unknown'; + my $ip = $conn->peerhost || 'unknown'; $dxchan->send_now('D', DXM::msg($lang, 'conbump', $call, $ip)); LogDbg('DXCommand', "$call bumped off by $ip, disconnected"); $dxchan->disconnect; @@ -208,7 +208,7 @@ sub new_channel my $lock = $user->lockout if $user; if ($baseuser && $baseuser->lockout || $lock) { if (!$user || !defined $lock || $lock) { - my $host = $conn->{peerhost} || "unknown"; + my $host = $conn->peerhost || "unknown"; LogDbg('DXCommand', "$call on $host is locked out, disconnected"); $conn->disconnect; return;