added logging
[spider.git] / perl / DXProt.pm
index f825ebb87b772006f5eec0aa28c19aa5a30d3cdd..ab9e0e33fd0af91dbf9b83e8b45d53672d212cac 100644 (file)
@@ -18,19 +18,25 @@ use DXM;
 use DXCluster;
 use DXProtVars;
 use DXCommandmode;
+use DXLog;
 use Spot;
-use Date::Parse;
 use DXProtout;
+use Carp;
 
 use strict;
+use vars qw($me $pc11_max_age $pc11_dup_age %dup $last_hour);
 
-my $me;            # 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
 {
   my $user = DXUser->get($main::mycall);
-  $me = DXChannel::alloc('DXProt', $main::mycall, undef, $user); 
-  $me->{sort} = 'M';    # M for me
+  $me = DXProt->new($main::mycall, undef, $user); 
+#  $me->{sort} = 'M';    # M for me
 }
 
 #
@@ -61,8 +67,9 @@ 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);
+  Log('DXProt', "$call connected");
 }
 
 #
@@ -97,33 +104,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;
        }
@@ -134,10 +142,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 {
@@ -157,16 +180,26 @@ sub normal
          last SWITCH if !$node;        # ignore if havn't seen a PC19 for this one yet
          my $i;
          
-         for ($i = 2; $i < $#field-1; $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 =~ 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;
          }
+         
+         # queue up any messages (look for privates only)
+         DXMsg::queue_msg(1) if $self->state eq 'normal';     
          last SWITCH;
        }
        
@@ -177,14 +210,9 @@ 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());
+      $self->state('init');    
          last SWITCH;
        }
        
@@ -192,10 +220,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
                
@@ -203,49 +231,101 @@ 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
-
-      # 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());
+         $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 == 24) {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];
+         $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
+         $field[1] =~ s/-\d+$//o;
+         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;}
@@ -283,11 +363,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
@@ -315,6 +392,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;
+  }
 }
 
 #
@@ -323,52 +411,50 @@ sub process
 sub finish
 {
   my $self = shift;
-  broadcast_ak1a($self->pc21('Gone.'));
-  $self->delnode();
-}
-# 
-# add a (local) user to the cluster
-#
-
-sub adduser
-{
-  DXNodeuser->add(@_);
-}
+  my $ref = DXCluster->get($self->call);
 
-#
-# delete a (local) user to the cluster
-#
+  # 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();
+  }
 
-sub deluser
-{
-  my $self = shift;
-  my $ref = DXCluster->get($self->call);
+  # 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;
 }
 
 #
-# add a (locally connected) node to the cluster
+# some active measures
 #
 
-sub addnode
-{
-  DXNode->new(@_);
-}
-
-#
-# delete a (locally connected) node to the cluster
-#
-sub delnode
+sub send_local_config
 {
   my $self = shift;
-  my $ref = DXCluster->get($self->call);
-  $ref->del() if $ref;
-}
+  my $n;
 
-#
-# some active measures
-#
+  # 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
@@ -380,8 +466,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
+       }
   }
 }
 
@@ -394,7 +489,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
   }
 }
 
@@ -407,7 +503,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 
   }
 }