start with routing
authorminima <minima>
Fri, 2 Jan 2004 00:41:21 +0000 (00:41 +0000)
committerminima <minima>
Fri, 2 Jan 2004 00:41:21 +0000 (00:41 +0000)
perl/DXChannel.pm
perl/DXProt.pm
perl/QXProt.pm
perl/Thingy.pm
perl/Thingy/Route.pm [new file with mode: 0644]
perl/cluster.pl

index 3b3ac62f13b84e193c0ff661981d3ba3a7981616..536e7bb363dc3cea6e7e1cb3c9f7dc9a83f74119 100644 (file)
@@ -220,6 +220,17 @@ sub get_all_user_calls
        return @out;
 }
 
+# return a list of all node callsigns
+sub get_all_node_calls
+{
+       my $ref;
+       my @out;
+       foreach $ref (values %channels) {
+               push @out, $ref->{call} if $ref->is_node;
+       }
+       return @out;
+}
+
 # obtain a channel object by searching for its connection reference
 sub get_by_cnum
 {
index 8f46826a60c9ee93498320e2cb1e31a9769255ab..67869dd57670805332bd77aa9a475baa94152ab3 100644 (file)
@@ -326,32 +326,6 @@ sub send
        }
 }
 
-my $pc90msgid = 0;
-
-sub nextpc90
-{
-       $pc90msgid = 0 if $pc90msgid > 9999;
-       return $pc90msgid++;
-}
-
-sub mungepc90
-{
-       unless ($_[0] =~ /^PC9\d/) {
-               my $id = nextpc90();
-               return "PC90^$main::mycall^$id^" . $_[0]; 
-       } 
-       return $_[0];
-}
-
-sub mungepc91
-{
-       unless ($_[1] =~ /^PC9\d/) {
-               my $id = nextpc90();
-               return "PC91^$main::mycall^$id^$_[0]^" . $_[1]; 
-       } 
-       return $_[1];
-}
-
 #
 # This is the normal pcxx despatcher
 #
@@ -380,68 +354,8 @@ sub normal
                return;
        }
 
-       # handle PC90 frames in a special way.
-    # 
-       # PC90 frames are normal frames that that are wrapped in inside a PC90 
-    # The extra fields are "originating node" and a sequence number.
-    # The sequence number is checked against the nodes 'last one' to see if
-       # it is a duplicate and, if so, is dropped at this stage; before any
-       # other processing.
-       #
-       # This is done here simply for efficiency. Adding another function would
-       # add more copying and so on.
-       #
-
        my $origin = $self->{call};
        
-       if ($pcno >= 90) {
-               $origin = $field[1];
-               if ($origin eq $main::mycall) {
-                       dbg("PCPROT: loop dupe") if isdbg('chanerr');
-                       return;
-               }
-               $self->user->wantpc90(1) unless $self->user->wantpc90 || $origin ne $self->{call};
-               my $seq = $field[2];
-               my $node = Route::Node::get($origin);
-               if ($node) {
-                       if (my $lid = $node->lid) {
-                               my $cmp = $seq >= $lid ? $seq : $seq + 9999;
-                               if ($cmp <= $lid) {
-                                       dbg("PCPROT: sequence dupe $seq ($cmp) <= $lid") if isdbg('chanerr');
-                                       return;
-                               }
-                       }
-                       $node->lid($seq);
-               }
-
-               # do a recheck on the contents of the PC90
-               if ($pcno >= 90) {
-                       shift @field;
-                       shift @field;
-                       shift @field;
-                       $origin = shift @field if $pcno == 91;
-
-                       ($pcno) = $field[0] =~ /^PC(\d\d)/; # just get the number
-                       unless (defined $pcno && $pcno >= 10 && $pcno <= 89) {
-                               dbg("PCPROT: unknown protocol") if isdbg('chanerr');
-                               return;
-                       }
-                       
-                       # check for and dump bad protocol messages
-                       my $n = check($pcno, @field);
-                       if ($n) {
-                               dbg("PCPROT: bad field $n, dumped (" . parray($checklist[$pcno-10]) . ")") if isdbg('chanerr');
-                               return;
-                       }
-               }
-       } else {
-               if ($pcno == 16 || $pcno == 17 || $pcno == 19 || $pcno == 21) {
-                       $line = mungepc91($origin, $line);
-               } else {
-                       $line = mungepc90($line);
-               }
-       }
-
        no strict 'subs';
        my $sub = "handle_$pcno";
 
