X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=627356823274c7fe1d5aee98935b3693d7858d3e;hb=602b16e109137598da1bb8a363c0bfb4028701b3;hp=3a26ca772976f0be6972718bc12c842981f9c1d8;hpb=2546ef0cfaaca39e65985e414258071a636979af;p=spider.git diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 3a26ca77..62735682 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -19,13 +19,17 @@ use DXCluster; use DXProtVars; use DXCommandmode; use Spot; -use Date::Parse; use DXProtout; +use Carp; use strict; -use vars qw($me); +use vars qw($me $pc11_max_age $pc11_dup_age %dup $last_hour); -$me = undef; # the channel id for this cluster +$me = undef; # the channel id for this cluster +$pc11_max_age = 1*3600; # the maximum age for an incoming 'real-time' pc11 +$pc11_dup_age = 24*3600; # the maximum time to keep the dup list for +%dup = (); # the pc11 and 26 dup hash +$last_hour = time; # last time I did an hourly periodic update sub init { @@ -62,7 +66,7 @@ sub start # send initialisation string $self->send(pc38()) if DXNode->get_all(); $self->send(pc18()); - $self->state('normal'); + $self->state('init'); $self->pc50_t(time); } @@ -98,33 +102,34 @@ sub normal return; } - if ($pcno == 11) { # dx spot + 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 $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 + 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 - Spot::add($field[1], $field[2], $d, $text, $field[6]); - - # format and broadcast it to users my $spotter = $field[6]; - $spotter =~ s/^(\w+)-\d+/$1/; # strip off the ssid from the spotter - $spotter .= ':'; # add a colon + $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 - my $buf = sprintf "DX de %-7.7s %13.13s %-12.12s %-30.30s %5.5s\a\a", $spotter, $field[1], $field[2], $text, $field[4]; - broadcast_users($buf); + if ($spot && $pcno == 11) { + my $buf = Spot::formatb($field[1], $field[2], $d, $text, $spotter); + broadcast_users("$buf\a\a"); + } last SWITCH; } @@ -135,10 +140,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,7 +182,8 @@ 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 '*'; @@ -174,6 +195,9 @@ sub normal $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; } @@ -184,9 +208,9 @@ sub normal } if ($pcno == 18) { # link request - $self->send_local_config(); $self->send(pc20()); + $self->state('init'); last SWITCH; } @@ -194,10 +218,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 @@ -205,52 +229,76 @@ sub normal 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 $ref = DXCluster->get($field[1]); - $ref->del() if $ref; + my $call = uc $field[1]; + if ($call ne $main::mycall) { # don't allow malicious buggers to disconnect me! + my $ref = DXCluster->get($call); + $ref->del() if $ref; + } last SWITCH; } if ($pcno == 22) {last SWITCH;} - if ($pcno == 23) {last SWITCH;} + + if ($pcno == 23 || $pcno == 27) { # WWV info + last SWITCH; + } if ($pcno == 24) { # set here status - my $user = DXCluster->get($field[1]); - $user->here($field[2]); + 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 == 38) { # node connected list from neighbour + return; + } if ($pcno == 39) { # incoming disconnect $self->disconnect(); return; } - if ($pcno == 40) {last SWITCH;} if ($pcno == 41) { # user info # add this station to the user database, if required my $user = DXUser->get_current($field[1]); @@ -274,7 +322,6 @@ sub normal $user->put; last SWITCH; } - if ($pcno == 42) {last SWITCH;} if ($pcno == 43) {last SWITCH;} if ($pcno == 44) {last SWITCH;} if ($pcno == 45) {last SWITCH;} @@ -341,6 +388,17 @@ sub process $chan->pc50_t($t); } } + + my $key; + my $val; + my $cutoff; + if ($main::systime - 3600 > $last_hour) { + $cutoff = $main::systime - $pc11_dup_age; + while (($key, $val) = each %dup) { + delete $dup{$key} if $val < $cutoff; + } + $last_hour = $main::systime; + } } # @@ -349,8 +407,24 @@ sub process sub finish { my $self = shift; - broadcast_ak1a($self->pc21('Gone.')); my $ref = DXCluster->get($self->call); + + # unbusy and stop and outgoing mail + my $mref = DXMsg::get_busy($self->call); + $mref->stop_msg($self) if $mref; + + # 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; } @@ -429,6 +503,17 @@ sub broadcast_users } } +# broadcast to a list of users +sub broadcast_list +{ + my $s = shift; + my $chan; + + foreach $chan (@_) { + $chan->send($s); # send it + } +} + # # gimme all the ak1a nodes #