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
  34 # sub modules
  35 use QXProt::QXI;
  36 use QXProt::QXP;
  37 use QXProt::QXR;
  38
  39 use strict;
  40
  41 use vars qw($VERSION $BRANCH);
  42 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
  43 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0));
  44 $main::build += $VERSION;
  45 $main::branch += $BRANCH;
  46
  47 sub init
  48 {
  49         my $user = DXUser->get($main::mycall);
  50         $DXProt::myprot_version += $main::version*100;
  51         $main::me = QXProt->new($main::mycall, 0, $user);
  52         $main::me->{here} = 1;
  53         $main::me->{state} = "indifferent";
  54         $main::me->{sort} = 'S';    # S for spider
  55         $main::me->{priv} = 9;
  56         $main::me->{metric} = 0;
  57         $main::me->{pingave} = 0;
  58         $main::me->{registered} = 1;
  59         $main::me->{version} = $main::version;
  60         $main::me->{build} = $main::build;
  61
  62 #       $Route::Node::me->adddxchan($main::me);
  63 }
  64
  65 sub start
  66 {
  67         my $self = shift;
  68         $self->SUPER::start(@_);
  69 }
  70
  71 sub sendinit
  72 {
  73         my $self = shift;
  74
  75         $self->send($self->QXI::gen);
  76 }
  77
  78 sub normal
  79 {
  80         if ($_[1] =~ /^PC\d\d\^/) {
  81                 DXProt::normal(@_);
  82                 return;
  83         }
  84         my ($sort, $tonode, $fromnode, $msgid, $line, $incs);
  85         return unless ($sort, $tonode, $fromnode, $msgid, $line, $incs) = $_[1] =~ /^QX([A-Z])\^(\*|[-A-Z0-9]+)\^([-A-Z0-9]+)\^([0-9A-F]{1,4})\^(.*)\^([0-9A-F]{2})$/;
  86
  87         $msgid = hex $msgid;
  88         my $noderef = Route::Node::get($fromnode);
  89         $noderef = Route::Node::new($fromnode) unless $noderef;
  90
  91         my $il = length $incs;
  92         my $cs = sprintf("%02X", unpack("%32C*", substr($_[1], 0, length($_[1]) - ($il+1))) & 255);
  93         if ($incs ne $cs) {
  94                 dbg("QXPROT: Checksum fail in: $incs ne calc: $cs" ) if isdbg('chanerr');
  95                 return;
  96         }
  97
  98         return unless $noderef->newid($msgid);
  99
 100         {
 101                 no strict 'subs';
 102                 my $sub = "QX${sort}::handle";
 103                 $_[0]->$sub($tonode, $fromnode, $msgid, $line) if $_[0]->can($sub);
 104         }
 105         return;
 106 }
 107
 108 my $last_node_update = 0;
 109 my $node_update_interval = 60*15;
 110
 111 sub process
 112 {
 113
 114         my $t = $main::systime;
 115
 116         foreach my $dxchan (DXChannel->get_all()) {
 117                 next unless $dxchan->is_np;
 118                 next if $dxchan == $main::me;
 119
 120                 # send a ping out on this channel
 121                 if ($dxchan->{pingint} && $t >= $dxchan->{pingint} + $dxchan->{lastping}) {
 122                         if ($dxchan->{nopings} <= 0) {
 123                                 $dxchan->disconnect;
 124                         } else {
 125                                 $dxchan->addping($main::mycall, $dxchan->call);
 126                                 $dxchan->{nopings} -= 1;
 127                                 $dxchan->{lastping} = $t;
 128                         }
 129                 }
 130         }
 131
 132         if ($t >= $last_node_update+$node_update_interval) {
 133 #               sendallnodes();
 134 #               sendallusers();
 135                 $last_node_update = $main::systime;
 136         }
 137 }
 138
 139 sub adjust_hops
 140 {
 141         return $_[1];
 142 }
 143
 144 sub disconnect
 145 {
 146         my $self = shift;
 147         $self->DXProt::disconnect(@_);
 148 }
 149
 150 my $msgid = 1;
 151
 152 sub frame
 153 {
 154         my $self = shift;
 155         my $sort = shift;
 156         my $to = shift || "*";
 157         my $ht;
 158
 159         $ht = sprintf "%X", $msgid;
 160         my $line = join '^', "QX$sort", $to, $main::mycall, $ht, @_;
 161         my $cs = sprintf "%02X", unpack("%32C*", $line) & 255;
 162         $msgid = 1 if ++$msgid > 0xffff;
 163         return "$line^$cs";
 164 }
 165
 166 # add a ping request to the ping queues
 167 sub addping
 168 {
 169         my ($self, $usercall, $to) = @_;
 170         my $ref = $DXChannel::pings{$to} || [];
 171         my $r = {};
 172         $r->{call} = $usercall;
 173         $r->{t} = [ gettimeofday ];
 174         DXChannel::route(undef, $to, $self->QXP::gen($to, 1, $usercall, @{$r->{t}}));
 175         push @$ref, $r;
 176         $DXCHannel::pings{$to} = $ref;
 177 }
 178
 179
 180
 181 1;