index b9cf952cb497a553d4fed6aa0069f09d7d20e2f5..43dbb03f17f31b8cc59b936675371e06f5f066c2 100644 (file)
@@ -30,6 +30,7 @@ use Route::Node;
 use Script;
 use DXProt;
 use Verify;
+use Thingy;
 
 use strict;
 
@@ -42,7 +43,7 @@ $main::branch += $BRANCH;
 sub init
 {
        my $user = DXUser->get($main::mycall);
-       $DXProt::myprot_version += $main::version*100;
+       $DXProt::myprot_version += ($main::version - 1 + 0.52)*100;
        $main::me = QXProt->new($main::mycall, 0, $user); 
        $main::me->{here} = 1;
        $main::me->{state} = "indifferent";
@@ -67,7 +68,8 @@ sub sendinit
 {
        my $self = shift;
        
-       $self->send($self->genI);
+       my $t = Thingy::Route->new_node_connect($main::mycall, $main::mycall, nextmsgid(), $self->{call});
+       $t->add;
 }
 
 sub normal
@@ -76,54 +78,41 @@ sub normal
                DXProt::normal(@_);
                return;
        }
-       my ($sort, $tonode, $fromnode, $msgid, $incs);
-       return unless ($sort, $tonode, $fromnode, $msgid, $incs) = $_[1] =~ /^QX([A-Z])\^(\*|[-A-Z0-9]+)\^([-A-Z0-9]+)\^([0-9A-F]{1,4})\^.*\^([0-9A-F]{2})$/;
 
-       $msgid = hex $msgid;
-       my $noderef = Route::Node::get($fromnode);
-       $noderef = Route::Node::new($fromnode) unless $noderef;
-
-       my $il = length $incs; 
-       my $cs = sprintf("%02X", unpack("%32C*", substr($_[1], 0, length($_[1]) - ($il+1))) & 255);
-       if ($incs ne $cs) {
-               dbg("QXPROT: Checksum fail in: $incs ne calc: $cs" ) if isdbg('chanerr');
-               return;
-       }
-
-       return unless $noderef->newid($msgid);
-
-       $_[0]->handle($sort, $tonode, $fromnode, $msgid, $_[1]);
-       return;
-}
-
-sub handle
-{
-       no strict 'subs';
-       my $self = shift;
-       my $sort = shift;
-       my $sub = "handle$sort";
-       $self->$sub(@_) if $self->can($sub);
-       return;
-}
+       # Although this is called the 'QX' Protocol, this is historical
+       # I am simply using this module to save a bit of time.
+       # 
+       
+       return unless my ($tonode, $fromnode, $class, $msgid, $hoptime, $rest) = 
+               $_[1] =~ /^([^,]+,){5,5}:(.*)$/;
 
-sub gen
-{
-       no strict 'subs';
        my $self = shift;
-       my $sort = shift;
-       my $sub = "gen$sort";
-       $self->$sub(@_) if $self->can($sub);
+       
+       # add this interface's hop time to the one passed
+       my $newhoptime = $self->{pingave} >= 999 ? 
+               $hoptime+10 : ($hoptime + int($self->{pingave}*10));
+       # split up the 'rest' which are 'a=b' pairs separated by commas
+    # and create a new thingy based on the class passed (if known)
+       # ignore pairs with a leading '_'.
+
+       my @par = map {/^_/ ? split(/=/,$_,2) : ()} split /,/, $rest;
+       no strict 'refs';
+       my $pkg = "Thingy::${class}";
+       my $t = $pkg->new(_tonode=>$tonode, _fromnode=>$fromnode,
+                                         _msgid=>$msgid, _hoptime=>$newhoptime,
+                                         _newdata=>$rest, _inon=>$self->{call},
+                                         @par) if defined *$pkg && $pkg->can('new');
+       $t->add if $t;
        return;
 }
 
 my $last_node_update = 0;
