X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;ds=sidebyside;f=perl%2FAranea.pm;h=308160203fbad7651fc2c90c6cc1d181b33b98d9;hb=89e4fd14125a1eb60cfd9ad2938614083ddaeb67;hp=bbe24bbd5194e7cd9c565cf9dfb5318564377601;hpb=393e17fd3a08dd94596f1c02d4d20f6f9a44954f;p=spider.git diff --git a/perl/Aranea.pm b/perl/Aranea.pm index bbe24bbd..30816020 100644 --- a/perl/Aranea.pm +++ b/perl/Aranea.pm @@ -152,9 +152,12 @@ sub disconnect my $call = $self->call; return if $self->{disconnecting}++; - + + my $thing = Thingy::Bye->new(origin=>$main::mycall, user=>$call); + $thing->process($self); + # get rid of any PC16/17/19 -# eph_del_regex("^PC1[679]*$call"); + DXProt::eph_del_regex("^PC1[679]*$call"); # do routing stuff, remove me from routing table my $node = Route::Node::get($call); @@ -165,7 +168,7 @@ sub disconnect # and all my ephemera as well for (@rout) { my $c = $_->call; -# eph_del_regex("^PC1[679].*$c"); + DXProt::eph_del_regex("^PC1[679].*$c"); } } @@ -197,6 +200,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,9 +224,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 .= ",$from" if $from; + my $r = formathead($mycall, sprintf('%6X%04X', $date, $seqno), 0, $from, $to); $seqno++; $seqno = 0 if $seqno > 0x0ffff; return $r; @@ -284,7 +302,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; @@ -312,9 +330,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 @@ -325,15 +341,17 @@ sub input $thing->{user} = $user if $user; $thing->{hopsaway} = $hop; - for (split(/,/, $rdata)) { - if (/=/) { - my ($k,$v) = split /=/, $_, 2; - $thing->{$k} = tdecode($v); - } else { - $thing->{$_} = 1; + if ($rdata) { + for (split(/,/, $rdata)) { + if (/=/) { + my ($k,$v) = split /=/, $_, 2; + $thing->{$k} = tdecode($v); + } else { + $thing->{$_} = 1; + } } } - + # post process the thing, this generally adds on semantic meaning # does parameter checking etc. It also adds / prepares the thingy so # this is compatible with older protocol and arranges data so