X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=18fafa82170ed24318cf20f050f519078d889e45;hb=b060a0a3ee72530aa3f10d453186a662b66d7efe;hp=7e1c530e933a248f33976a07eebfbd18c6645d9a;hpb=84505457c5b3757715d97a63acd792b28fc1841a;p=spider.git diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 7e1c530e..18fafa82 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -18,13 +18,19 @@ use DXM; use DXCluster; use DXProtVars; use DXCommandmode; +use DXLog; use Spot; 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 { @@ -49,20 +55,29 @@ sub new # all the crap that comes between). sub start { - my ($self, $line) = shift; - my $call = $self->call; - + my ($self, $line, $sort) = @_; + my $call = $self->{call}; + my $user = $self->{user}; + # remember type of connection $self->{consort} = $line; - + $self->{outbound} = $sort eq 'O'; + $self->{priv} = $user->priv; + $self->{lang} = $user->lang; + $self->{consort} = $line; # save the connection type + $self->{here} = 1; + # set unbuffered $self->send_now('B',"0"); # send initialisation string - $self->send(pc38()) if DXNode->get_all(); - $self->send(pc18()); - $self->state('normal'); + if (!$self->{outbound}) { + $self->send(pc38()) if DXNode->get_all(); + $self->send(pc18()); + } + $self->state('init'); $self->pc50_t(time); + Log('DXProt', "$call connected"); } # @@ -97,34 +112,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 $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 + 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/-\d+$//o; # strip off the ssid from the spotter - $spotter .= ':'; # add a colon + + # 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; } @@ -190,6 +205,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; } @@ -200,9 +218,9 @@ sub normal } if ($pcno == 18) { # link request - $self->send_local_config(); $self->send(pc20()); + $self->state('init'); last SWITCH; } @@ -221,25 +239,49 @@ 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; + + # add this station to the user database, if required + my $user = DXUser->get_current($call); + $user = DXUser->new($call) if !$user; + $user->node($call) if !$user->node; + $user->sort('A'); + $user->put; } + + # 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; + 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 + Geomag::update(@field[1..$#field]); + last SWITCH; + } if ($pcno == 24) { # set here status my $call = uc $field[1]; @@ -250,20 +292,41 @@ sub normal } if ($pcno == 25) {last SWITCH;} - if ($pcno == 26) {last SWITCH;} - if ($pcno == 27) {last SWITCH;} if (($pcno >= 28 && $pcno <= 33) || $pcno == 40 || $pcno == 42) { # mail/file handling - DXMsg::process($self, $line); - return; + DXMsg::process($self, $line); + return; } if ($pcno == 34 || $pcno == 36) { # remote commands (incoming) - last SWITCH; + if ($field[1] eq $main::mycall) { + if ($self->{priv}) { # you have to have SOME privilege, the commands have further filtering + $self->{remotecmd} = 1; # for the benefit of any command that needs to know + for (DXCommandmode::run_cmd($self, $field[3])) { + s/\s*$//og; + $self->send(pc35($main::mycall, $self->{call}, "$main::mycall:$_")); + } + delete $self->{remotecmd}; + } + } else { + route($field[1], $line); + } + return; } if ($pcno == 35) { # remote command replies - last SWITCH; + if ($field[1] eq $main::mycall) { + my $s = DXChannel::get($main::myalias); + my @ref = grep { $_->pc34to eq $field[2] } DXChannel::get_all(); # people that have rcmded someone + push @ref, $s if $s; + + foreach (@ref) { + $_->send($field[3]); + } + } else { + route($field[1], $line); + } + return; } if ($pcno == 37) {last SWITCH;} @@ -279,6 +342,7 @@ sub normal if ($pcno == 41) { # user info # add this station to the user database, if required + $field[1] =~ s/-\d+$//o; my $user = DXUser->get_current($field[1]); $user = DXUser->new($field[1]) if !$user; @@ -366,6 +430,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; + } } # @@ -375,6 +450,10 @@ sub finish { my $self = shift; 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(); @@ -388,6 +467,7 @@ sub finish # now broadcast to all other ak1a nodes that I have gone broadcast_ak1a(pc21($self->call, 'Gone.'), $self); + Log('DXProt', $self->call . " Disconnected"); $ref->del() if $ref; } @@ -404,7 +484,7 @@ sub send_local_config my @nodes = DXNode::get_all(); # create a list of all the nodes that are not connected to this connection - @nodes = map { $_->dxchan != $self ? $_ : () } @nodes; + @nodes = grep { $_->dxchan != $self } @nodes; $self->send($me->pc19(@nodes)); # get all the users connected on the above nodes and send them out