X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FQXProt.pm;h=689432d017bc4f54e2e019e97e8e6923f0235eea;hb=refs%2Fremotes%2Fserver%2Fspider2;hp=82cb2075d8f8196edf32524b048b96dbc7ca445c;hpb=74803d3f4937220f536cd67b515faa15da6e0520;p=spider.git diff --git a/perl/QXProt.pm b/perl/QXProt.pm index 82cb2075..689432d0 100644 --- a/perl/QXProt.pm +++ b/perl/QXProt.pm @@ -30,19 +30,20 @@ use Route::Node; use Script; use DXProt; use Verify; +use 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)); +$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/,(0,0)); $main::build += $VERSION; $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,7 @@ sub sendinit { my $self = shift; - $self->send($self->genI); + $self->node_update; } sub normal @@ -76,54 +77,49 @@ 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; + + for (split /;/, $rest) { + next if /^_/; + next unless /^\w+=/; + s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg; + push @par, split(/=/,$_,2); + } + + no strict 'refs'; + my $pkg = 'Thingy::' . lcfirst $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->queue 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,107 +127,64 @@ sub process sub disconnect { my $self = shift; + my $t = Thingy::Route->new_node_disconnect($main::mycall, $main::mycall, $self->{call}); + $t->queue; $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]; - 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; - } - 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(); + $t->queue if $t; } -sub genI -{ - my $self = shift; - my $inp = Verify->new; - return frame('I', $self->call, "DXSpider", ($main::version + 53) * 100, $main::build, $inp->challenge, $inp->response($self->user->passphrase, $self->call, $main::mycall)); -} - -sub handleR -{ - -} - -sub genR -{ - -} - -sub handleP -{ - -} - -sub genP -{ - -} - -sub gen2 +sub t_send { my $self = shift; + my $t = shift; + confess('$t is not a Thingy') unless $t->isa('Thingy'); - 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"; + # manufacture the protocol line if required + unless (exists $t->{_newprot}) { + my ($class) = ref $self =~ /::(\w+)$/; + unless (exists $t->{_rest}) { + $t->{_rest} = ""; + while (my ($k,$v) = each %$t) { + next if $k =~ /^_/; + if (ref $v && @$v) { + my $val = ""; + for(@$v) { + my $vv = $_; + $vv =~ s/([\%;=,\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg; + $val .= $vv . ','; + } + if (length $val) { + chop $val; + $t->{_rest} .= "$k=$val;"; + } + } elsif (length $v) { + $v =~ s/([\%;=\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg; + $t->{_rest} .= "$k=$v;"; + } } + chop $t->{_rest} if length $t->{_rest}; } - push @out, $str if $str; + + $t->{_hoptime} ||= 1; + $t->{_msgid} = nextmsgid() unless $t->{_msgid}; + $t->{_newprot} = join(';', $t->{_tonode}, $t->{_fromnode}, uc $class, + $t->{_msgid}, $t->{_hoptime}) . '|' . $t->{_rest}; } - 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; + $self->SUPER::send($t->{_newprot}); } 1;