-my $node_update_interval = 60*15;
+my $node_update_interval = 60*60;
 
 sub process
 {
        if ($main::systime >= $last_node_update+$node_update_interval) {
-#              sendallnodes();
-#              sendallusers();
                $last_node_update = $main::systime;
        }
 }
@@ -131,116 +120,25 @@ sub process
 sub disconnect
 {
        my $self = shift;
+       my $t = Thingy::Route->new_node_disconnect($main::mycall, $main::mycall, nextmsgid(), $self->{call});
+       $t->add;
        $self->DXProt::disconnect(@_);
 }
 
 my $msgid = 1;
 
-sub frame
+sub nextmsgid
 {
-       my $sort = shift;
-       my $to = shift || "*";
-       my $ht;
-       
-       $ht = sprintf "%X", $msgid;
-       my $line = join '^', "QX$sort", $to, $main::mycall, $ht, @_;
-       my $cs = sprintf "%02X", unpack("%32C*", $line) & 255;
-       $msgid = 1 if ++$msgid > 0xffff;
-       return "$line^$cs";
+       my $r = $msgid;
+       $msgid = 1 if ++$msgid > 99999;
+       return $r;
 }
 
-sub handleI
+sub node_update
 {
-       my $self = shift;
-       
-       my @f = split /\^/, $_[3];
-       if ($self->passphrase && $f[7] && $f[8]) {
-               my $inv = Verify->new($f[7]);
-               unless ($inv->verify($f[8], $main::me->user->passphrase, $main::mycall, $self->call)) {
-                       $self->sendnow('D','Sorry...');
-                       $self->disconnect;
-               }
-               $self->{verified} = 1;
-       } else {
-               $self->{verified} = 0;
-       }
-       if ($self->{outbound}) {
-               $self->send($self->genI);
-       } 
-       if ($self->{sort} ne 'S' && $f[4] eq 'DXSpider') {
-               $self->{user}->{sort} = $self->{sort} = 'S';
-               $self->{user}->{priv} = $self->{priv} = 1 unless $self->{priv};
-       }
-       $self->{version} = $f[5];
-       $self->{build} = $f[6];
-       $self->state('init1');
-       $self->{lastping} = 0;
+       my $t = Thingy::Route->new_node_update(nextmsgid());
+       $t->add if $t;
 }
 
-sub genI
-{
-       my $self = shift;
-       my @out = ('I', $self->call, "DXSpider", ($main::version + 53) * 100, $main::build);
-       if (my $pass = $self->user->passphrase) {
-               my $inp = Verify->new;
-               push @out, $inp->challenge, $inp->response($pass, $self->call, $main::mycall);
-       }
-       return frame(@out);
-}
-
-sub handleR
-{
-
-}
-
-sub genR
-{
-
-}
-
-sub handleP
-{
-
-}
-
-sub genP
-{
-
-}
-
-sub gen2
-{
-       my $self = shift;
-       
-       my $node = shift;
-       my $sort = shift;
-       my @out;
-       my $dxchan;
-       
-       while (@_) {
-               my $str = '';
-               for (; @_ && length $str <= 230;) {
-                       my $ref = shift;
-                       my $call = $ref->call;
-                       my $flag = 0;
-                       
-                       $flag += 1 if $ref->here;
-                       $flag += 2 if $ref->conf;
-                       if ($ref->is_node) {
-                               my $ping = int($ref->pingave * 10);
-                               $str .= "^N$flag$call,$ping";
-                               my $v = $ref->build || $ref->version;
-                               $str .= ",$v" if defined $v;
-                       } else {
-                               $str .= "^U$flag$call";
-                       }
-               }
-               push @out, $str if $str;
-       }
-       my $n = @out;
-       my $h = get_hops(90);
-       @out = map { sprintf "PC90^%s^%X^%s%d%s^%s^", $node->call, $main::systime, $sort, --$n, $_, $h } @out;
-       return @out;
-}
 
 1;
index 885e7f0f5f4c0dc1a210a449390b5025978d7c87..87ee391adece15a8da1ac799ee2e0ca0be1867c1 100644 (file)
@@ -10,6 +10,8 @@
 
 package Thingy;
 
