From: minima Date: Tue, 21 Jan 2003 11:17:54 +0000 (+0000) Subject: severe munging of code in prepartion for newprotocol X-Git-Url: http://dxspider.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=c76bd4b6555d057c32b59e29654c2f88beb67c2a;p=spider.git severe munging of code in prepartion for newprotocol several changes --- diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index 5773c7e9..04ef99cb 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -138,309 +138,332 @@ sub alloc sub process { - my ($self, $line) = @_; - # this is periodic processing - if (!$self || !$line) { - - if ($main::systime >= $lastq + $queueinterval) { - - # queue some message if the interval timer has gone off - queue_msg(0); - - # import any messages in the import directory - import_msgs(); - - $lastq = $main::systime; - } - - # clean the message queue - clean_old() if $main::systime - $last_clean > 3600 ; + if ($main::systime >= $lastq + $queueinterval) { - # actual remove all the 'deleted' messages in one hit. - # this has to be delayed until here otherwise it only does one at - # a time because @msg is rewritten everytime del_msg is called. - my @del = grep {!$_->{tonode} && $_->{delete} && !$_->{keep} && $_->{deletetime} < $main::systime} @msg; - for (@del) { - $_->del_msg; - } - - $last_clean = $main::systime; - return; + # queue some message if the interval timer has gone off + queue_msg(0); + + # import any messages in the import directory + import_msgs(); + + $lastq = $main::systime; } - my @f = split /\^/, $line; - my ($pcno) = $f[0] =~ /^PC(\d\d)/; # just get the number - my ($tonode, $fromnode) = @f[1, 2]; - my $stream = $f[3] if ($pcno >= 29 && $pcno <= 33) || $pcno == 42; + # clean the message queue + clean_old() if $main::systime - $last_clean > 3600 ; + + # actual remove all the 'deleted' messages in one hit. + # this has to be delayed until here otherwise it only does one at + # a time because @msg is rewritten everytime del_msg is called. + my @del = grep {!$_->{tonode} && $_->{delete} && !$_->{keep} && $_->{deletetime} < $main::systime} @msg; + for (@del) { + $_->del_msg; + } + + $last_clean = $main::systime; +} - SWITCH: { - if ($pcno == 28) { # incoming message +# incoming message +sub handle_28 +{ + my $dxchan = shift; + my ($tonode, $fromnode) = @_[1..2]; - # sort out various extant protocol errors that occur - my $origin = $f[13]; - $origin = $self->call unless $origin && $origin gt ' '; + # sort out various extant protocol errors that occur + my $origin = $_[13]; + $origin = $dxchan->call unless $origin && $origin gt ' '; - # first look for any messages in the busy queue - # and cancel them this should both resolve timed out incoming messages - # and crossing of message between nodes, incoming messages have priority + # first look for any messages in the busy queue + # and cancel them this should both resolve timed out incoming messages + # and crossing of message between nodes, incoming messages have priority - my $ref = get_busy($fromnode); - if ($ref) { - my $otonode = $ref->{tonode} || "unknown"; - dbg("Busy, stopping msgno: $ref->{msgno} $fromnode->$otonode") if isdbg('msg'); - $ref->stop_msg($fromnode); - } + my $ref = get_busy($fromnode); + if ($ref) { + my $otonode = $ref->{tonode} || "unknown"; + dbg("Busy, stopping msgno: $ref->{msgno} $fromnode->$otonode") if isdbg('msg'); + $ref->stop_msg($fromnode); + } - my $t = cltounix($f[5], $f[6]); - $stream = next_transno($fromnode); - $ref = DXMsg->alloc($stream, uc $f[3], $f[4], $t, $f[7], $f[8], $origin, '0', $f[11]); + my $t = cltounix($_[5], $_[6]); + my $stream = next_transno($fromnode); + $ref = DXMsg->alloc($stream, uc $_[3], $_[4], $t, $_[7], $_[8], $origin, '0', $_[11]); - # fill in various forwarding state variables - $ref->{fromnode} = $fromnode; - $ref->{tonode} = $tonode; - $ref->{rrreq} = $f[11]; - $ref->{linesreq} = $f[10]; - $ref->{stream} = $stream; - $ref->{count} = 0; # no of lines between PC31s - dbg("new message from $f[4] to $f[3] '$f[8]' stream $fromnode/$stream\n") if isdbg('msg'); - Log('msg', "Incoming message $f[4] to $f[3] '$f[8]' origin: $origin" ); - set_fwq($fromnode, $stream, $ref); # store in work - set_busy($fromnode, $ref); # set interlock - $self->send(DXProt::pc30($fromnode, $tonode, $stream)); # send ack - $ref->{lastt} = $main::systime; - - # look to see whether this is a non private message sent to a known callsign - my $uref = DXUser->get_current($ref->{to}); - if (is_callsign($ref->{to}) && !$ref->{private} && $uref && $uref->homenode) { - $ref->{private} = 1; - dbg("set bull to $ref->{to} to private") if isdbg('msg'); - Log('msg', "set bull to $ref->{to} to private"); - } - last SWITCH; - } - - if ($pcno == 29) { # incoming text - my $ref = get_fwq($fromnode, $stream); - if ($ref) { - $f[4] =~ s/\%5E/^/g; - if (@{$ref->{lines}}) { - push @{$ref->{lines}}, $f[4]; - } else { - # temporarily store any R: lines so that we end up with - # only the first and last ones stored. - if ($f[4] =~ m|^R:\d{6}/\d{4}|) { - push @{$ref->{tempr}}, $f[4]; - } else { - if (exists $ref->{tempr}) { - push @{$ref->{lines}}, shift @{$ref->{tempr}}; - push @{$ref->{lines}}, pop @{$ref->{tempr}} if @{$ref->{tempr}}; - delete $ref->{tempr}; - } - push @{$ref->{lines}}, $f[4]; - } - } - $ref->{count}++; - if ($ref->{count} >= $ref->{linesreq}) { - $self->send(DXProt::pc31($fromnode, $tonode, $stream)); - dbg("stream $stream: $ref->{count} lines received\n") if isdbg('msg'); - $ref->{count} = 0; - } - $ref->{lastt} = $main::systime; - } else { - dbg("PC29 from unknown stream $stream from $fromnode") if isdbg('msg'); - $self->send(DXProt::pc42($fromnode, $tonode, $stream)); # unknown stream - } - last SWITCH; - } + # fill in various forwarding state variables + $ref->{fromnode} = $fromnode; + $ref->{tonode} = $tonode; + $ref->{rrreq} = $_[11]; + $ref->{linesreq} = $_[10]; + $ref->{stream} = $stream; + $ref->{count} = 0; # no of lines between PC31s + dbg("new message from $_[4] to $_[3] '$_[8]' stream $fromnode/$stream\n") if isdbg('msg'); + Log('msg', "Incoming message $_[4] to $_[3] '$_[8]' origin: $origin" ); + set_fwq($fromnode, $stream, $ref); # store in work + set_busy($fromnode, $ref); # set interlock + $dxchan->send(DXProt::pc30($fromnode, $tonode, $stream)); # send ack + $ref->{lastt} = $main::systime; + + # look to see whether this is a non private message sent to a known callsign + my $uref = DXUser->get_current($ref->{to}); + if (is_callsign($ref->{to}) && !$ref->{private} && $uref && $uref->homenode) { + $ref->{private} = 1; + dbg("set bull to $ref->{to} to private") if isdbg('msg'); + Log('msg', "set bull to $ref->{to} to private"); + } +} - if ($pcno == 30) { # this is a incoming subject ack - my $ref = get_fwq($fromnode); # note no stream at this stage - if ($ref) { - del_fwq($fromnode); - $ref->{stream} = $stream; - $ref->{count} = 0; - $ref->{linesreq} = 5; - set_fwq($fromnode, $stream, $ref); # new ref - set_busy($fromnode, $ref); # interlock - dbg("incoming subject ack stream $stream\n") if isdbg('msg'); - $ref->{lines} = [ $ref->read_msg_body ]; - $ref->send_tranche($self); - $ref->{lastt} = $main::systime; +# incoming text +sub handle_29 +{ + my $dxchan = shift; + my ($tonode, $fromnode, $stream) = @_[1..3]; + + my $ref = get_fwq($fromnode, $stream); + if ($ref) { + $_[4] =~ s/\%5E/^/g; + if (@{$ref->{lines}}) { + push @{$ref->{lines}}, $_[4]; + } else { + # temporarily store any R: lines so that we end up with + # only the first and last ones stored. + if ($_[4] =~ m|^R:\d{6}/\d{4}|) { + push @{$ref->{tempr}}, $_[4]; } else { - dbg("PC30 from unknown stream $stream from $fromnode") if isdbg('msg'); - $self->send(DXProt::pc42($fromnode, $tonode, $stream)); # unknown stream + if (exists $ref->{tempr}) { + push @{$ref->{lines}}, shift @{$ref->{tempr}}; + push @{$ref->{lines}}, pop @{$ref->{tempr}} if @{$ref->{tempr}}; + delete $ref->{tempr}; + } + push @{$ref->{lines}}, $_[4]; } - last SWITCH; } - - if ($pcno == 31) { # acknowledge a tranche of lines - my $ref = get_fwq($fromnode, $stream); - if ($ref) { - dbg("tranche ack stream $stream\n") if isdbg('msg'); - $ref->send_tranche($self); - $ref->{lastt} = $main::systime; - } else { - dbg("PC31 from unknown stream $stream from $fromnode") if isdbg('msg'); - $self->send(DXProt::pc42($fromnode, $tonode, $stream)); # unknown stream - } - last SWITCH; + $ref->{count}++; + if ($ref->{count} >= $ref->{linesreq}) { + $dxchan->send(DXProt::pc31($fromnode, $tonode, $stream)); + dbg("stream $stream: $ref->{count} lines received\n") if isdbg('msg'); + $ref->{count} = 0; } + $ref->{lastt} = $main::systime; + } else { + dbg("PC29 from unknown stream $stream from $fromnode") if isdbg('msg'); + $dxchan->send(DXProt::pc42($fromnode, $tonode, $stream)); # unknown stream + } +} + +# this is a incoming subject ack +sub handle_30 +{ + my $dxchan = shift; + my ($tonode, $fromnode, $stream) = @_[1..3]; + + my $ref = get_fwq($fromnode); # note no stream at this stage + if ($ref) { + del_fwq($fromnode); + $ref->{stream} = $stream; + $ref->{count} = 0; + $ref->{linesreq} = 5; + set_fwq($fromnode, $stream, $ref); # new ref + set_busy($fromnode, $ref); # interlock + dbg("incoming subject ack stream $stream\n") if isdbg('msg'); + $ref->{lines} = [ $ref->read_msg_body ]; + $ref->send_tranche($dxchan); + $ref->{lastt} = $main::systime; + } else { + dbg("PC30 from unknown stream $stream from $fromnode") if isdbg('msg'); + $dxchan->send(DXProt::pc42($fromnode, $tonode, $stream)); # unknown stream + } +} - if ($pcno == 32) { # incoming EOM - dbg("stream $stream: EOM received\n") if isdbg('msg'); - my $ref = get_fwq($fromnode, $stream); - if ($ref) { - $self->send(DXProt::pc33($fromnode, $tonode, $stream)); # acknowledge it +# acknowledge a tranche of lines +sub handle_31 +{ + my $dxchan = shift; + my ($tonode, $fromnode, $stream) = @_[1..3]; + + my $ref = get_fwq($fromnode, $stream); + if ($ref) { + dbg("tranche ack stream $stream\n") if isdbg('msg'); + $ref->send_tranche($dxchan); + $ref->{lastt} = $main::systime; + } else { + dbg("PC31 from unknown stream $stream from $fromnode") if isdbg('msg'); + $dxchan->send(DXProt::pc42($fromnode, $tonode, $stream)); # unknown stream + } +} + +# incoming EOM +sub handle_32 +{ + my $dxchan = shift; + my ($tonode, $fromnode, $stream) = @_[1..3]; + + dbg("stream $stream: EOM received\n") if isdbg('msg'); + my $ref = get_fwq($fromnode, $stream); + if ($ref) { + $dxchan->send(DXProt::pc33($fromnode, $tonode, $stream)); # acknowledge it - # get the next msg no - note that this has NOTHING to do with the stream number in PC protocol - # store the file or message - # remove extraneous rubbish from the hash - # remove it from the work in progress vector - # stuff it on the msg queue - if ($ref->{lines}) { - if ($ref->{file}) { - $ref->store($ref->{lines}); - } else { - - # does an identical message already exist? - my $m; - for $m (@msg) { - if (substr($ref->{subject},0,28) eq substr($m->{subject},0,28) && $ref->{t} == $m->{t} && $ref->{from} eq $m->{from} && $ref->{to} eq $m->{to}) { - $ref->stop_msg($fromnode); - my $msgno = $m->{msgno}; - dbg("duplicate message from $ref->{from} -> $ref->{to} to msg: $msgno") if isdbg('msg'); - Log('msg', "duplicate message from $ref->{from} -> $ref->{to} to msg: $msgno"); - return; - } - } - - # swop addresses - $ref->swop_it($self->call); + # get the next msg no - note that this has NOTHING to do with the stream number in PC protocol + # store the file or message + # remove extraneous rubbish from the hash + # remove it from the work in progress vector + # stuff it on the msg queue + if ($ref->{lines}) { + if ($ref->{file}) { + $ref->store($ref->{lines}); + } else { + + # does an identical message already exist? + my $m; + for $m (@msg) { + if (substr($ref->{subject},0,28) eq substr($m->{subject},0,28) && $ref->{t} == $m->{t} && $ref->{from} eq $m->{from} && $ref->{to} eq $m->{to}) { + $ref->stop_msg($fromnode); + my $msgno = $m->{msgno}; + dbg("duplicate message from $ref->{from} -> $ref->{to} to msg: $msgno") if isdbg('msg'); + Log('msg', "duplicate message from $ref->{from} -> $ref->{to} to msg: $msgno"); + return; + } + } + + # swop addresses + $ref->swop_it($dxchan->call); - # look for 'bad' to addresses - if ($ref->dump_it($self->call)) { - $ref->stop_msg($fromnode); - dbg("'Bad' message $ref->{to}") if isdbg('msg'); - Log('msg', "'Bad' message $ref->{to}"); - return; - } - - # check the message for bad words - my @words; - for (@{$ref->{lines}}) { - push @words, BadWords::check($_); - } - push @words, BadWords::check($ref->{subject}); - if (@words) { - dbg("$ref->{from} swore: '@words' -> $ref->{to} '$ref->{subject}' origin: $ref->{origin} via " . $self->call) if isdbg('msg'); - Log('msg',"$ref->{from} swore: '@words' -> $ref->{to} origin: $ref->{origin} via " . $self->call); - Log('msg',"subject: $ref->{subject}"); - for (@{$ref->{lines}}) { - Log('msg', "line: $_"); - } - $ref->stop_msg($fromnode); - return; - } - - $ref->{msgno} = next_transno("Msgno"); - push @{$ref->{gotit}}, $fromnode; # mark this up as being received - $ref->store($ref->{lines}); - $ref->notify; - add_dir($ref); - Log('msg', "Message $ref->{msgno} from $ref->{from} received from $fromnode for $ref->{to}"); + # look for 'bad' to addresses + if ($ref->dump_it($dxchan->call)) { + $ref->stop_msg($fromnode); + dbg("'Bad' message $ref->{to}") if isdbg('msg'); + Log('msg', "'Bad' message $ref->{to}"); + return; + } + + # check the message for bad words + my @words; + for (@{$ref->{lines}}) { + push @words, BadWords::check($_); + } + push @words, BadWords::check($ref->{subject}); + if (@words) { + dbg("$ref->{from} swore: '@words' -> $ref->{to} '$ref->{subject}' origin: $ref->{origin} via " . $dxchan->call) if isdbg('msg'); + Log('msg',"$ref->{from} swore: '@words' -> $ref->{to} origin: $ref->{origin} via " . $dxchan->call); + Log('msg',"subject: $ref->{subject}"); + for (@{$ref->{lines}}) { + Log('msg', "line: $_"); } + $ref->stop_msg($fromnode); + return; } - $ref->stop_msg($fromnode); - } else { - dbg("PC32 from unknown stream $stream from $fromnode") if isdbg('msg'); - $self->send(DXProt::pc42($fromnode, $tonode, $stream)); # unknown stream + + $ref->{msgno} = next_transno("Msgno"); + push @{$ref->{gotit}}, $fromnode; # mark this up as being received + $ref->store($ref->{lines}); + $ref->notify; + add_dir($ref); + Log('msg', "Message $ref->{msgno} from $ref->{from} received from $fromnode for $ref->{to}"); } - # queue_msg(0); - last SWITCH; } + $ref->stop_msg($fromnode); + } else { + dbg("PC32 from unknown stream $stream from $fromnode") if isdbg('msg'); + $dxchan->send(DXProt::pc42($fromnode, $tonode, $stream)); # unknown stream + } + # queue_msg(0); +} - if ($pcno == 33) { # acknowledge the end of message - my $ref = get_fwq($fromnode, $stream); - if ($ref) { - if ($ref->{private}) { # remove it if it private and gone off site# - Log('msg', "Message $ref->{msgno} from $ref->{from} sent to $fromnode and deleted"); - $ref->mark_delete; - } else { - Log('msg', "Message $ref->{msgno} from $ref->{from} sent to $fromnode"); - push @{$ref->{gotit}}, $fromnode; # mark this up as being received - $ref->store($ref->{lines}); # re- store the file - } - $ref->stop_msg($fromnode); - } else { - dbg("PC33 from unknown stream $stream from $fromnode") if isdbg('msg'); - $self->send(DXProt::pc42($fromnode, $tonode, $stream)); # unknown stream - } - - # send next one if present - queue_msg(0); - last SWITCH; +# acknowledge the end of message +sub handle_33 +{ + my $dxchan = shift; + my ($tonode, $fromnode, $stream) = @_[1..3]; + + my $ref = get_fwq($fromnode, $stream); + if ($ref) { + if ($ref->{private}) { # remove it if it private and gone off site# + Log('msg', "Message $ref->{msgno} from $ref->{from} sent to $fromnode and deleted"); + $ref->mark_delete; + } else { + Log('msg', "Message $ref->{msgno} from $ref->{from} sent to $fromnode"); + push @{$ref->{gotit}}, $fromnode; # mark this up as being received + $ref->store($ref->{lines}); # re- store the file } + $ref->stop_msg($fromnode); + } else { + dbg("PC33 from unknown stream $stream from $fromnode") if isdbg('msg'); + $dxchan->send(DXProt::pc42($fromnode, $tonode, $stream)); # unknown stream + } + + # send next one if present + queue_msg(0); +} - if ($pcno == 40) { # this is a file request - $f[3] =~ s/\\/\//og; # change the slashes - $f[3] =~ s/\.//og; # remove dots - $f[3] =~ s/^\///o; # remove the leading / - $f[3] = lc $f[3]; # to lower case; - dbg("incoming file $f[3]\n") if isdbg('msg'); - $f[3] = 'packclus/' . $f[3] unless $f[3] =~ /^packclus\//o; - - # create any directories - my @part = split /\//, $f[3]; - my $part; - my $fn = "$main::root"; - pop @part; # remove last part - foreach $part (@part) { - $fn .= "/$part"; - next if -e $fn; - last SWITCH if !mkdir $fn, 0777; - dbg("created directory $fn\n") if isdbg('msg'); - } - my $stream = next_transno($fromnode); - my $ref = DXMsg->alloc($stream, "$main::root/$f[3]", $self->call, time, !$f[4], $f[3], ' ', '0', '0'); +# this is a file request +sub handle_40 +{ + my $dxchan = shift; + my ($tonode, $fromnode) = @_[1..2]; + + $_[3] =~ s/\\/\//og; # change the slashes + $_[3] =~ s/\.//og; # remove dots + $_[3] =~ s/^\///o; # remove the leading / + $_[3] = lc $_[3]; # to lower case; + dbg("incoming file $_[3]\n") if isdbg('msg'); + $_[3] = 'packclus/' . $_[3] unless $_[3] =~ /^packclus\//o; - # forwarding variables - $ref->{fromnode} = $tonode; - $ref->{tonode} = $fromnode; - $ref->{linesreq} = $f[5]; - $ref->{stream} = $stream; - $ref->{count} = 0; # no of lines between PC31s - $ref->{file} = 1; - $ref->{lastt} = $main::systime; - set_fwq($fromnode, $stream, $ref); # store in work - $self->send(DXProt::pc30($fromnode, $tonode, $stream)); # send ack + # create any directories + my @part = split /\//, $_[3]; + my $part; + my $fn = "$main::root"; + pop @part; # remove last part + foreach $part (@part) { + $fn .= "/$part"; + next if -e $fn; + last SWITCH if !mkdir $fn, 0777; + dbg("created directory $fn\n") if isdbg('msg'); + } + my $stream = next_transno($fromnode); + my $ref = DXMsg->alloc($stream, "$main::root/$_[3]", $dxchan->call, time, !$_[4], $_[3], ' ', '0', '0'); - last SWITCH; - } + # forwarding variables + $ref->{fromnode} = $tonode; + $ref->{tonode} = $fromnode; + $ref->{linesreq} = $_[5]; + $ref->{stream} = $stream; + $ref->{count} = 0; # no of lines between PC31s + $ref->{file} = 1; + $ref->{lastt} = $main::systime; + set_fwq($fromnode, $stream, $ref); # store in work + $dxchan->send(DXProt::pc30($fromnode, $tonode, $stream)); # send ack +} - if ($pcno == 42) { # abort transfer - dbg("stream $stream: abort received\n") if isdbg('msg'); - my $ref = get_fwq($fromnode, $stream); - if ($ref) { - $ref->stop_msg($fromnode); - $ref = undef; - } - last SWITCH; - } +# abort transfer +sub handle_42 +{ + my $dxchan = shift; + my ($tonode, $fromnode, $stream) = @_[1..3]; + + dbg("stream $stream: abort received\n") if isdbg('msg'); + my $ref = get_fwq($fromnode, $stream); + if ($ref) { + $ref->stop_msg($fromnode); + $ref = undef; + } +} - if ($pcno == 49) { # global delete on subject - for (@msg) { - if ($_->{from} eq $f[1] && $_->{subject} eq $f[2]) { - $_->mark_delete; - Log('msg', "Message $_->{msgno} from $_->{from} ($_->{subject}) fully deleted"); - DXChannel::broadcast_nodes($line, $self); - } - } +# global delete on subject +sub handle_49 +{ + my $dxchan = shift; + my $line = shift; + + for (@msg) { + if ($_->{from} eq $_[1] && $_->{subject} eq $_[2]) { + $_->mark_delete; + Log('msg', "Message $_->{msgno} from $_->{from} ($_->{subject}) fully deleted"); + DXChannel::broadcast_nodes($line, $dxchan); } } } + sub notify { my $ref = shift; diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 2fe92625..9f9ffd4a 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -327,1024 +327,1167 @@ sub normal }; # dbg("Local::pcprot error $@") if isdbg('local') if $@; return if $pcr; + + no strict 'subs'; + my $sub = "handle_$pcno"; + if ($self->can($sub)) { + $self->$sub($pcno, $line, @field); + } else { + $self->handle_default($pcno, $line, @field); + } +} - SWITCH: { - if ($pcno == 10) { # incoming talk +# incoming talk commands +sub handle_10 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; # rsfp check - return if $rspfcheck and !$self->rspfcheck(0, $field[6], $field[1]); + return if $rspfcheck and !$self->rspfcheck(0, $_[6], $_[1]); - # will we allow it at all? - if ($censorpc) { - my @bad; - if (@bad = BadWords::check($field[3])) { - dbg("PCPROT: Bad words: @bad, dropped") if isdbg('chanerr'); - return; - } - } + # 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 = $field[1]; - if ($field[5] gt ' ') { - $via = $field[2]; - $to = $field[5]; - } else { - $to = $field[2]; - } + # 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($field[6]) || ($via && $badnode->in($via))) { - dbg("PCPROT: Bad Node, dropped") if isdbg('chanerr'); - return; - } + # 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 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, $field[3]) && AnnTalk::dup($from, $to, $field[3])) { - dbg("DXPROT: Dupe talk from announce, 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; + } + } - # 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) { - $field[3] =~ s/\%5E/^/g; - $dxchan->talk($from, $to, $via, $field[3]); - return; - } + # 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, $field[3], $field[6]); - 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; + } - # not visible here, send a message of condolence - $vref = undef; - $ref = Route::get($from); - $vref = $ref = Route::Node::get($field[6]) unless $ref; - if ($ref) { - $dxchan = $ref->dxchan; - $dxchan->talk($main::mycall, $from, $vref ? $vref->call : undef, $dxchan->msg('talknh', $to) ); - } + # 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; + + # route 'foreign' pc26s + if ($pcno == 26) { + if ($_[7] ne $main::mycall) { + $self->route($_[7], $line); return; } - - if ($pcno == 11 || $pcno == 26) { # dx spot - - # route 'foreign' pc26s - if ($pcno == 26) { - if ($field[7] ne $main::mycall) { - $self->route($field[7], $line); - return; - } - } + } - # rsfp check -# return if $rspfcheck and !$self->rspfcheck(1, $field[7], $field[6]); + # rsfp check + # return if $rspfcheck and !$self->rspfcheck(1, $_[7], $_[6]); - # if this is a 'nodx' node then ignore it - if ($badnode->in($field[7])) { - dbg("PCPROT: Bad Node, 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 = $field[6]; - $nossid =~ s/-\d+$//; - if ($badspotter->in($nossid)) { - dbg("PCPROT: Bad Spotter, 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($field[3], $field[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 ($field[3] $field[4])\n") 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($field[2]) || BadWords::check($field[2]) || $field[2] =~ /COCK/) { - dbg("PCPROT: Bad DX spot, ignored") 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 - $field[5] =~ s/^\s+//; # take any leading blanks off - $field[2] = unpad($field[2]); # take off leading and trailing blanks from spotted callsign - if ($field[2] =~ /BUST\w*$/) { - dbg("PCPROT: useless 'BUSTED' spot") if isdbg('chanerr'); - return; - } - if ($censorpc) { - my @bad; - if (@bad = BadWords::check($field[5])) { - dbg("PCPROT: Bad words: @bad, dropped") 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; + } + } - my @spot = Spot::prepare($field[1], $field[2], $d, $field[5], $field[6], $field[7]); - # global spot filtering on INPUT - if ($self->{inspotsfilter}) { - my ($filter, $hops) = $self->{inspotsfilter}->it(@spot); - unless ($filter) { - dbg("PCPROT: Rejected by input spot filter") if isdbg('chanerr'); - return; - } - } + my @spot = Spot::prepare($_[1], $_[2], $d, $_[5], $_[6], $_[7]); + # global spot filtering on INPUT + if ($self->{inspotsfilter}) { + my ($filter, $hops) = $self->{inspotsfilter}->it(@spot); + unless ($filter) { + dbg("PCPROT: Rejected by input spot filter") if isdbg('chanerr'); + return; + } + } - # 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($field[1], $field[2], $d, $field[5], $field[6])) { - dbg("PCPROT: Duplicate Spot ignored\n") 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($_[1], $_[2], $d, $_[5], $_[6])) { + dbg("PCPROT: Duplicate Spot ignored\n") if isdbg('chanerr'); + return; + } - # add it - Spot::add(@spot); + # 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 - # + # + # @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; - } - } + # 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; + # 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)); } - if ($to ne $field[7]) { - $to = $field[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; } } + $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; - return; } + } + + # 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; +} - if ($pcno == 12) { # announces +# announces +sub handle_12 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; -# return if $rspfcheck and !$self->rspfcheck(1, $field[5], $field[1]); + # return if $rspfcheck and !$self->rspfcheck(1, $_[5], $_[1]); - # announce duplicate checking - $field[3] =~ s/^\s+//; # remove leading blanks + # announce duplicate checking + $_[3] =~ s/^\s+//; # remove leading blanks - if ($censorpc) { - my @bad; - if (@bad = BadWords::check($field[3])) { - dbg("PCPROT: Bad words: @bad, dropped") if isdbg('chanerr'); - return; - } - } + 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($field[5])) { - dbg("PCPROT: Bad Node, 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 = $field[1]; - $nossid =~ s/-\d+$//; - if ($badspotter->in($nossid)) { - dbg("PCPROT: Bad Spotter, 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; + } - if ($field[2] eq '*' || $field[2] eq $main::mycall) { + if ($_[2] eq '*' || $_[2] eq $main::mycall) { - # 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($field[1], $field[3]); - if ($call) { - my $ref = Route::get($call); - if ($ref) { - my $dxchan = $ref->dxchan; - $dxchan->talk($field[1], $call, undef, $field[3], $field[5]) if $dxchan != $self; - 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) { + my $dxchan = $ref->dxchan; + $dxchan->talk($_[1], $call, undef, $_[3], $_[5]) if $dxchan != $self; + return; } - - # send it - $self->send_announce($line, @field[1..6]); - } else { - $self->route($field[2], $line); } - return; - } - - if ($pcno == 13) { - last SWITCH; - } - if ($pcno == 14) { - last SWITCH; - } - if ($pcno == 15) { - last SWITCH; } + + # send it + $self->send_announce($line, @_[1..6]); + } else { + $self->route($_[2], $line); + } +} - if ($pcno == 16) { # add a user +# incoming user +sub handle_16 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; - if (eph_dup($line)) { - dbg("PCPROT: dup PC16 detected") if isdbg('chanerr'); - return; - } - # general checks - my $dxchan; - my $ncall = $field[1]; - my $newline = "PC16^"; + if (eph_dup($line)) { + dbg("PCPROT: dup PC16 detected") if isdbg('chanerr'); + return; + } + + # general checks + my $dxchan; + my $ncall = $_[1]; + my $newline = "PC16^"; - # do 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; + # do 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 $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 $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 && @field > 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(@nrout) if @nrout ; - $parent = Route::Node::get($ncall); - unless ($parent) { - dbg("PCPROT: lost $ncall after sending PC19 for it?"); - return; - } - } else { - return; + 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; } - delete $pc19list{$ncall}; + 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(@nrout) if @nrout ; + $parent = Route::Node::get($ncall); + unless ($parent) { + dbg("PCPROT: lost $ncall after sending PC19 for it?"); + return; } } else { - dbg("PCPROT: Node $ncall not in config") if isdbg('chanerr'); return; } - } else { + 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; - } + $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); - } + # input filter if required + return unless $self->in_filter_route($parent); + } - my $i; - my @rout; - for ($i = 2; $i < $#field; $i++) { - my ($call, $conf, $here) = $field[$i] =~ /^(\S+) (\S) (\d)/o; - next unless $call && $conf && defined $here && is_callsign($call); - next if $call eq $main::mycall; + 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"); + 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; - } + $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); + $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); - } + 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); + } - # 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; - } + # 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; + } - # queue up any messages (look for privates only) - DXMsg::queue_msg(1) if $self->state eq 'normal'; - - $self->route_pc16($parent, @rout) if @rout; - return; - } + $self->route_pc16($parent, @rout) if @rout; +} - if ($pcno == 17) { # remove a user - my $dxchan; - my $ncall = $field[2]; - my $ucall = $field[1]; +# remove a user +sub handle_17 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + my $dxchan; + my $ncall = $_[2]; + my $ucall = $_[1]; - eph_del_regex("^PC16\\^$ncall.*$ucall"); + 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; - } + # 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; + } - 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; - } + my $uref = Route::User::get($ucall); + unless ($uref) { + dbg("PCPROT: Route::User $ucall not in config") if isdbg('chanerr'); + return; + } + my $parent = Route::Node::get($ncall); + unless ($parent) { + dbg("PCPROT: Route::Node $ncall not in config") if isdbg('chanerr'); + return; + } - $dxchan = $parent->dxchan; - if ($dxchan && $dxchan ne $self) { - dbg("PCPROT: PC17 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr'); - return; - } + $dxchan = $parent->dxchan; + if ($dxchan && $dxchan ne $self) { + dbg("PCPROT: PC17 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr'); + return; + } - # input filter if required - return unless $self->in_filter_route($parent); + # input filter if required + return unless $self->in_filter_route($parent); - $parent->del_user($uref); + $parent->del_user($uref); - 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; + } - $self->route_pc17($parent, $uref); - return; - } + $self->route_pc17($parent, $uref); +} - if ($pcno == 18) { # link request - $self->state('init'); - - # record the type and version offered - if ($field[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'); - } - } else { - $self->version(50.0); - $self->version($field[2] / 100) if $field[2] && $field[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(@rout, $parent) if @rout; - $self->send_local_config(); - $self->send(pc20()); - return; # we don't pass these on +# link request +sub handle_18 +{ + my $self = shift; + my $pcno = shift; + my $line = 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'); } + } 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(@rout, $parent) if @rout; + $self->send_local_config(); + $self->send(pc20()); +} - if ($pcno == 19) { # incoming cluster list - my $i; - my $newline = "PC19^"; +# incoming cluster list +sub handle_19 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; - if (eph_dup($line)) { - dbg("PCPROT: dup PC19 detected") if isdbg('chanerr'); - return; - } + my $i; + my $newline = "PC19^"; - # new routing list - my @rout; - my $parent = Route::Node::get($self->{call}); - unless ($parent) { - dbg("DXPROT: my parent $self->{call} has disappeared"); - $self->disconnect; - return; - } + if (eph_dup($line)) { + dbg("PCPROT: dup PC19 detected") if isdbg('chanerr'); + return; + } - # parse the PC19 - for ($i = 1; $i < $#field-1; $i += 4) { - my $here = $field[$i]; - my $call = uc $field[$i+1]; - my $conf = $field[$i+2]; - my $ver = $field[$i+3]; - next unless defined $here && defined $conf && is_callsign($call); + # new routing list + my @rout; + my $parent = Route::Node::get($self->{call}); + unless ($parent) { + dbg("DXPROT: my parent $self->{call} has disappeared"); + $self->disconnect; + return; + } - eph_del_regex("^PC(?:21\\^$call|17\\^[^\\^]+\\^$call)"); - - # check for sane parameters -# $ver = 5000 if $ver eq '0000'; - 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; + # 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); - # 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; - } + eph_del_regex("^PC(?:21\\^$call|17\\^[^\\^]+\\^$call)"); + + # check for sane parameters + # $ver = 5000 if $ver eq '0000'; + 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->sort('A'); - $user->priv(1); # I have relented and defaulted nodes - $user->lockout(1); - $user->homenode($call); - $user->node($call); - } + # 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->sort('A'); + $user->priv(1); # I have relented and defaulted nodes + $user->lockout(1); + $user->homenode($call); + $user->node($call); + } - my $r = Route::Node::get($call); - my $flags = Route::here($here)|Route::conf($conf); + 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; - } + # 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; - } + # 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; + # 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; - } + $user->lastin($main::systime) unless DXChannel->get($call); + $user->put; + } - $self->route_pc19(@rout) if @rout; - return; - } + $self->route_pc19(@rout) if @rout; +} - if ($pcno == 20) { # send local configuration - $self->send_local_config(); - $self->send(pc22()); - $self->state('normal'); - $self->{lastping} = 0; - return; - } +# send local configuration +sub handle_20 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + $self->send_local_config(); + $self->send(pc22()); + $self->state('normal'); + $self->{lastping} = 0; +} - if ($pcno == 21) { # delete a cluster from the list - my $call = uc $field[1]; +# delete a cluster from the list +sub handle_21 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + my $call = uc $_[1]; - eph_del_regex("^PC1[679].*$call"); + 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; - } + # 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; + } - # 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 { + # 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; + 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; } - 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); + # 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; - } + # routing objects + push @rout, $node->del($parent); } - - $self->route_pc21(@rout) if @rout; + } else { + dbg("PCPROT: I WILL _NOT_ be disconnected!") if isdbg('chanerr'); return; } + } + + $self->route_pc21(@rout) if @rout; +} - if ($pcno == 22) { - $self->state('normal'); - $self->{lastping} = 0; - return; - } + +sub handle_22 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + $self->state('normal'); + $self->{lastping} = 0; +} - if ($pcno == 23 || $pcno == 27) { # WWV info +# WWV info +sub handle_23 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; - # route 'foreign' pc27s - if ($pcno == 27) { - if ($field[8] ne $main::mycall) { - $self->route($field[8], $line); - return; - } - } + # route 'foreign' pc27s + if ($pcno == 27) { + if ($_[8] ne $main::mycall) { + $self->route($_[8], $line); + return; + } + } - return if $rspfcheck and !$self->rspfcheck(1, $field[8], $field[7]); - - # do some de-duping - my $d = cltounix($field[1], sprintf("%02d18Z", $field[2])); - my $sfi = unpad($field[3]); - my $k = unpad($field[4]); - my $i = unpad($field[5]); - my ($r) = $field[6] =~ /R=(\d+)/; - $r = 0 unless $r; - if (($pcno == 23 && $d < $main::systime - $pc23_max_age) || $d > $main::systime + 1500 || $field[2] < 0 || $field[2] > 23) { - dbg("PCPROT: WWV Date ($field[1] $field[2]) out of range") if isdbg('chanerr'); - return; - } - if (Geomag::dup($d,$sfi,$k,$i,$field[6])) { - dbg("PCPROT: Dup WWV Spot ignored\n") if isdbg('chanerr'); - return; - } - $field[7] =~ s/-\d+$//o; # remove spotter's ssid + 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; + } + if (Geomag::dup($d,$sfi,$k,$i,$_[6])) { + dbg("PCPROT: Dup WWV Spot ignored\n") if isdbg('chanerr'); + return; + } + $_[7] =~ s/-\d+$//o; # remove spotter's ssid - my $wwv = Geomag::update($d, $field[2], $sfi, $k, $i, @field[6..8], $r); + my $wwv = Geomag::update($d, $_[2], $sfi, $k, $i, @_[6..8], $r); - my $rep; - eval { - $rep = Local::wwv($self, $field[1], $field[2], $sfi, $k, $i, @field[6..8], $r); - }; -# dbg("Local::wwv2 error $@") if isdbg('local') if $@; - return if $rep; + 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; + # DON'T be silly and send on PC27s! + return if $pcno == 27; - # broadcast to the eager world - send_wwv_spot($self, $line, $d, $field[2], $sfi, $k, $i, @field[6..8]); - return; - } + # broadcast to the eager world + send_wwv_spot($self, $line, $d, $_[2], $sfi, $k, $i, @_[6..8]); +} - if ($pcno == 24) { # set here status - my $call = uc $field[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 +# set here status +sub handle_24 +{ + my $self = shift; + my $pcno = shift; + my $line = 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 - unless (eph_dup($line)) { - $nref->here($field[2]) if $nref; - $uref->here($field[2]) if $uref; - my $ref = $nref || $uref; - return unless $self->in_filter_route($ref); - $self->route_pc24($ref, $field[3]); - } - return; - } + 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($ref, $_[3]); +} - if ($pcno == 25) { # merge request - if ($field[1] ne $main::mycall) { - $self->route($field[1], $line); - return; - } - if ($field[2] eq $main::mycall) { - dbg("PCPROT: Trying to merge to myself, ignored") if isdbg('chanerr'); - return; - } +# merge request +sub handle_25 +{ + my $self = shift; + my $pcno = shift; + my $line = 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 $field[3] spots and $field[4] WWV from $field[2]"); + Log('DXProt', "Merge request for $_[3] spots and $_[4] WWV from $_[2]"); - # spots - if ($field[3] > 0) { - my @in = reverse Spot::search(1, undef, undef, 0, $field[3]); - my $in; - foreach $in (@in) { - $self->send(pc26(@{$in}[0..4], $field[2])); - } - } - - # wwv - if ($field[4] > 0) { - my @in = reverse Geomag::search(0, $field[4], time, 1); - my $in; - foreach $in (@in) { - $self->send(pc27(@{$in}[0..5], $field[2])); - } - } - return; + # 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])); } + } - if (($pcno >= 28 && $pcno <= 33) || $pcno == 40 || $pcno == 42 || $pcno == 49) { # mail/file handling - return if $pcno == 49 && eph_dup($line); - if ($pcno == 49 || $field[1] eq $main::mycall) { - DXMsg::process($self, $line); - } else { - $self->route($field[1], $line) unless $self->is_clx; - } - return; + # 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; + 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} - if ($pcno == 34 || $pcno == 36) { # remote commands (incoming) - if (eph_dup($line, $eph_pc34_restime)) { - dbg("PCPROT: dupe") if isdbg('chanerr'); - } else { - $self->process_rcmd($field[1], $field[2], $field[2], $field[3]); - } - return; - } +sub handle_34 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + if (eph_dup($line, $eph_pc34_restime)) { + dbg("PCPROT: dupe PC34, ignored") if isdbg('chanerr'); + } else { + $self->process_rcmd($_[1], $_[2], $_[2], $_[3]); + } +} - if ($pcno == 35) { # remote command replies - eph_del_regex("^PC35\\^$field[2]\\^$field[1]\\^"); - $self->process_rcmd_reply($field[1], $field[2], $field[1], $field[3]); - return; - } +# remote command replies +sub handle_35 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + eph_del_regex("^PC35\\^$_[2]\\^$_[1]\\^"); + $self->process_rcmd_reply($_[1], $_[2], $_[1], $_[3]); +} - # for pc 37 see 44 onwards +sub handle_36 {goto &handle_34} - if ($pcno == 38) { # node connected list from neighbour - return; - } +# database stuff +sub handle_37 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + DXDb::process($self, $line); +} + +# node connected list from neighbour +sub handle_38 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; +} - if ($pcno == 39) { # incoming disconnect - if ($field[1] eq $self->{call}) { - $self->disconnect(1); - } else { - dbg("PCPROT: came in on wrong channel") if isdbg('chanerr'); - } - return; - } +# incoming disconnect +sub handle_39 +{ + my $self = shift; + my $pcno = shift; + my $line = 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} - if ($pcno == 41) { # user info - my $call = $field[1]; +# user info +sub handle_41 +{ + my $self = shift; + my $pcno = shift; + my $line = 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: dupe") if isdbg('chanerr'); - return; - } + 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); + # input filter if required + # my $ref = Route::get($call) || Route->new($call); + # return unless $self->in_filter_route($ref); - if ($field[3] eq $field[2] || $field[3] =~ /^\s*$/) { - dbg('PCPROT: invalid value') if isdbg('chanerr'); - return; - } + 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; + # add this station to the user database, if required + my $user = DXUser->get_current($call); + $user = DXUser->new($call) unless $user; - if ($field[2] == 1) { - $user->name($field[3]); - } elsif ($field[2] == 2) { - $user->qth($field[3]); - } elsif ($field[2] == 3) { - if (is_latlong($field[3])) { - my ($lat, $long) = DXBearing::stoll($field[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 ($field[2] == 4) { - $user->homenode($field[3]); - } elsif ($field[2] == 5) { - if (is_qra(uc $field[3])) { - my ($lat, $long) = DXBearing::qratoll(uc $field[3]); - $user->lat($lat); - $user->long($long); - $user->qra(uc $field[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, $field[2], $field[3], $field[4]); + if ($_[2] == 1) { + $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; } - - if ($pcno == 43) { - last SWITCH; - } - - if ($pcno == 37 || $pcno == 44 || $pcno == 45 || $pcno == 46 || $pcno == 47 || $pcno == 48) { - DXDb::process($self, $line); + } 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} - if ($pcno == 50) { # keep alive/user list - my $call = $field[1]; - my $node = Route::Node::get($call); - if ($node) { - return unless $node->call eq $self->{call}; - $node->usercount($field[2]); +# message and database +sub handle_49 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; - # input filter if required - return unless $self->in_filter_route($node); + 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; + } +} - $self->route_pc50($node, $field[2], $field[3]) unless eph_dup($line); - } - return; - } +# keep alive/user list +sub handle_50 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + + my $call = $_[1]; + 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($node, $_[2], $_[3]) unless eph_dup($line); + } +} - if ($pcno == 51) { # incoming ping requests/answers - my $to = $field[1]; - my $from = $field[2]; - my $flag = $field[3]; +# incoming ping requests/answers +sub handle_51 +{ + my $self = shift; + my $pcno = shift; + my $line = 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 { - # it's a reply, look in the ping list for this one - my $ref = $pings{$from}; - if ($ref) { - my $tochan = DXChannel->get($from); - while (@$ref) { - my $r = shift @$ref; - my $dxchan = DXChannel->get($r->{call}); - next unless $dxchan; - my $t = tv_interval($r->{t}, [ gettimeofday ]); - if ($dxchan->is_user) { - my $s = sprintf "%.2f", $t; - my $ave = sprintf "%.2f", $tochan ? ($tochan->{pingave} || $t) : $t; - $dxchan->send($dxchan->msg('pingi', $from, $s, $ave)) - } elsif ($dxchan->is_node) { - if ($tochan) { - my $nopings = $tochan->user->nopings || 2; - push @{$tochan->{pingtime}}, $t; - shift @{$tochan->{pingtime}} if @{$tochan->{pingtime}} > 6; - - # cope with a missed ping, this means you must set the pingint large enough - if ($t > $tochan->{pingint} && $t < 2 * $tochan->{pingint} ) { - $t -= $tochan->{pingint}; - } - - # calc smoothed RTT a la TCP - if (@{$tochan->{pingtime}} == 1) { - $tochan->{pingave} = $t; - } else { - $tochan->{pingave} = $tochan->{pingave} + (($t - $tochan->{pingave}) / 6); - } - $tochan->{nopings} = $nopings; # pump up the timer - } - } + # is it for us? + if ($to eq $main::mycall) { + if ($flag == 1) { + $self->send(pc51($from, $to, '0')); + } else { + # it's a reply, look in the ping list for this one + my $ref = $pings{$from}; + if ($ref) { + my $tochan = DXChannel->get($from); + while (@$ref) { + my $r = shift @$ref; + my $dxchan = DXChannel->get($r->{call}); + next unless $dxchan; + my $t = tv_interval($r->{t}, [ gettimeofday ]); + if ($dxchan->is_user) { + my $s = sprintf "%.2f", $t; + my $ave = sprintf "%.2f", $tochan ? ($tochan->{pingave} || $t) : $t; + $dxchan->send($dxchan->msg('pingi', $from, $s, $ave)) + } elsif ($dxchan->is_node) { + if ($tochan) { + my $nopings = $tochan->user->nopings || 2; + push @{$tochan->{pingtime}}, $t; + shift @{$tochan->{pingtime}} if @{$tochan->{pingtime}} > 6; + + # cope with a missed ping, this means you must set the pingint large enough + if ($t > $tochan->{pingint} && $t < 2 * $tochan->{pingint} ) { + $t -= $tochan->{pingint}; + } + + # calc smoothed RTT a la TCP + if (@{$tochan->{pingtime}} == 1) { + $tochan->{pingave} = $t; + } else { + $tochan->{pingave} = $tochan->{pingave} + (($t - $tochan->{pingave}) / 6); + } + $tochan->{nopings} = $nopings; # pump up the timer } - } - } - } else { - if (eph_dup($line)) { - dbg("PCPROT: dup PC51 detected") if isdbg('chanerr'); - return; + } } - # route down an appropriate thingy - $self->route($to, $line); } - return; } - - if ($pcno == 75) { # dunno but route it - my $call = $field[1]; - if ($call ne $main::mycall) { - $self->route($call, $line); - } + } else { + if (eph_dup($line)) { + dbg("PCPROT: dup PC51 detected") if isdbg('chanerr'); return; } + # route down an appropriate thingy + $self->route($to, $line); + } +} - if ($pcno == 73) { # WCY broadcasts - my $call = $field[1]; +# dunno but route it +sub handle_75 +{ + my $self = shift; + my $pcno = shift; + my $line = 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 $call = $_[1]; - # do some de-duping - my $d = cltounix($call, sprintf("%02d18Z", $field[2])); - if (($pcno == 23 && $d < $main::systime - $pc23_max_age) || $d > $main::systime + 1500 || $field[2] < 0 || $field[2] > 23) { - dbg("PCPROT: WCY Date ($call $field[2]) out of range") if isdbg('chanerr'); - return; - } - @field = map { unpad($_) } @field; - if (WCY::dup($d)) { - dbg("PCPROT: Dup WCY Spot ignored\n") if isdbg('chanerr'); - return; - } + # 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, @field[2..12]); + my $wcy = WCY::update($d, @_[2..12]); - my $rep; - eval { - $rep = Local::wcy($self, @field[1..12]); - }; - # dbg("Local::wcy error $@") if isdbg('local') if $@; - return if $rep; + 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, @field[2..12]); - return; - } + # broadcast to the eager world + send_wcy_spot($self, $line, $d, @_[2..12]); +} - if ($pcno == 84) { # remote commands (incoming) - $self->process_rcmd($field[1], $field[2], $field[3], $field[4]); - return; - } +# remote commands (incoming) +sub handle_84 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + $self->process_rcmd($_[1], $_[2], $_[3], $_[4]); +} - if ($pcno == 85) { # remote command replies - $self->process_rcmd_reply($field[1], $field[2], $field[3], $field[4]); - - return; - } - if ($pcno == 90) { # new style PC16,17,19,21 - return; - } - } +# remote command replies +sub handle_85 +{ + my $self = shift; + my $pcno = shift; + my $line = shift; + $self->process_rcmd_reply($_[1], $_[2], $_[3], $_[4]); +} - # if get here then rebroadcast the thing with its Hop count decremented (if - # there is one). If it has a hop count and it decrements to zero then don't - # rebroadcast it. - # - # NOTE - don't arrive here UNLESS YOU WANT this lump of protocol to be - # REBROADCAST!!!! - # +# 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; if (eph_dup($line)) { dbg("PCPROT: Ephemeral dup, dropped") if isdbg('chanerr'); @@ -1383,6 +1526,8 @@ sub process # send a ping out on this channel if ($dxchan->{pingint} && $t >= $dxchan->{pingint} + $dxchan->{lastping}) { if ($dxchan->{nopings} <= 0) { + Log('DXProt', $dxchan->call . " Disconnected on Ping Timeout"); + dbg($dxchan->call . " Disconnected on Ping Timeout"); $dxchan->disconnect; } else { addping($main::mycall, $dxchan->call); @@ -2021,7 +2166,7 @@ sub broadcast_route foreach $dxchan (@dxchan) { next if $dxchan == $self; next if $dxchan == $main::me; - next if $dxchan->user->wantnp; + next unless $dxchan->isa('DXProt'); next if ($generate == \&pc16 || $generate==\&pc17) && !$dxchan->user->wantsendpc16; $dxchan->send_route($generate, @_); diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 7c9a4b36..08a6b9ff 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -25,7 +25,7 @@ $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)) $main::build += $VERSION; $main::branch += $BRANCH; -use vars qw(%u $dbm $filename %valid $lastoperinterval $lasttime $lru $lrusize $tooold); +use vars qw(%u $dbm $filename %valid $lastoperinterval $lasttime $lru $lrusize $tooold $v3); %u = (); $dbm = undef; @@ -34,6 +34,7 @@ $lastoperinterval = 60*24*60*60; $lasttime = 0; $lrusize = 2000; $tooold = 86400 * 365; # this marks an old user who hasn't given enough info to be useful +$v3 = 0; # hash of valid elements and a simple prompt %valid = ( @@ -116,14 +117,53 @@ sub init my ($pkg, $fn, $mode) = @_; confess "need a filename in User" if !$fn; - $fn .= ".v2"; + + my $ufn; + my $convert; + + eval { + require Storable; + }; + +# eval "use Storable qw(nfreeze thaw)"; + + if ($@) { + $ufn = "$fn.v2"; + } else { + import Storable qw(nfreeze thaw); + + $ufn = "$fn.v3"; + $v3 = 1; + $convert = ! -e $ufn; + } + if ($mode) { - $dbm = tie (%u, 'DB_File', $fn, O_CREAT|O_RDWR, 0666, $DB_BTREE) or confess "can't open user file: $fn ($!) [rebuild it from user_asc?]"; + $dbm = tie (%u, 'DB_File', $ufn, O_CREAT|O_RDWR, 0666, $DB_BTREE) or confess "can't open user file: $fn ($!) [rebuild it from user_asc?]"; } else { - $dbm = tie (%u, 'DB_File', $fn, O_RDONLY, 0666, $DB_BTREE) or confess "can't open user file: $fn ($!) [rebuild it from user_asc?]"; + $dbm = tie (%u, 'DB_File', $ufn, O_RDONLY, 0666, $DB_BTREE) or confess "can't open user file: $fn ($!) [rebuild it from user_asc?]"; } - $filename = $fn; + # do a conversion if required + if ($convert) { + my ($key, $val, $action, $count, $err); + + my %oldu; + dbg("Converting the User File to V3"); + my $odbm = tie (%oldu, 'DB_File', "${fn}.v2", O_RDONLY, 0666, $DB_BTREE) or confess "can't open user file: $fn ($!) [rebuild it from user_asc?]"; + for ($count = $err = 0, $action = R_FIRST; !$odbm->seq($key, $val, $action); $action = R_NEXT) { + my $ref = asc_decode($val); + if ($ref) { + $u{$key} = $ref->encode; + $count++; + } else { + $err++ + } + } + undef $odbm; + untie %oldu; + dbg("Conversion completed $count records $err errors"); + } + $filename = $ufn; $lru = LRU->newbase("DXUser", $lrusize); } @@ -250,10 +290,25 @@ sub put $dbm->put($call, $ref); } +# freeze the user +sub encode +{ + goto &asc_encode unless $v3; + my $self = shift; + return nfreeze($self); +} + +# thaw the user +sub decode +{ + goto &asc_decode unless $v3; + return thaw(shift); +} + # -# create a string from a user reference +# create a string from a user reference (in_ascii) # -sub encode +sub asc_encode { my $self = shift; my $dd = new Data::Dumper([$self]); @@ -264,9 +319,9 @@ sub encode } # -# create a hash from a string +# create a hash from a string (in ascii) # -sub decode +sub asc_decode { my $s = shift; my $ref; @@ -372,7 +427,7 @@ BEGIN { # try to detect a lockfile (this isn't atomic but # should do for now - $lockfn = "$root/perl/cluster.lck"; # lock file name + $lockfn = "$root/local/cluster.lck"; # lock file name if (-e $lockfn) { open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!"; my $pid = ; @@ -400,7 +455,7 @@ my $err = 0; while () { chomp; my @f = split /\t/; - my $ref = decode($f[1]); + my $ref = asc_decode($f[1]); if ($ref) { $ref->put(); $count++; @@ -435,7 +490,7 @@ print "There are $count user records and $err errors\n"; } } # only store users that are reasonably active or have useful information - print $fh "$key\t" . $ref->encode . "\n"; + print $fh "$key\t" . $ref->asc_encode . "\n"; ++$count; } else { Log('DXCommand', "Export Error3: $key\t$val"); diff --git a/perl/cluster.pl b/perl/cluster.pl index 5d102e4f..c6ec4e52 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -33,7 +33,7 @@ BEGIN { # try to create and lock a lockfile (this isn't atomic but # should do for now - $lockfn = "$root/perl/cluster.lck"; # lock file name + $lockfn = "$root/local/cluster.lck"; # lock file name if (-e $lockfn) { open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!"; my $pid = ; @@ -556,7 +556,7 @@ for (;;) { DXUser::process(); DXDupe::process(); AGWMsg::process(); - + eval { Local::process(); # do any localised processing }; diff --git a/perl/create_sysop.pl b/perl/create_sysop.pl index fbfc7764..11673e31 100755 --- a/perl/create_sysop.pl +++ b/perl/create_sysop.pl @@ -75,7 +75,7 @@ sub create_it } -$lockfn = "$root/perl/cluster.lck"; # lock file name +$lockfn = "$root/local/cluster.lck"; # lock file name if (-e $lockfn) { open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!"; my $pid = ; diff --git a/perl/lock_nodes.pl b/perl/lock_nodes.pl index c80c6973..9480c481 100755 --- a/perl/lock_nodes.pl +++ b/perl/lock_nodes.pl @@ -26,7 +26,7 @@ BEGIN { use DXVars; use DXUser; -my $lockfn = "$root/perl/cluster.lck"; # lock file name +my $lockfn = "$root/local/cluster.lck"; # lock file name if (-e $lockfn) { open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!"; my $pid = ; diff --git a/perl/update_sysop.pl b/perl/update_sysop.pl index af128c94..d93e096b 100755 --- a/perl/update_sysop.pl +++ b/perl/update_sysop.pl @@ -82,7 +82,7 @@ sub create_it } -$lockfn = "$root/perl/cluster.lck"; # lock file name +$lockfn = "$root/local/cluster.lck"; # lock file name if (-e $lockfn) { open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!"; my $pid = ;