release 1.5
[spider.git] / perl / DXProt.pm
index 7e1c530e933a248f33976a07eebfbd18c6645d9a..18fafa82170ed24318cf20f050f519078d889e45 100644 (file)
@@ -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