projects
/
spider.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
a pretty nearly working gtkconsole...
[spider.git]
/
perl
/
DXProt.pm
diff --git
a/perl/DXProt.pm
b/perl/DXProt.pm
index af1f34f7124a32f29a6729fb97724177d3089f0e..b1631628986c9013cec9df9c20772fb3847c85e0 100644
(file)
--- a/
perl/DXProt.pm
+++ b/
perl/DXProt.pm
@@
-50,7
+50,7
@@
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
$investigation_int $pc19_version $myprot_version
%nodehops $baddx $badspotter $badnode $censorpc $rspfcheck
$allowzero $decode_dk0wcy $send_opernam @checklist
-
$handle_xml
);
+ );
$pc11_max_age = 1*3600; # the maximum age for an incoming 'real-time' pc11
$pc23_max_age = 1*3600; # the maximum age for an incoming 'real-time' pc23
$pc11_max_age = 1*3600; # the maximum age for an incoming 'real-time' pc11
$pc23_max_age = 1*3600; # the maximum age for an incoming 'real-time' pc23
@@
-77,7
+77,6
@@
$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
$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
-$handle_xml = 0; # handle XML sentences
@checklist =
(
@checklist =
(
@@
-333,7
+332,7
@@
sub normal
{
my ($self, $line) = @_;
{
my ($self, $line) = @_;
- if ($line =~ '^<\w+\s') {
+ if ($line =~ '^<\w+\s'
&& $main::do_xml
) {
DXXml::normal($self, $line);
return;
}
DXXml::normal($self, $line);
return;
}
@@
-479,11
+478,16
@@
sub handle_11
# return if $rspfcheck and !$self->rspfcheck(1, $_[7], $_[6]);
# is the spotted callsign blank? This should really be trapped earlier but it
# 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.
+ # 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] =~ /^\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])) {
# if this is a 'nodx' node then ignore it
if ($badnode->in($_[7])) {
@@
-840,9
+844,12
@@
sub handle_16
push @rout, $parent->add_user($call, $flags);
}
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
# add this station to the user database, if required
-
$call =~ s/-\d+$//o; # remove ssid for users
+
#
$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;
my $user = DXUser->get_current($call);
$user = DXUser->new($call) if !$user;
$user->homenode($parent->call) if !$user->homenode;
@@
-911,6
+918,10
@@
sub handle_17
$parent = Route->new($ncall); # throw away
}
$parent = Route->new($ncall); # throw away
}
+ # 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;
if (eph_dup($line)) {
dbg("PCPROT: dup PC17 detected") if isdbg('chanerr');
return;
@@
-940,7
+951,7
@@
sub handle_18
$self->user->put;
$self->sort('S');
}
$self->user->put;
$self->sort('S');
}
- $self->{handle_xml}++ if
$main::do_xml
&& $_[1] =~ /\bxml\b/;
+ $self->{handle_xml}++ if
DXXml::available()
&& $_[1] =~ /\bxml\b/;
} else {
$self->version(50.0);
$self->version($_[2] / 100) if $_[2] && $_[2] =~ /^\d+$/;
} else {
$self->version(50.0);
$self->version($_[2] / 100) if $_[2] && $_[2] =~ /^\d+$/;
@@
-1009,6
+1020,7
@@
sub handle_19
# check for sane parameters
# $ver = 5000 if $ver eq '0000';
# 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;
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;