1. fix set/lockout so that it is possible to lock out all SSIDs except those

[spider.git] / perl / QXProt.pm

diff --git a/perl/QXProt.pm b/perl/QXProt.pm
new file mode 100644 (file)
index 0000000..bce0b56
--- /dev/null
+++ b/perl/QXProt.pm
@@ -0,0 +1,116 @@
+#
+# This module impliments the new protocal mode for a dx cluster
+#
+# Copyright (c) 2001 Dirk Koopman G1TLH
+#
+# $Id$
+# 
+
+package QXProt;
+
+@ISA = qw(DXChannel DXProt);
+
+use DXUtil;
+use DXChannel;
+use DXUser;
+use DXM;
+use DXLog;
+use Spot;
+use DXDebug;
+use Filter;
+use DXDb;
+use AnnTalk;
+use Geomag;
+use WCY;
+use Time::HiRes qw(gettimeofday tv_interval);
+use BadWords;
+use DXHash;
+use Route;
+use Route::Node;
+use Script;
+use DXProt;
+
+use strict;
+
+use vars qw($VERSION $BRANCH);
+$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
+$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0;
+$main::build += $VERSION;
+$main::branch += $BRANCH;
+
+use vars qw($last_node_update $node_update_interval);
+
+$node_update_interval = 14*60;
+$last_node_update = time;
+
+
+sub start
+{
+       my $self = shift;
+       $self->SUPER::start(@_);
+}
+
+sub normal
+{
+       if ($_[1] =~ /^PC\d\d\^/) {
+               DXProt::normal(@_);
+               return;
+       }
+       my $pcno;
+       return unless ($pcno) = $_[1] =~ /^QX(\d\d)\^/;
+
+       my ($self, $line) = @_;
+       
+       # calc checksum
+       $line =~ s/\^(\d\d)$//;
+       my $incs = hex $1;
+       my $cs = unpack("%32C*", $line) % 255;
+       if ($incs != $cs) {
+               dbg("QXPROT: Checksum fail in: $incs ne calc: $cs" ) if isdbg('qxerr');
+               return;
+       }
+
+       # split the field for further processing
+       my ($id, $tonode, $fromnode, @field) = split /\^/, $line;
+       
+}
+
+sub process
+{
+       if ($main::systime >= $last_node_update+$node_update_interval) {
+#              sendallnodes();
+#              sendallusers();
+               $last_node_update = $main::systime;
+       }
+}
+
+sub sendallnodes
+{
+       my $nodes = join(',', map {sprintf("%s:%d", $_->{call}, int($_->{pingave} * $_->{metric}))} DXChannel::get_all_nodes());
+       my $users = DXChannel::get_all_users();
+       DXChannel::broadcast_nodes(frame(2, undef, undef, hextime(), $users, 'S', $nodes))
+}
+
+sub sendallusers
+{
+
+}
+
+sub hextime
+{
+       my $t = shift || $main::systime;
+       return sprintf "%X", $t; 
+}
+
+sub frame
+{
+       my $pcno = shift;
+       my $to = shift || '';
+       my $from = shift || $main::mycall;
+       
+       my $line = join '^', sprintf("QX%02d", $pcno), $to, $from, @_;
+       my $cs = unpack("%32C*", $line) % 255;
+       return $line . sprintf("^%02X", $cs);
+}
+
+1;