- my ($self, $line) = @_;
- my @field = split /[\^\~]/, $line;
-
- # ignore any lines that don't start with PC
- return if !$field[0] =~ /^PC/;
-
- # process PC frames
- my ($pcno) = $field[0] =~ /^PC(\d\d)/; # just get the number
- return if $pcno < 10 || $pcno > 51;
-
- SWITCH: {
- if ($pcno == 10) { # incoming talk
-
- # is it for me or one of mine?
- my $call = ($field[5] gt ' ') ? $field[5] : $field[2];
- if ($call eq $main::mycall || grep $_ eq $call, get_all_user_calls()) {
-
- # yes, it is
- my $text = unpad($field[3]);
- my $ref = DXChannel->get($call);
- $ref->send("$call de $field[1]: $text") if $ref;
- } else {
- route($field[2], $line); # relay it on its way
- }
- return;
- }
-
- if ($pcno == 11 || $pcno == 26) { # dx spot
-
- # if this is a 'nodx' node then ignore it
- last SWITCH if grep $field[7] =~ /^$_/, @DXProt::nodx_node;
-
- # convert the date to a unix date
- my $d = cltounix($field[3], $field[4]);
- return if !$d || ($pcno == 11 && $d < $main::systime - $pc11_max_age); # bang out (and don't pass on) if date is invalid or the spot is too old
-
- # strip off the leading & trailing spaces from the comment
- my $text = unpad($field[5]);
-
- # store it away
- my $spotter = $field[6];
- $spotter =~ s/-\d+$//o; # strip off the ssid from the spotter
-
- # do some de-duping
- my $dupkey = "$field[1]$field[2]$d$text$field[6]";
- return if $dup{$dupkey};
- $dup{$dupkey} = $d;
-
- my $spot = Spot::add($field[1], $field[2], $d, $text, $spotter);
-
- # send orf to the users
- if ($spot && $pcno == 11) {
- my $buf = Spot::formatb($field[1], $field[2], $d, $text, $spotter);
- broadcast_users("$buf\a\a");
- }
-
- last SWITCH;
- }
-
- if ($pcno == 12) { # announces
-
- if ($field[2] eq '*' || $field[2] eq $main::mycall) {
-
- # strip leading and trailing stuff
- my $text = unpad($field[3]);
- my $target;
- my @list;
-
- if ($field[4] eq '*') { # sysops
- $target = "To Sysops";
- @list = map { $_->priv >= 5 ? $_ : () } get_all_users();
- } elsif ($field[4] gt ' ') { # speciality list handling
- my ($name) = split /\./, $field[4];
- $target = "To $name"; # put the rest in later (if bothered)
- }
-
- $target = "WX" if $field[6] eq '1';
- $target = "To All" if !$target;
-
- if (@list > 0) {
- broadcast_list("$target de $field[1]: $text", @list);
- } else {
- broadcast_users("$target de $field[1]: $text");
- }
-
- return if $field[2] eq $main::mycall; # it's routed to me
- } else {
- route($field[2], $line);
- return; # only on a routed one
- }
-
- last SWITCH;
- }
-
- if ($pcno == 13) {last SWITCH;}
- if ($pcno == 14) {last SWITCH;}
- if ($pcno == 15) {last SWITCH;}
-
- if ($pcno == 16) { # add a user
- my $node = DXCluster->get($field[1]);
- last SWITCH if !$node; # ignore if havn't seen a PC19 for this one yet
- my $i;
-
- for ($i = 2; $i < $#field; $i++) {
- my ($call, $confmode, $here) = $field[$i] =~ /^(\w+) (-) (\d)/o;
- next if length $call < 3;
- next if !$confmode;
- $call = uc $call;
- $call =~ s/-\d+$//o; # remove ssid
- next if DXCluster->get($call); # we already have this (loop?)
-
- $confmode = $confmode eq '*';
- DXNodeuser->new($self, $node, $call, $confmode, $here);
-
- # add this station to the user database, if required
- my $user = DXUser->get_current($call);
- $user = DXUser->new($call) if !$user;
- $user->node($node->call) if !$user->node;
- $user->put;
- }
-
- # queue up any messages (look for privates only)
- DXMsg::queue_msg(1) if $self->state eq 'normal';
- last SWITCH;
- }
-
- if ($pcno == 17) { # remove a user
- my $ref = DXCluster->get($field[1]);
- $ref->del() if $ref;
- last SWITCH;
- }
-
- if ($pcno == 18) { # link request
- $self->send_local_config();
- $self->send(pc20());
- $self->state('init');
- last SWITCH;
- }
-
- if ($pcno == 19) { # incoming cluster list
- my $i;
- for ($i = 1; $i < $#field-1; $i += 4) {
- my $here = $field[$i];
- my $call = uc $field[$i+1];
- my $confmode = $field[$i+2] eq '*';
- my $ver = $field[$i+3];
-
- # now check the call over
- next if DXCluster->get($call); # we already have this
-
- # check for sane parameters
- next if $ver < 5000; # only works with version 5 software
- next if length $call < 3; # min 3 letter callsigns
- DXNode->new($self, $call, $confmode, $here, $ver);
-
- # 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($self) if $mref;
- }
-
- # queue up any messages
- DXMsg::queue_msg() if $self->state eq 'normal';
- last SWITCH;
- }
-
- if ($pcno == 20) { # send local configuration
- $self->send_local_config();
- $self->send(pc22());
- $self->state('normal');
-
- # queue mail
- DXMsg::queue_msg();
- return;
- }
-
- if ($pcno == 21) { # delete a cluster from the list
- my $call = uc $field[1];
- my $ref = DXCluster->get($call);
- $ref->del() if $ref;
- last SWITCH;
- }
-
- if ($pcno == 22) {last SWITCH;}
-
- if ($pcno == 23 || $pcno == 27) { # WWV info
- last SWITCH;
- }
-
- if ($pcno == 24) { # set here status
- my $call = uc $field[1];
- $call =~ s/-\d+//o;
- my $ref = DXCluster->get($call);
- $ref->here($field[2]) if $ref;
- last SWITCH;
- }
-
- if ($pcno == 25) {last SWITCH;}
-
- if (($pcno >= 28 && $pcno <= 33) || $pcno == 40 || $pcno == 42) { # mail/file handling
- DXMsg::process($self, $line);
- return;
- }
-
- if ($pcno == 34 || $pcno == 36) { # remote commands (incoming)
- last SWITCH;
- }
-
- if ($pcno == 35) { # remote command replies
- last SWITCH;
- }
-
- if ($pcno == 37) {last SWITCH;}
-
- if ($pcno == 38) { # node connected list from neighbour
- return;
- }
-
- if ($pcno == 39) { # incoming disconnect
- $self->disconnect();
- return;
- }
-
- if ($pcno == 41) { # user info
- # add this station to the user database, if required
- my $user = DXUser->get_current($field[1]);
- $user = DXUser->new($field[1]) if !$user;
-
- if ($field[2] == 1) {
- $user->name($field[3]);
- } elsif ($field[2] == 2) {
- $user->qth($field[3]);
- } elsif ($field[2] == 3) {
- my ($latd, $latm, $latl, $longd, $longm, $longl) = split /\s+/, $field[3];
- $longd += ($longm/60);
- $longd = 0-$longd if (uc $longl) eq 'W';
- $user->long($longd);
- $latd += ($latm/60);
- $latd = 0-$latd if (uc $latl) eq 'S';
- $user->lat($latd);
- } elsif ($field[2] == 4) {
- $user->node($field[3]);
- }
- $user->put;
- last SWITCH;
- }
- if ($pcno == 43) {last SWITCH;}
- if ($pcno == 44) {last SWITCH;}
- if ($pcno == 45) {last SWITCH;}
- if ($pcno == 46) {last SWITCH;}
- if ($pcno == 47) {last SWITCH;}
- if ($pcno == 48) {last SWITCH;}
- if ($pcno == 49) {last SWITCH;}
-
- if ($pcno == 50) { # keep alive/user list
- my $ref = DXCluster->get($field[1]);
- $ref->update_users($field[2]) if $ref;
- last SWITCH;
- }
-
- if ($pcno == 51) { # incoming ping requests/answers
-
- # is it for us?
- if ($field[1] eq $main::mycall) {
- my $flag = $field[3];
- $flag ^= 1;
- $self->send($self->pc51($field[2], $field[1], $flag));
- } else {
- # route down an appropriate thingy
- route($field[1], $line);
- }
- return;
- }
- }
-
- # if get here then rebroadcast the thing with its Hop count decremented (if
- # there is one). If it has a hop count and it decrements to zero then don't
- # rebroadcast it.
- #
- # NOTE - don't arrive here UNLESS YOU WANT this lump of protocol to be
- # REBROADCAST!!!!
- #
-
- my $hops;
- if (($hops) = $line =~ /H(\d+)\^\~?$/o) {
- my $newhops = $hops - 1;
- if ($newhops > 0) {
- $line =~ s/\^H$hops(\^\~?)$/\^H$newhops$1/; # change the hop count
- broadcast_ak1a($line, $self); # send it to everyone but me
- }
- }
+ my ($self, $line) = @_;
+
+ if ($line =~ '^<\w+\s' && $main::do_xml) {
+ DXXml::normal($self, $line);
+ return;
+ }
+
+ my @field = split /\^/, $line;
+ return unless @field;
+
+ pop @field if $field[-1] eq '~';
+
+# print join(',', @field), "\n";
+
+
+ # process PC frames, this will fail unless the frame starts PCnn
+ my ($pcno) = $field[0] =~ /^PC(\d\d)/; # just get the number
+ unless (defined $pcno && $pcno >= 10 && $pcno <= 99) {
+ dbg("PCPROT: unknown protocol") if isdbg('chanerr');
+ return;
+ }
+
+ # check for and dump bad protocol messages
+ my $n = check($pcno, @field);
+ if ($n) {
+ dbg("PCPROT: bad field $n, dumped (" . parray($checklist[$pcno-10]) . ")") if isdbg('chanerr');
+ return;
+ }
+
+ # modify the hop count here
+ if ($self != $main::me) {
+ if (my ($hops, $trail) = $line =~ /\^H(\d+)(\^?\~?)?$/) {
+ $trail ||= '';
+ $hops--;
+ return if $hops < 0;
+ $line =~ s/\^H(\d+)(\^?\~?)?$/sprintf('^H%d%s', $hops, $trail)/e;
+ $field[-1] = "H$hops";
+ }
+ }
+
+ if (defined &Local::pcprot) {
+ my $r;
+ eval { $r = Local::pcprot($self, $pcno, $line, @field); };
+ return if $r; # i.e don't process it
+ }
+
+ # send it out for processing
+ my $origin = $self->{call};
+ no strict 'subs';
+ my $sub = "handle_$pcno";
+
+ if ($self->can($sub)) {
+ $self->$sub($pcno, $line, $origin, @field);
+ } else {
+ $self->handle_default($pcno, $line, $origin, @field);
+ }