From 87b2f58b1b0df6c0cb5c5f0070db554ec2d2a961 Mon Sep 17 00:00:00 2001 From: minima Date: Sat, 19 Feb 2005 17:39:55 +0000 Subject: [PATCH] added more routing code --- perl/Aranea.pm | 28 ++++++++---- perl/DXUser.pm | 6 +++ perl/Thingy.pm | 10 ++--- perl/Thingy/Hello.pm | 27 +++++++++++- perl/Thingy/Rt.pm | 101 ++++++++++++++++++++++++------------------- 5 files changed, 113 insertions(+), 59 deletions(-) diff --git a/perl/Aranea.pm b/perl/Aranea.pm index 7f0134c3..f4d9a1ec 100644 --- a/perl/Aranea.pm +++ b/perl/Aranea.pm @@ -197,6 +197,23 @@ sub disconnect # because it has to be used before a channel is fully initialised). # +sub formathead +{ + my $mycall = shift; + my $dts = shift; + my $hop = shift; + my $user = shift; + my $group = shift; + + my $s = "$mycall,$dts,$hop"; + $s .= ",$user" if $user; + if ($group) { + $s .= "," unless $user; + $s .= ",$group" if $group; + } + return $s; +} + sub genheader { my $mycall = shift; @@ -204,10 +221,7 @@ sub genheader my $from = shift; my $date = ((($dayno << 1) | $ntpflag) << 18) | ($main::systime % 86400); - my $r = "$mycall," . sprintf('%6X%04X,0', $date, $seqno); - $r .= ",$to" if $to; - $r .= "," if $from && !$to; - $r .= ",$from" if $from; + my $r = formathead($mycall, sprintf('%6X%04X', $date, $seqno), 0, $from, $to); $seqno++; $seqno = 0 if $seqno > 0x0ffff; return $r; @@ -285,7 +299,7 @@ sub input my ($head, $data) = split /\|/, $line, 2; return unless $head && $data; - my ($origin, $dts, $hop, $group, $user) = split /,/, $head; + my ($origin, $dts, $hop, $user, $group) = split /,/, $head; return if DXDupe::check("Ara,$origin,$dts", $dupeage); my $err; $err .= "incomplete header," unless $origin && $dts && defined $hop; @@ -313,9 +327,7 @@ sub input $thing = $class->new(); # reconstitute the header but wth hop increased by one - $head = join(',', $origin, $dts, ++$hop); - $head .= ",$group" if $group; - $head .= ",$user" if $user; + $head = formathead($origin, $dts, ++$hop, $user, $group); $thing->{Aranea} = "$head|$data"; # store useful data diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 62f26290..d2a0a12a 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -726,6 +726,12 @@ sub is_node return $self->{sort} =~ /[ACRSX]/; } +sub is_aranea +{ + my $self = shift; + return $self->{sort} eq 'W'; +} + sub is_user { my $self = shift; diff --git a/perl/Thingy.pm b/perl/Thingy.pm index 7bbf3edb..ed33fde0 100644 --- a/perl/Thingy.pm +++ b/perl/Thingy.pm @@ -65,15 +65,13 @@ sub send } # generate the line which may (or not) be cached - my @out; - if (my $ref = $thing->{class}) { - push @out, ref $ref ? @$ref : $ref; - } else { + my $ref; + unless ($ref = $thing->{class}) { no strict 'refs'; my $sub = "gen_$class"; - push @out, $thing->$sub($dxchan) if $thing->can($sub); + $ref = $thing->$sub($dxchan) if $thing->can($sub); } - $dxchan->send(@out) if @out; + $dxchan->send(ref $ref ? @$ref : $ref) if $ref; } # broadcast to all except @_ diff --git a/perl/Thingy/Hello.pm b/perl/Thingy/Hello.pm index 9c1e3080..c098ca94 100644 --- a/perl/Thingy/Hello.pm +++ b/perl/Thingy/Hello.pm @@ -49,7 +49,9 @@ sub handle my $dxchan = shift; # verify authenticity - if ($dxchan->call eq $thing->{origin}) { + if ($dxchan->{call} eq $thing->{origin}) { + + # for directly connected calls if ($verify_on_login) { my $pp = $dxchan->user->passphrase; unless ($pp) { @@ -71,7 +73,30 @@ sub handle $thing->send($dxchan); } } + } else { + + # for otherwise connected calls, that come in relayed from other nodes + # note that we cannot do any connections at this point + my $nref = Route::Node::get($thing->{origin}); + unless ($nref) { + my $v = $thing->{user} ? undef : $thing->{v}; + $nref = Route::Node->new($thing->{origin}, $v, 1); + } + if (my $user = $thing->{user}) { + my $ur = Route::get($user); + unless ($ur) { + my $uref = DXUser->get_current($user); + if ($uref->is_node || $uref->is_aranea) { + $nref->add($user, $thing->{v}, 1); + } else { + $nref->add_user($user, 1); + } + } + } } + RouteDB::update($thing->{origin}, $dxchan->{call}, $thing->{hopsaway}); + RouteDB::update($thing->{user}, $dxchan->{call}, $thing->{hopsaway}) if $thing->{user}; + $thing->broadcast($dxchan); } diff --git a/perl/Thingy/Rt.pm b/perl/Thingy/Rt.pm index 7f407235..f7c503ac 100644 --- a/perl/Thingy/Rt.pm +++ b/perl/Thingy/Rt.pm @@ -28,8 +28,10 @@ sub gen_Aranea my $thing = shift; unless ($thing->{Aranea}) { my @items; - push @items, 't', $thing->{t} if $thing->{t}; - push @items, 'd', $thing->{d} if $thing->{d}; + push @items, 's', $thing->{'s'} if $thing->{'s'}; + push @items, 'n', $thing->{n} if $thing->{n}; + push @items, 'v', $thing->{v} if $thing->{v}; + push @items, 'u', $thing->{u} if $thing->{u}; $thing->{Aranea} = Aranea::genmsg($thing, 'RT', @items) if @items; } return $thing->{Aranea}; @@ -46,6 +48,33 @@ sub gen_DXProt { my $thing = shift; my $dxchan = shift; + my $s = $thing->{'s'}; + if ($s eq 'au') { + my $n = $thing->{n} || $thing->{user}; + my @out; + if ($n && (my $u = $thing->{u})) { + my $s = ''; + for (split /:/, $u) { + my ($here, $call) = unpack "A1 A*", $_; + my $str = sprintf "^%s * %d", $call, $here; + if (length($s) + length($str) > $DXProt::sentencelth) { + push @out, "PC16^$n" . $s . sprintf "^%s^", DXProt::get_hops(16); + $s = ''; + } + $s .= $str; + } + push @out, "PC16^$n" . $s . sprintf "^%s^", DXProt::get_hops(16); + $thing->{DXProt} = @out > 1 ? \@out : $out[0]; + } + } elsif ($s eq 'du') { + my $n = $thing->{n} || $thing->{user}; + my $hops = DXProt::get_hops(17); + if ($n && (my $u = $thing->{u})) { + $thing->{DXProt} = "PC17^$u^$n^$hops^"; + } + } elsif ($s eq 'an') { + } elsif ($s eq 'dn') { + } return $thing->{DXProt}; } @@ -85,74 +114,58 @@ sub handle } } -sub handle_eau +# these contain users and either a node (for externals) or the from address +sub handle_au { my $thing = shift; my $dxchan = shift; - if (my $d = $thing->{d}) { - my $nref; - for (split /:/, $d) { - my ($type, $here, $call) = unpack "A1 A1 A*", $_; - if ($type eq 'U') { - unless ($nref) { - dbg("Thingy::Rt::ea need a node before $call"); - return; - } + my $node = $thing->{n} || $thing->{user}; + my $nref = Route::Node::get($node); + + if ($nref) { + if (my $u = $thing->{u}) { + for (split /:/, $u) { + my ($here, $call) = unpack "A1 A*", $_; add_user($nref, $call, $here); my $h = $dxchan->{call} eq $nref->{call} ? 3 : ($thing->{hops} || 99); RouteDB::update($call, $dxchan->{call}, $h); - } elsif ($type eq 'N') { - $nref = Route::Node::get($call); - unless ($nref) { - dbg("Thingy::Rt::ea need a definition for $call"); - return; - } - my $h = $dxchan->{call} eq $nref->{call} ? 2 : ($thing->{hops} || 99); - RouteDB::update($nref->{call}, $dxchan->{call}, $h); - } else { - dbg("Thingy::Rt::ea invalid type $type"); - return; } } + } else { + dbg("Thingy::Rt::au: $node not found") if isdbg('chanerr'); + return; } return $thing; } -sub handle_edu +sub handle_du { my $thing = shift; my $dxchan = shift; - if (my $d = $thing->{d}) { - my $nref; - for (split /:/, $d) { - my ($type, $here, $call) = unpack "A1 A1 A*", $_; - if ($type eq 'U') { - unless ($nref) { - dbg("Thingy::Rt::edu need a node before $call"); - return; - } + my $node = $thing->{n} || $thing->{user}; + my $nref = Route::Node::get($node); + + if ($nref) { + if (my $u = $thing->{u}) { + for (split /:/, $u) { + my ($here, $call) = unpack "A1 A*", $_; my $uref = Route::User::get($call); unless ($uref) { - dbg("Thingy::Rt::edu $call not a user") if isdbg('chanerr'); + dbg("Thingy::Rt::du $call not a user") if isdbg('chanerr'); next; } $nref->del_user($uref); RouteDB::delete($call, $dxchan->{call}); - } elsif ($type eq 'N') { - $nref = Route::Node::get($call); - unless ($nref) { - dbg("Thingy::Rt::ed need a definition for $call"); - return; - } - RouteDB::update($nref->{call}, $dxchan->{call}, $dxchan->{call} eq $nref->{call} ? 2 : ($thing->{hops} || 99)); - } else { - dbg("Thingy::Rt::ed invalid type $type"); - return; } + RouteDB::update($nref->{call}, $dxchan->{call}, $dxchan->{call} eq $nref->{call} ? 2 : ($thing->{hops} || 99)); } + } else { + dbg("Thingy::Rt::du: $node not found") if isdbg('chanerr'); + return; } + return $thing; } -- 2.43.0