+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,0));
@@ -20,6 +22,8 @@ $main::branch += $BRANCH;
 use DXChannel;
 use DXDebug;
 
+use Thingy::Route;
+
 use vars qw(@queue);
 @queue = ();                                   # the thingy queue
 
@@ -29,7 +33,15 @@ sub new
        my $class = shift;
        my $self = {@_};
        
+       my ($type) = $class =~ /::(\w+)$/;
+       
        bless $self, $class;
+       $self->{_tonode} ||= '*';
+       $self->{_fromnode} ||= $main::mycall;
+       $self->{_hoptime} ||= 0;
+       while (my ($k,$v) = each %$self) {
+               delete $self->{$k} unless defined $v;
+       }
        return $self;
 }
 
@@ -44,7 +56,22 @@ sub process
 {
        my $t = pop @queue if @queue;
 
-       $t->process if $t;
+       if ($t) {
+
+               # go directly to this class's t= handler if there is one
+               my $type = $t->{t};
+               if ($type) {
+                       # remove extraneous characters put there by the ungodly
+                       $type =~ s/[^\w]//g;
+                       $type = 'handle_' . $type;
+                       if ($t->can($type)) {
+                               no strict 'refs';
+                               $t->$type;
+                               return;
+                       }
+               }
+               $t->normal;
+       }
 }
 
 1;
diff --git a/perl/Thingy/Route.pm b/perl/Thingy/Route.pm
new file mode 100644 (file)
index 0000000..ccdb53f
--- /dev/null
@@ -0,0 +1,67 @@
+#
+# Generate route Thingies
+#
+# $Id$
+#
+# Copyright (c) 2004 Dirk Koopman G1TLH
+#
+
+package Thingy::Route;
+
+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,0));
+$main::build += $VERSION;
+$main::branch += $BRANCH;
+
+use vars qw(@ISA);
+
+@ISA = qw(Thingy);
+
+# this is node connect 
+sub new_node_connect
+{
+       my $pkg = shift;
+       my $fromnode = shift;
+       my $inon = shift;
+       my $msgid = shift;
+       my $t = $pkg->SUPER::new(_fromnode=>$fromnode, _msgid=>$msgid, 
+                                                        _inon=>$inon,
+                                                        t=>'nc', n=>join('|', @_));
+       return $t;
+}
+
+# this is node disconnect 
+sub new_node_disconnect
+{
+       my $pkg = shift;
+       my $fromnode = shift;
+       my $inon = shift;
+       my $msgid = shift;
+       my $t = $pkg->SUPER::new(_fromnode=>$fromnode, _msgid=>$msgid, 
+                                                        _inon=>$inon,
+                                                        t=>'nd', n=>join('|', @_));
+       return $t;
+}
+
+# a full node update
+sub new_node_update
+{
+       my $pkg = shift;
+       my $msgid = shift;
+       
+       my @nodes = grep {$_ ne $main::mycall} DXChannel::get_all_node_calls();
+       my @users = DXChannel::get_all_user_calls();
+       
+       my $t = $pkg->SUPER::new(_msgid=>$msgid, t=>'nu', 
+                                                        id=>"DXSpider $main::version $main::build", 
+                                                        n=>join('|', @nodes), u=>join('|', @users));
+       return $t;
+}
+
+sub normal
+{
+
+}
index 68f40e1aa83eff76c8b11aad87c49cb7a00718be..6833f929b743477229ff0846a7794dcfbc465171 100755 (executable)
@@ -118,7 +118,7 @@ use vars qw(@inqueue $systime $version $starttime $lockfn @outstanding_connects
 
 @inqueue = ();                                 # the main input queue, an array of hashes
 $systime = 0;                                  # the time now (in seconds)
-$version = "1.51";                             # the version no of the software
+$version = "2.00";                             # the version no of the software
 $starttime = 0;                 # the starting time of the cluster   
 #@outstanding_connects = ();     # list of outstanding connects
 @listeners = ();                               # list of listeners
@@ -397,7 +397,6 @@ foreach (@debug) {
 STDOUT->autoflush(1);
 
 # calculate build number
-$build += $main::version;
 $build = "$build.$branch" if $branch;
 
 Log('cluster', "DXSpider V$version, build $build started");