X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=7e1c530e933a248f33976a07eebfbd18c6645d9a;hb=84505457c5b3757715d97a63acd792b28fc1841a;hp=d75dd46c7d3e21b05ce21133be0cafa699328fe8;hpb=7432cb12ce865030c8b0315a30764e0088a59102;p=spider.git diff --git a/perl/DXProt.pm b/perl/DXProt.pm index d75dd46c..7e1c530e 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -19,7 +19,6 @@ use DXCluster; use DXProtVars; use DXCommandmode; use Spot; -use Date::Parse; use DXProtout; use strict; @@ -104,11 +103,12 @@ sub normal last SWITCH if grep $field[7] =~ /^$_/, @DXProt::nodx_node; # convert the date to a unix date - my $date = $field[3]; - my $time = $field[4]; - $date =~ s/^\s*(\d+)-(\w\w\w)-(19\d\d)$/$1 $2 $3/; - $time =~ s/^(\d\d)(\d\d)Z$/$1:$2 +0000/; - my $d = str2time("$date $time"); + my $d = cltounix($field[3], $field[4]); +# my $date = $field[3]; +# my $time = $field[4]; +# $date =~ s/^\s*(\d+)-(\w\w\w)-(19\d\d)$/$1 $2 $3/; +# $time =~ s/^(\d\d)(\d\d)Z$/$1:$2 +0000/; +# my $d = str2time("$date $time"); return if !$d; # bang out (and don't pass on) if date is invalid # strip off the leading & trailing spaces from the comment @@ -119,7 +119,7 @@ sub normal # format and broadcast it to users my $spotter = $field[6]; - $spotter =~ s/^(\w+)-\d+/$1/; # strip off the ssid from the spotter + $spotter =~ s/-\d+$//o; # strip off the ssid from the spotter $spotter .= ':'; # add a colon # send orf to the users @@ -135,10 +135,25 @@ sub normal # strip leading and trailing stuff my $text = unpad($field[3]); - my $target = "To Sysops" if $field[4] eq '*'; - $target = "WX" if $field[6]; + 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; - broadcast_users("$target de $field[1]: $text"); + + 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 { @@ -162,11 +177,18 @@ sub normal my ($call, $confmode, $here) = $field[$i] =~ /^(\w+) (-) (\d)/o; next if length $call < 3; next if !$confmode; - $call =~ s/^(\w+)-\d+/$1/; # remove ssid + $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; } last SWITCH; } @@ -179,12 +201,7 @@ sub normal if ($pcno == 18) { # link request - # send our nodes - my $hops = get_hops(19); - $self->send($me->pc19(get_all_ak1a())); - - # get all the local users and send them out - $self->send($me->pc16(get_all_users())); + $self->send_local_config(); $self->send(pc20()); last SWITCH; } @@ -193,10 +210,10 @@ sub normal my $i; for ($i = 1; $i < $#field-1; $i += 4) { my $here = $field[$i]; - my $call = $field[$i+1]; + 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 @@ -209,44 +226,80 @@ sub normal } if ($pcno == 20) { # send local configuration - - # send our nodes - my $hops = get_hops(19); - $self->send($me->pc19(get_all_ak1a())); - - # get all the local users and send them out - $self->send($me->pc16(get_all_users())); + $self->send_local_config(); $self->send(pc22()); return; } if ($pcno == 21) { # delete a cluster from the list - my $ref = DXCluster->get($field[1]); + my $call = uc $field[1]; + my $ref = DXCluster->get($call); $ref->del() if $ref; last SWITCH; } if ($pcno == 22) {last SWITCH;} if ($pcno == 23) {last SWITCH;} - if ($pcno == 24) {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 == 26) {last SWITCH;} if ($pcno == 27) {last SWITCH;} - if ($pcno == 28) {last SWITCH;} - if ($pcno == 29) {last SWITCH;} - if ($pcno == 30) {last SWITCH;} - if ($pcno == 31) {last SWITCH;} - if ($pcno == 32) {last SWITCH;} - if ($pcno == 33) {last SWITCH;} - if ($pcno == 34) {last SWITCH;} - if ($pcno == 35) {last SWITCH;} - if ($pcno == 36) {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) {last SWITCH;} - if ($pcno == 39) {last SWITCH;} - if ($pcno == 40) {last SWITCH;} - if ($pcno == 41) {last SWITCH;} - if ($pcno == 42) {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;} @@ -284,11 +337,8 @@ sub normal # REBROADCAST!!!! # - my $hopfield = pop @field; - push @field, $hopfield; - my $hops; - if (($hops) = $hopfield =~ /H(\d+)\^\~?$/o) { + if (($hops) = $line =~ /H(\d+)\^\~?$/o) { my $newhops = $hops - 1; if ($newhops > 0) { $line =~ s/\^H$hops(\^\~?)$/\^H$newhops$1/; # change the hop count @@ -324,8 +374,20 @@ sub process sub finish { my $self = shift; - broadcast_ak1a($self->pc21('Gone.')); my $ref = DXCluster->get($self->call); + + # broadcast to all other nodes that all the nodes connected to via me are gone + my @gonenodes = map { $_->dxchan == $self ? $_ : () } DXNode::get_all(); + my $node; + + foreach $node (@gonenodes) { + next if $node->call eq $self->call; + broadcast_ak1a(pc21($node->call, 'Gone'), $self); # done like this 'cos DXNodes don't have a pc21 method + $node->del(); + } + + # now broadcast to all other ak1a nodes that I have gone + broadcast_ak1a(pc21($self->call, 'Gone.'), $self); $ref->del() if $ref; } @@ -333,6 +395,25 @@ sub finish # some active measures # +sub send_local_config +{ + my $self = shift; + my $n; + + # send our nodes + my @nodes = DXNode::get_all(); + + # create a list of all the nodes that are not connected to this connection + @nodes = map { $_->dxchan != $self ? $_ : () } @nodes; + $self->send($me->pc19(@nodes)); + + # get all the users connected on the above nodes and send them out + foreach $n (@nodes) { + my @users = values %{$n->list}; + $self->send(DXProt::pc16($n, @users)); + } +} + # # route a message down an appropriate interface for a callsign # @@ -343,8 +424,17 @@ sub route my ($call, $line) = @_; my $cl = DXCluster->get($call); if ($cl) { - my $dxchan = $cl->{dxchan}; - $cl->send($line) if $dxchan; + my $hops; + my $dxchan = $cl->{dxchan}; + if (($hops) = $line =~ /H(\d+)\^\~?$/o) { + my $newhops = $hops - 1; + if ($newhops > 0) { + $line =~ s/\^H$hops(\^\~?)$/\^H$newhops$1/; # change the hop count + $dxchan->send($line) if $dxchan; + } + } else { + $dxchan->send($line) if $dxchan; # for them wot don't have Hops + } } } @@ -357,7 +447,8 @@ sub broadcast_ak1a my $chan; foreach $chan (@chan) { - $chan->send($s) if !grep $chan, @except; # send it if it isn't the except list + next if grep $chan == $_, @except; + $chan->send($s); # send it if it isn't the except list } } @@ -370,7 +461,19 @@ sub broadcast_users my $chan; foreach $chan (@chan) { - $chan->send($s) if !grep $chan, @except; # send it if it isn't the except list + next if grep $chan == $_, @except; + $chan->send($s); # send it if it isn't the except list + } +} + +# broadcast to a list of users +sub broadcast_list +{ + my $s = shift; + my $chan; + + foreach $chan (@_) { + $chan->send($s); # send it } }