perl/QXProt.pm

   1 #
   2 # This module impliments the new protocal mode for a dx cluster
   3 #
   4 # Copyright (c) 2001 Dirk Koopman G1TLH
   5 #
   6 # $Id$
   7 #
   8
   9 package QXProt;
  10
  11 @ISA = qw(DXChannel DXProt);
  12
  13 use DXUtil;
  14 use DXChannel;
  15 use DXUser;
  16 use DXM;
  17 use DXLog;
  18 use Spot;
  19 use DXDebug;
  20 use Filter;
  21 use DXDb;
  22 use AnnTalk;
  23 use Geomag;
  24 use WCY;
  25 use Time::HiRes qw(gettimeofday tv_interval);
  26 use BadWords;
  27 use DXHash;
  28 use Route;
  29 use Route::Node;
  30 use Script;
  31 use DXProt;
  32 use Verify;
  33 use Thingy;
  34
  35 use strict;
  36
  37 use vars qw($VERSION $BRANCH);
  38 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
  39 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0));
  40 $main::build += $VERSION;
  41 $main::branch += $BRANCH;
  42
  43 sub init
  44 {
  45         my $user = DXUser->get($main::mycall);
  46         $DXProt::myprot_version += ($main::version - 1 + 0.52)*100;
  47         $main::me = QXProt->new($main::mycall, 0, $user);
  48         $main::me->{here} = 1;
  49         $main::me->{state} = "indifferent";
  50         $main::me->{sort} = 'S';    # S for spider
  51         $main::me->{priv} = 9;
  52         $main::me->{metric} = 0;
  53         $main::me->{pingave} = 0;
  54         $main::me->{registered} = 1;
  55         $main::me->{version} = $main::version;
  56         $main::me->{build} = $main::build;
  57
  58 #       $Route::Node::me->adddxchan($main::me);
  59 }
  60
  61 sub start
  62 {
  63         my $self = shift;
  64         $self->SUPER::start(@_);
  65 }
  66
  67 sub sendinit
  68 {
  69         my $self = shift;
  70
  71         my $t = Thingy::Route->new_node_connect($main::mycall, $main::mycall, nextmsgid(), $self->{call});
  72         $t->add;
  73 }
  74
  75 sub normal
  76 {
  77         if ($_[1] =~ /^PC\d\d\^/) {
  78                 DXProt::normal(@_);
  79                 return;
  80         }
  81
  82         # Although this is called the 'QX' Protocol, this is historical
  83         # I am simply using this module to save a bit of time.
  84         #
  85
  86         return unless my ($tonode, $fromnode, $class, $msgid, $hoptime, $rest) =
  87                 $_[1] =~ /^([^,]+,){5,5}:(.*)$/;
  88
  89         my $self = shift;
  90
  91         # add this interface's hop time to the one passed
  92         my $newhoptime = $self->{pingave} >= 999 ?
  93                 $hoptime+10 : ($hoptime + int($self->{pingave}*10));
  94
  95         # split up the 'rest' which are 'a=b' pairs separated by commas
  96     # and create a new thingy based on the class passed (if known)
  97         # ignore pairs with a leading '_'.
  98
  99         my @par = map {/^_/ ? split(/=/,$_,2) : ()} split /,/, $rest;
 100         no strict 'refs';
 101         my $pkg = "Thingy::${class}";
 102         my $t = $pkg->new(_tonode=>$tonode, _fromnode=>$fromnode,
 103                                           _msgid=>$msgid, _hoptime=>$newhoptime,
 104                                           _newdata=>$rest, _inon=>$self->{call},
 105                                           @par) if defined *$pkg && $pkg->can('new');
 106         $t->add if $t;
 107         return;
 108 }
 109
 110 my $last_node_update = 0;
 111 my $node_update_interval = 60*60;
 112
 113 sub process
 114 {
 115         if ($main::systime >= $last_node_update+$node_update_interval) {
 116                 $last_node_update = $main::systime;
 117         }
 118 }
 119
 120 sub disconnect
 121 {
 122         my $self = shift;
 123         my $t = Thingy::Route->new_node_disconnect($main::mycall, $main::mycall, nextmsgid(), $self->{call});
 124         $t->add;
 125         $self->DXProt::disconnect(@_);
 126 }
 127
 128 my $msgid = 1;
 129
 130 sub nextmsgid
 131 {
 132         my $r = $msgid;
 133         $msgid = 1 if ++$msgid > 99999;
 134         return $r;
 135 }
 136
 137 sub node_update
 138 {
 139         my $t = Thingy::Route->new_node_update(nextmsgid());
 140         $t->add if $t;
 141 }
 142
 143
 144 1;