From: minima Date: Fri, 2 Jan 2004 00:41:21 +0000 (+0000) Subject: start with routing X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=commitdiff_plain;h=048adf1eb39f866e0968e1443fb7307ec5fdc4a6;p=spider.git start with routing --- diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 3b3ac62f..536e7bb3 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -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 { diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 8f46826a..67869dd5 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -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"; diff --git a/perl/QXProt.pm b/perl/QXProt.pm index b9cf952c..43dbb03f 100644 --- a/perl/QXProt.pm +++ b/perl/QXProt.pm @@ -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; diff --git a/perl/Thingy.pm b/perl/Thingy.pm index 885e7f0f..87ee391a 100644 --- a/perl/Thingy.pm +++ b/perl/Thingy.pm @@ -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 index 00000000..ccdb53fe --- /dev/null +++ b/perl/Thingy/Route.pm @@ -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 +{ + +} diff --git a/perl/cluster.pl b/perl/cluster.pl index 68f40e1a..6833f929 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -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");