From: minima Date: Sun, 13 Feb 2005 23:36:01 +0000 (+0000) Subject: a nominially working aranea with DX commands converted X-Git-Tag: R_1_52~203 X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=5b3c2c5e342c23fbab96b7573c5963344617878f;p=spider.git a nominially working aranea with DX commands converted --- diff --git a/cmd/connect.pl b/cmd/connect.pl index d1c583cb..1f1ad03f 100644 --- a/cmd/connect.pl +++ b/cmd/connect.pl @@ -16,7 +16,16 @@ return (1, $self->msg('lockout', $call)) if $user && $user->lockout; my @out; push @out, $self->msg('constart', $call); -ExtMsg::start_connect($call, "$main::root/connect/$lccall"); +my $fn = "$main::root/connect/$lccall"; + +my $f = new IO::File $fn; +if ($f) { + my @f = <$f>; + $f->close; + ExtMsg::start_connect($call, @f); +} else { + push @out, $self->msg('e3', 'connect', $fn); +} return (1, @out); diff --git a/cmd/dx.pl b/cmd/dx.pl index 02fc3ca4..9a9aff71 100644 --- a/cmd/dx.pl +++ b/cmd/dx.pl @@ -104,8 +104,9 @@ return (1, @out) unless $valid; # Store it here (but only if it isn't baddx) my $t = (int ($main::systime/60)) * 60; -return (1, $self->msg('dup')) if Spot::dup($freq, $spotted, $t, $line, $spotter); my @spot = Spot::prepare($freq, $spotted, $t, $line, $spotter, $main::mycall); +my $thing = Thingy::Dx->new(origin=>$main::mycall, group=>'DX', user=>$spotter); +$thing->from_DXProt(spotdata=>\@spot); if ($DXProt::baddx->in($spotted) || $freq =~ /^69/ || $localonly) { @@ -113,19 +114,10 @@ if ($DXProt::baddx->in($spotted) || $freq =~ /^69/ || $localonly) { if ($freq =~ /^69/) { $self->badcount(($self->badcount||0) + 1); } - - $self->dx_spot(undef, undef, @spot); - return (1); } else { - if (@spot) { - # store it - Spot::add(@spot); - - # send orf to the users - DXProt::send_dx_spot($self, DXProt::pc11($spotter, $freq, $spotted, $line), @spot); - } + $thing->queue($self); } - +push @out, $thing->gen_DXCommandmode($self); return (1, @out); diff --git a/cmd/show/connect.pl b/cmd/show/connect.pl index 98211ddf..23b2620b 100644 --- a/cmd/show/connect.pl +++ b/cmd/show/connect.pl @@ -18,8 +18,9 @@ foreach my $call (sort keys %Msg::conns) { my $c = $call; my $addr; - if ($c =~ /^Server\s+(\S+)$/) { + if ($c =~ /^Server\s+(.*)$/) { $addr = $1; + $addr =~ s/\s+using.*$//; $c = "Server"; } else { $addr = "$r->{peerhost}/$r->{peerport}"; diff --git a/cmd/who.pl b/cmd/who.pl index 12010d81..3b12fd0e 100644 --- a/cmd/who.pl +++ b/cmd/who.pl @@ -19,13 +19,13 @@ foreach $dxchan ( sort {$a->call cmp $b->call} DXChannel::get_all ) { my $type = $dxchan->is_node ? "NODE" : "USER"; my $sort = " "; if ($dxchan->is_node) { - $sort = 'ANEA' if $dxchan->is_aranea; $sort = "DXSP" if $dxchan->is_spider; $sort = "CLX " if $dxchan->is_clx; $sort = "DXNT" if $dxchan->is_dxnet; $sort = "AR-C" if $dxchan->is_arcluster; $sort = "AK1A" if $dxchan->is_ak1a; } + $type = 'ANEA' if $dxchan->is_aranea; my $name = $dxchan->user->name || " "; my $ping = $dxchan->is_node && $dxchan != $main::me ? sprintf("%5.2f", $dxchan->pingave) : " "; my $conn = $dxchan->conn; diff --git a/perl/AMsg.pm b/perl/AMsg.pm index 19fe9208..6a178322 100644 --- a/perl/AMsg.pm +++ b/perl/AMsg.pm @@ -54,7 +54,7 @@ sub dequeue } } if ($conn->{state} eq 'WC' && exists $conn->{cmd} && @{$conn->{cmd}} == 0) { - $conn->to_connected($conn->{call}, 'O', $conn->{csort}); + $conn->{state} = 'WH'; } } elsif ($conn->{msg} =~ /\cJ/) { my @lines = $conn->{msg} =~ /([^\cM\cJ]*)\cM?\cJ/g; @@ -67,23 +67,19 @@ sub dequeue dbg("connect $conn->{cnum}: $msg") if $conn->{state} ne 'C' && isdbg('connect'); if ($conn->{state} eq 'C') { &{$conn->{rproc}}($conn, $msg); - } elsif ($conn->{state} eq 'WA' ) { - my $uref = DXUser->get_current($conn->{call}); + } elsif ($conn->{state} eq 'WH' ) { + # this is the first stage that we have a callsign + # do we have a hello? $msg =~ s/[\r\n]+$//; - if ($uref && $msg eq $uref->passwd) { - my $sort = $conn->{csort}; - $sort = 'local' if $conn->{peerhost} eq "127.0.0.1"; - $conn->{usedpasswd} = 1; - $conn->to_connected($conn->{call}, 'A', $sort); - } else { - $conn->send_now("Sorry"); - $conn->disconnect; + if ($msg =~ m{ROUTE,[0-9A-F,]+|HELLO}) { + # a possibly valid HELLO line, process it + $conn->new_channel($msg); } } elsif ($conn->{state} eq 'WC') { if (exists $conn->{cmd} && @{$conn->{cmd}}) { $conn->_docmd($msg); if ($conn->{state} eq 'WC' && exists $conn->{cmd} && @{$conn->{cmd}} == 0) { - $conn->to_connected($conn->{call}, 'O', $conn->{csort}); + $conn->{state} = 'WH'; } } } @@ -91,18 +87,6 @@ sub dequeue } } -sub to_connected -{ - my ($conn, $call, $dir, $sort) = @_; - $conn->{state} = 'C'; - $conn->conns($call); - delete $conn->{cmd}; - $conn->{timeout}->del if $conn->{timeout}; - delete $conn->{timeout}; - $conn->nolinger; - &{$conn->{rproc}}($conn, "$dir$call|$sort"); -} - sub login { return \&new_channel; @@ -141,30 +125,23 @@ sub new_client { $conn->disconnect(); } Log('Aranea', "Incoming connection from $conn->{peerhost}"); - $conn->{outgoing} = 0; + $conn->{outbound} = 0; $conn->{state} = 'WH'; # wait for return authorize my $thing = $conn->{lastthing} = Thingy::Hello->new(origin=>$main::mycall, group=>'ROUTE'); + $thing->send($conn, 'Aranea'); + dbg("-> D $conn->{peerhost} $thing->{Aranea}") if isdbg('chan'); } } else { dbg("ExtMsg: error on accept ($!)") if isdbg('err'); } } -sub start_connect +sub set_newchannel_rproc { - my $call = shift; - my $fn = shift; - my $conn = AMsg->new(\&new_channel); - $conn->{outgoing} = 1; - $conn->conns($call); - - my $f = new IO::File $fn; - push @{$conn->{cmd}}, <$f>; - $f->close; - $conn->{state} = 'WC'; - $conn->_dotimeout($deftimeout); - $conn->_docmd; + my $conn = shift; + $conn->{rproc} = \&new_channel; + $conn->{state} = 'WH'; } # @@ -174,10 +151,19 @@ sub start_connect sub new_channel { my ($conn, $msg) = @_; + my $call = $conn->{call} || $conn->{peerhost}; + + dbg("<- I $call $msg") if isdbg('chan'); + my $thing = Aranea::input($msg); - return unless defined $thing; + unless ($thing) { + dbg("Invalid thingy: $msg from $conn->{peerhost}"); + $conn->send_now("Sorry"); + $conn->disconnect; + return; + } - my $call = $thing->{origin}; + $call = $thing->{origin}; unless (is_callsign($call)) { main::already_conn($conn, $call, DXM::msg($main::lang, "illcall", $call)); return; @@ -188,7 +174,7 @@ sub new_channel my $user = DXUser->get_current($call); my $dxchan = DXChannel->get($call); if ($dxchan) { - if ($main::bumpexisting) { + if ($main::bumpexisting && $call ne $main::mycall) { my $ip = $conn->{peerhost} || 'unknown'; $dxchan->send_now('D', DXM::msg($main::lang, 'conbump', $call, $ip)); Log('DXCommand', "$call bumped off by $ip, disconnected"); @@ -224,12 +210,17 @@ sub new_channel $dxchan = Aranea->new($call, $conn, $user); # check that the conn has a callsign - $conn->conns($call) if $conn->isa('IntMsg'); + $conn->conns($call); # set callbacks $conn->set_error(sub {main::error_handler($dxchan)}); $conn->set_rproc(sub {my ($conn,$msg) = @_; $dxchan->rec($msg)}); - $dxchan->rec($msg); + $conn->{state} = 'C'; + delete $conn->{cmd}; + $conn->{timeout}->del if $conn->{timeout}; + delete $conn->{timeout}; + $conn->nolinger; + $thing->handle($dxchan); } sub send diff --git a/perl/Aranea.pm b/perl/Aranea.pm index 1d0a912f..3af3aee9 100644 --- a/perl/Aranea.pm +++ b/perl/Aranea.pm @@ -24,6 +24,7 @@ use Route::Node; use Script; use Verify; use DXDupe; +use Thingy; use vars qw($VERSION $BRANCH); $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); @@ -40,6 +41,7 @@ $dupeage = 12*60*60; # duplicates stored half a day my $seqno = 0; my $dayno = 0; +my $daystart = 0; sub init { @@ -109,7 +111,7 @@ sub start $self->{metric} ||= 100; $self->{lastping} = $main::systime; - $self->state('init'); + $self->state('normal'); $self->{pc50_t} = $main::systime; # send info to all logged in thingies @@ -118,7 +120,6 @@ sub start # run a script send the output to the debug file my $script = new Script(lc $call) || new Script('node_default'); $script->run($self) if $script; - $self->send("Hello?"); } # @@ -127,8 +128,8 @@ sub start sub normal { my ($self, $line) = @_; - - + my $thing = input($line); + $thing->queue($self) if $thing; } # @@ -139,7 +140,57 @@ sub process { # calc day number - $dayno = (gmtime($main::systime))[3]; + my $d = (gmtime($main::systime))[3]; + if ($d != $dayno) { + $dayno = $d; + $daystart = $main::systime - ($main::systime % 86400); + } +} + +sub disconnect +{ + my $self = shift; + my $call = $self->call; + + return if $self->{disconnecting}++; + + # get rid of any PC16/17/19 +# eph_del_regex("^PC1[679]*$call"); + + # do routing stuff, remove me from routing table + my $node = Route::Node::get($call); + my @rout; + if ($node) { + @rout = $node->del($main::routeroot); + + # and all my ephemera as well + for (@rout) { + my $c = $_->call; +# eph_del_regex("^PC1[679].*$c"); + } + } + + RouteDB::delete_interface($call); + + # unbusy and stop and outgoing mail + my $mref = DXMsg::get_busy($call); + $mref->stop_msg($call) if $mref; + + # broadcast to all other nodes that all the nodes connected to via me are gone +# $self->route_pc21($main::mycall, undef, @rout) if @rout; + + # remove outstanding pings +# delete $pings{$call}; + + # I was the last node visited + $self->user->node($main::mycall); + + # send info to all logged in thingies + $self->tell_login('logoutn'); + + Log('Aranea', $call . " Disconnected"); + + $self->SUPER::disconnect; } # @@ -154,24 +205,49 @@ sub genheader my $from = shift; my $date = ((($dayno << 1) | $ntpflag) << 18) | ($main::systime % 86400); - my $r = "$mycall,$to," . sprintf('%06X%04X,0', $date, $seqno); + my $r = "$mycall,$to," . sprintf('%6X%04X,0', $date, $seqno); $r .= ",$from" if $from; $seqno++; $seqno = 0 if $seqno > 0x0ffff; return $r; } +# +# decode the date time sequence group +# + +sub decode_dts +{ + my $dts = shift; + my ($dt, $seqno) = map {hex} unpack "H6H4", $dts; + my $secs = $dt & 0x3FFFF; + $dt >>= 18; + my $day = $dt >> 1; + my $ntp = $dt & 1; + my $t; + if ($dayno == $day) { + $t = $daystart + $secs; + } elsif ($dayno < $day) { + $t = $daystart + (($day-$dayno) * 86400) + $secs; + } else { + $t = $daystart + (($dayno-$day) * 86400) + $secs; + } + return ($t, $seqno, $ntp); +} + # subroutines to encode and decode values in lists sub tencode { my $s = shift; - $s =~ s/([\%=|,\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg; + $s =~ s/([\%=|,\'\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg; + $s = "'$s'" if $s =~ / /; return $s; } sub tdecode { my $s = shift; + $s =~ s/^'(.*)'$/$1/; $s =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg; return $s; } @@ -194,39 +270,167 @@ sub genmsg return "$head|$data"; } + +sub decode_input +{ + my $self = shift; + my $line = shift; + return ('I', $self->{call}, $line); +} + sub input { my $line = shift; my ($head, $data) = split /\|/, $line, 2; return unless $head && $data; + my ($origin, $group, $dts, $hop, $user) = split /,/, $head; - return if DXDupe::add("Ara,$origin,$dts", $dupeage); - $hop++; + return if DXDupe::check("Ara,$origin,$dts", $dupeage); + my $err; + $err .= "incomplete header," unless $origin && defined $group && $dts && defined $hop; my ($cmd, $rdata) = split /,/, $data, 2; - my $class = 'Thingy::' . ucfirst $cmd; + + # validate it further + $err .= "missing cmd or data," unless $cmd && $data; + $err .= "invalid command ($cmd)," unless $cmd =~ /^[A-Z][A-Z0-9]*$/; + $err .= "invalid group ($group)," unless $group =~ /^[-A-Z0-9\/:]{2,}$/; + + my $class = 'Thingy::' . ucfirst(lc $cmd); my $thing; + my ($t, $seqno, $ntp) = decode_dts($dts) unless $err; + $err .= "invalid date/seq," unless $t; - # create the appropriate Thingy - if (defined *$class) { + if ($err) { + chop $err; + dbg("Aranea input: $err"); + } elsif ($class->can('new')) { + # create the appropriate Thingy $thing = $class->new(); # reconstitute the header but wth hop increased by one - $head = join(',', $origin, $group, $dts, $hop); + $head = join(',', $origin, $group, $dts, ++$hop); $head .= ",$user" if $user; $thing->{Aranea} = "$head|$data"; # store useful data $thing->{origin} = $origin; - $thing->{group} = $group; - $thing->{time} = decode_dts($dts); + ($thing->{group}, $thing->{touser}) = split /:/, $group, 2; + $thing->{time} = $t; $thing->{user} = $user if $user; $thing->{hopsaway} = $hop; - while (my ($k,$v) = split /,/, $rdata) { - $thing->{$k} = tdecode($v); + 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 + # that the filtering can still work. + if ($thing->can('from_Aranea')) { + + # if a thing is ok then return that thing, otherwise return + # nothing + $thing = $thing->from_Aranea; } } return $thing; } +# this is the DXChannel send +# note that this does NOT send out stuff in same way as other DXChannels +# it is just as it comes, no extra bits added (here) +sub send # this is always later and always data +{ + my $self = shift; + my $conn = $self->{conn}; + return unless $conn; + my $call = $self->{call}; + + for (@_) { +# chomp; + my @lines = split /\n/; + for (@lines) { + $conn->send_later($_); + dbg("-> D $call $_") if isdbg('chan'); + } + } + $self->{t} = $main::systime; +} + +# +# load of dummies for DXChannel broadcasts +# these will go away in time? +# These are all from PC protocol +# + +sub dx_spot +{ + my $self = shift; + my $line = shift; + my $isolate = shift; + my ($filter, $hops); + + if ($self->{spotsfilter}) { + ($filter, $hops) = $self->{spotsfilter}->it(@_); + return unless $filter; + } +# send_prot_line($self, $filter, $hops, $isolate, $line); +} + +sub wwv +{ + my $self = shift; + my $line = shift; + my $isolate = shift; + my ($filter, $hops); + + if ($self->{wwvfilter}) { + ($filter, $hops) = $self->{wwvfilter}->it(@_); + return unless $filter; + } +# send_prot_line($self, $filter, $hops, $isolate, $line) +} + +sub wcy +{ + my $self = shift; + my $line = shift; + my $isolate = shift; + my ($filter, $hops); + + if ($self->{wcyfilter}) { + ($filter, $hops) = $self->{wcyfilter}->it(@_); + return unless $filter; + } +# send_prot_line($self, $filter, $hops, $isolate, $line) if $self->is_clx || $self->is_spider || $self->is_dxnet; +} + +sub announce +{ + my $self = shift; + my $line = shift; + my $isolate = shift; + my $to = shift; + my $target = shift; + my $text = shift; + my ($filter, $hops); + + if ($self->{annfilter}) { + ($filter, $hops) = $self->{annfilter}->it(@_); + return unless $filter; + } +# send_prot_line($self, $filter, $hops, $isolate, $line) unless $_[1] eq $main::mycall; +} + +sub chat +{ + goto &announce; +} + 1; diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index acd4245c..69654429 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -266,7 +266,7 @@ sub is_bbs sub is_node { my $self = shift; - return $self->{'sort'} =~ /[ACRSXW]/; + return $self->{'sort'} =~ /[ACRSX]/; } # is it an ak1a node ? sub is_ak1a diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index debc23d2..276b346b 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -35,6 +35,8 @@ use Net::Telnet; use QSL; use DB_File; use VE7CC; +use Thingy; +use Thingy::Dx; use strict; use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase $maxerrors %nothereslug $maxbadcount $msgpolltime); @@ -847,14 +849,15 @@ sub chat sub format_dx_spot { my $self = shift; - - my $t = ztime($_[2]); + my $spot = ref $_[0] ? shift : \@_; + + my $t = ztime($spot->[2]); my $loc = ''; my $clth = $self->{consort} eq 'local' ? 29 : 30; - my $comment = substr $_[3], 0, $clth; + my $comment = substr $spot->[3], 0, $clth; $comment .= ' ' x ($clth - length($comment)); if ($self->{user}->wantgrid) { - my $ref = DXUser->get_current($_[4]); + my $ref = DXUser->get_current($spot->[4]); if ($ref) { $loc = $ref->qra || ''; $loc = ' ' . substr($loc, 0, 4) if $loc; @@ -862,17 +865,17 @@ sub format_dx_spot } if ($self->{user}->wantdxitu) { - $loc = ' ' . sprintf("%2d", $_[10]) if defined $_[10]; - $comment = substr($comment, 0, $self->{consort} eq 'local' ? 26 : 27) . ' ' . sprintf("%2d", $_[8]) if defined $_[8]; + $loc = ' ' . sprintf("%2d", $spot->[10]) if defined $spot->[10]; + $comment = substr($comment, 0, $self->{consort} eq 'local' ? 26 : 27) . ' ' . sprintf("%2d", $spot->[8]) if defined $spot->[8]; } elsif ($self->{user}->wantdxcq) { - $loc = ' ' . sprintf("%2d", $_[11]) if defined $_[11]; - $comment = substr($comment, 0, $self->{consort} eq 'local' ? 26 : 27) . ' ' . sprintf("%2d", $_[9]) if defined $_[9]; + $loc = ' ' . sprintf("%2d", $spot->[11]) if defined $spot->[11]; + $comment = substr($comment, 0, $self->{consort} eq 'local' ? 26 : 27) . ' ' . sprintf("%2d", $spot->[9]) if defined $spot->[9]; } elsif ($self->{user}->wantusstate) { - $loc = ' ' . $_[13] if $_[13]; - $comment = substr($comment, 0, $self->{consort} eq 'local' ? 26 : 27) . ' ' . $_[12] if $_[12]; + $loc = ' ' . $spot->[13] if $spot->[13]; + $comment = substr($comment, 0, $self->{consort} eq 'local' ? 26 : 27) . ' ' . $spot->[12] if $spot->[12]; } - return sprintf "DX de %-7.7s%11.1f %-12.12s %-s $t$loc", "$_[4]:", $_[0], $_[1], $comment; + return sprintf "DX de %-7.7s%11.1f %-12.12s %-s $t$loc", "$spot->[4]:", $spot->[0], $spot->[1], $comment; } # send a dx spot diff --git a/perl/DXDebug.pm b/perl/DXDebug.pm index 416dea0a..30fe2b25 100644 --- a/perl/DXDebug.pm +++ b/perl/DXDebug.pm @@ -11,7 +11,7 @@ package DXDebug; require Exporter; @ISA = qw(Exporter); -@EXPORT = qw(dbginit dbg dbgadd dbgsub dbglist dbgdump isdbg dbgclose confess croak cluck); +@EXPORT = qw(dbginit dbg dbgadd dbgsub dbglist dbgdump dbglog isdbg dbgclose confess croak cluck); use strict; use vars qw(%dbglevel $fp $callback $cleandays $keepdays); @@ -186,6 +186,13 @@ sub dbgclean } } +sub dbglog +{ + my $sort = shift; + my $l = shift; + dbg($l); + DXLog::Log($sort, $l); +} 1; __END__ diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 5e324fa4..5580a2be 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -35,7 +35,8 @@ use Route::Node; use Script; use Investigate; use RouteDB; - +use Thingy; +use Thingy::Dx; use strict; @@ -219,7 +220,7 @@ sub init $main::me->{metric} = 0; $main::me->{pingave} = 0; $main::me->{registered} = 1; - $main::me->{version} = $main::version; + $main::me->{version} = 5251 + $main::version; $main::me->{build} = $main::build; } @@ -323,20 +324,6 @@ sub sendinit $self->send(pc18()); } -sub removepc90 -{ - $_[0] =~ s/^PC90\^[-A-Z0-9]+\^\d+\^//; - $_[0] =~ s/^PC91\^[-A-Z0-9]+\^\d+\^[-A-Z0-9]+\^//; -} - -#sub send -#{ -# my $self = shift; -# while (@_) { -# my $line = shift; -# $self->SUPER::send($line); -# } -#} # # This is the normal pcxx despatcher @@ -345,9 +332,6 @@ sub normal { my ($self, $line) = @_; - # remove any incoming PC90 frames - removepc90($line); - my @field = split /\^/, $line; return unless @field; @@ -355,7 +339,6 @@ sub normal # print join(',', @field), "\n"; - # process PC frames, this will fail unless the frame starts PCnn my ($pcno) = $field[0] =~ /^PC(\d\d)/; # just get the number unless (defined $pcno && $pcno >= 10 && $pcno <= 99) { @@ -370,6 +353,16 @@ sub normal return; } + # decrement any hop fields at this point + if ($line =~ /\^H(\d\d?)\^?~?$/) { + my $hops = $1 - 1; + if ($hops < 0) { + dbg("PCPROT: zero hop count, dumped") if isdbg('chanerr'); + return; + } + $line =~ s/\^H\d\d?(\^?~?)$/^H$hops$1/; + } + my $origin = $self->{call}; no strict 'subs'; my $sub = "handle_$pcno"; @@ -434,7 +427,7 @@ sub handle_10 } # remember a route to this node and also the node on which this user is - RouteDB::update($_[6], $self->{call}); + RouteDB::update($_[6], $origin); # RouteDB::update($to, $_[6]); # it is here and logged on @@ -536,26 +529,14 @@ sub handle_11 # RouteDB::update($_[6], $_[7]); my @spot = Spot::prepare($_[1], $_[2], $d, $_[5], $_[6], $_[7]); - # global spot filtering on INPUT - if ($self->{inspotsfilter}) { - my ($filter, $hops) = $self->{inspotsfilter}->it(@spot); - unless ($filter) { - dbg("PCPROT: Rejected by input spot filter") if isdbg('chanerr'); - return; - } - } + + my $thing = Thingy::Dx->new(origin=>$main::mycall, group=>'DX'); + $thing->from_DXProt(DXProt=>$line,spotdata=>\@spot); + $thing->queue($self); # this goes after the input filtering, but before the add # so that if it is input filtered, it isn't added to the dup # list. This allows it to come in from a "legitimate" source - if (Spot::dup($_[1], $_[2], $d, $_[5], $_[6])) { - dbg("PCPROT: Duplicate Spot ignored\n") if isdbg('chanerr'); - return; - } - - # add it - Spot::add(@spot); - # # @spot at this point contains:- # freq, spotted call, time, text, spotter, spotted cc, spotters cc, orig node @@ -622,7 +603,7 @@ sub handle_11 return if $pcno == 26; # send out the filtered spots - send_dx_spot($self, $line, @spot) if @spot; +# send_dx_spot($self, $line, @spot) if @spot; } # announces @@ -714,7 +695,7 @@ sub handle_16 # dos I want users from this channel? unless ($self->user->wantpc16) { - dbg("PCPROT: don't send users to $self->{call}") if isdbg('chanerr'); + dbg("PCPROT: don't send users to $origin") if isdbg('chanerr'); return; } # is it me? @@ -723,14 +704,14 @@ sub handle_16 return; } - RouteDB::update($ncall, $self->{call}); + RouteDB::update($ncall, $origin); # do we believe this call? - unless ($ncall eq $self->{call} || $self->is_believed($ncall)) { - if (my $ivp = Investigate::get($ncall, $self->{call})) { + unless ($ncall eq $origin || $self->is_believed($ncall)) { + if (my $ivp = Investigate::get($ncall, $origin)) { $ivp->store_pcxx($pcno,$line,$origin,@_); } else { - dbg("PCPROT: We don't believe $ncall on $self->{call}") if isdbg('chanerr'); + dbg("PCPROT: We don't believe $ncall on $origin") if isdbg('chanerr'); } return; } @@ -770,7 +751,7 @@ sub handle_16 $parent = Route::Node::get($_->[0]); $dxchan = $parent->dxchan if $parent; if ($dxchan && $dxchan ne $self) { - dbg("PCPROT: PC19 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr'); + dbg("PCPROT: PC19 from $origin trying to alter locally connected $ncall, ignored!") if isdbg('chanerr'); $parent = undef; } if ($parent) { @@ -802,7 +783,7 @@ sub handle_16 $dxchan = $parent->dxchan; if ($dxchan && $dxchan ne $self) { - dbg("PCPROT: PC16 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr'); + dbg("PCPROT: PC16 from $origin trying to alter locally connected $ncall, ignored!") if isdbg('chanerr'); return; } @@ -871,7 +852,7 @@ sub handle_17 # do I want users from this channel? unless ($self->user->wantpc16) { - dbg("PCPROT: don't send users to $self->{call}") if isdbg('chanerr'); + dbg("PCPROT: don't send users to $origin") if isdbg('chanerr'); return; } if ($ncall eq $main::mycall) { @@ -879,14 +860,14 @@ sub handle_17 return; } - RouteDB::delete($ncall, $self->{call}); + RouteDB::delete($ncall, $origin); # do we believe this call? - unless ($ncall eq $self->{call} || $self->is_believed($ncall)) { - if (my $ivp = Investigate::get($ncall, $self->{call})) { + unless ($ncall eq $origin || $self->is_believed($ncall)) { + if (my $ivp = Investigate::get($ncall, $origin)) { $ivp->store_pcxx($pcno,$line,$origin,@_); } else { - dbg("PCPROT: We don't believe $ncall on $self->{call}") if isdbg('chanerr'); + dbg("PCPROT: We don't believe $ncall on $origin") if isdbg('chanerr'); } return; } @@ -902,7 +883,7 @@ sub handle_17 $dxchan = $parent->dxchan if $parent; if ($dxchan && $dxchan ne $self) { - dbg("PCPROT: PC17 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr'); + dbg("PCPROT: PC17 from $origin trying to alter locally connected $ncall, ignored!") if isdbg('chanerr'); return; } @@ -934,8 +915,8 @@ sub handle_18 # record the type and version offered if ($_[1] =~ /DXSpider Version: (\d+\.\d+) Build: (\d+\.\d+)/) { - $self->version(53 + $1); - $self->user->version(53 + $1); + $self->version(52.51 + $1); + $self->user->version(52.51 + $1); $self->build(0 + $2); $self->user->build(0 + $2); unless ($self->is_spider) { @@ -950,7 +931,7 @@ sub handle_18 } # first clear out any nodes on this dxchannel - my $parent = Route::Node::get($self->{call}); + my $parent = Route::Node::get($origin); my @rout = $parent->del_nodes; $self->route_pc21($origin, $line, @rout, $parent) if @rout; $self->send_local_config(); @@ -972,9 +953,9 @@ sub handle_19 my @rout; # first get the INTERFACE node - my $parent = Route::Node::get($self->{call}); + my $parent = Route::Node::get($origin); unless ($parent) { - dbg("DXPROT: my parent $self->{call} has disappeared"); + dbg("DXPROT: my parent $origin has disappeared"); $self->disconnect; return; } @@ -1018,7 +999,7 @@ sub handle_19 # check that this PC19 isn't trying to alter the wrong dxchan my $dxchan = DXChannel->get($call); if ($dxchan && $dxchan != $self) { - dbg("PCPROT: PC19 from $self->{call} trying to alter wrong locally connected $call, ignored!") if isdbg('chanerr'); + dbg("PCPROT: PC19 from $origin trying to alter wrong locally connected $call, ignored!") if isdbg('chanerr'); next; } @@ -1033,19 +1014,19 @@ sub handle_19 } $user->sort('A') unless $user->is_node; - RouteDB::update($call, $self->{call}); + RouteDB::update($call, $origin); # do we believe this call? my $genline = "PC19^$here^$call^$conf^$ver^$_[-1]^"; - unless ($call eq $self->{call} || $self->is_believed($call)) { - my $pt = $user->lastping($self->{call}) || 0; - if ($pt+$investigation_int < $main::systime && !Investigate::get($call, $self->{call})) { - my $ivp = Investigate->new($call, $self->{call}); + unless ($call eq $origin || $self->is_believed($call)) { + my $pt = $user->lastping($origin) || 0; + if ($pt+$investigation_int < $main::systime && !Investigate::get($call, $origin)) { + my $ivp = Investigate->new($call, $origin); $ivp->version($ver); $ivp->here($here); $ivp->store_pcxx($pcno,$genline,$origin,'PC19',$here,$call,$conf,$ver,$_[-1]); } else { - dbg("PCPROT: We don't believe $call on $self->{call}") if isdbg('chanerr'); + dbg("PCPROT: We don't believe $call on $origin") if isdbg('chanerr'); } $user->put; next; @@ -1078,7 +1059,7 @@ sub handle_19 } else { # if he is directly connected or allowed then add him, otherwise store him up for later - if ($call eq $self->{call} || $user->wantroutepc19) { + if ($call eq $origin || $user->wantroutepc19) { my $new = Route->new($call); # throw away if ($self->in_filter_route($new)) { my $ar = $parent->add($call, $ver, $flags); @@ -1090,7 +1071,7 @@ sub handle_19 } else { $pc19list{$call} = [] unless exists $pc19list{$call}; my $nl = $pc19list{$call}; - push @{$pc19list{$call}}, [$self->{call}, $ver, $flags] unless grep $_->[0] eq $self->{call}, @$nl; + push @{$pc19list{$call}}, [$origin, $ver, $flags] unless grep $_->[0] eq $origin, @$nl; } } @@ -1137,14 +1118,14 @@ sub handle_21 return; } - RouteDB::delete($call, $self->{call}); + RouteDB::delete($call, $origin); # check if we believe this - unless ($call eq $self->{call} || $self->is_believed($call)) { - if (my $ivp = Investigate::get($call, $self->{call})) { + unless ($call eq $origin || $self->is_believed($call)) { + if (my $ivp = Investigate::get($call, $origin)) { $ivp->store_pcxx($pcno,$line,$origin,@_); } else { - dbg("PCPROT: We don't believe $call on $self->{call}") if isdbg('chanerr'); + dbg("PCPROT: We don't believe $call on $origin") if isdbg('chanerr'); } return; } @@ -1153,13 +1134,13 @@ sub handle_21 # this routing table manipulation, just remove it from the list and dump it my @rout; if (my $nl = $pc19list{$call}) { - $pc19list{$call} = [ grep {$_->[0] ne $self->{call}} @$nl ]; + $pc19list{$call} = [ grep {$_->[0] ne $origin} @$nl ]; delete $pc19list{$call} unless @{$pc19list{$call}}; } else { - my $parent = Route::Node::get($self->{call}); + my $parent = Route::Node::get($origin); unless ($parent) { - dbg("DXPROT: my parent $self->{call} has disappeared"); + dbg("DXPROT: my parent $origin has disappeared"); $self->disconnect; return; } @@ -1169,7 +1150,7 @@ sub handle_21 my $dxchan = DXChannel->get($call); if ($dxchan && $dxchan != $self) { - dbg("PCPROT: PC21 from $self->{call} trying to alter locally connected $call, ignored!") if isdbg('chanerr'); + dbg("PCPROT: PC21 from $origin trying to alter locally connected $call, ignored!") if isdbg('chanerr'); return; } @@ -1399,7 +1380,7 @@ sub handle_39 my $pcno = shift; my $line = shift; my $origin = shift; - if ($_[1] eq $self->{call}) { + if ($_[1] eq $origin) { $self->disconnect(1); } else { dbg("PCPROT: came in on wrong channel") if isdbg('chanerr'); @@ -1515,11 +1496,11 @@ sub handle_50 my $call = $_[1]; - RouteDB::update($call, $self->{call}); + RouteDB::update($call, $origin); my $node = Route::Node::get($call); if ($node) { - return unless $node->call eq $self->{call}; + return unless $node->call eq $origin; $node->usercount($_[2]); # input filter if required @@ -1577,11 +1558,11 @@ sub handle_51 $tochan->{pingave} = $tochan->{pingave} + (($t - $tochan->{pingave}) / 6); } $tochan->{nopings} = $nopings; # pump up the timer - if (my $ivp = Investigate::get($from, $self->{call})) { + if (my $ivp = Investigate::get($from, $origin)) { $ivp->handle_ping; } } elsif (my $rref = Route::Node::get($r->{call})) { - if (my $ivp = Investigate::get($from, $self->{call})) { + if (my $ivp = Investigate::get($from, $origin)) { $ivp->handle_ping; } } @@ -1591,7 +1572,7 @@ sub handle_51 } } else { - RouteDB::update($from, $self->{call}); + RouteDB::update($from, $origin); if (eph_dup($line)) { dbg("PCPROT: dup PC51 detected") if isdbg('chanerr'); @@ -2160,7 +2141,7 @@ sub adjust_hops $s =~ s/\^H(\d+)(\^~?)$/\^H$newhops$2/ if $newhops; } else { # simply decrement it - $hops--; +# $hops--; this is done on receipt now return "" if !$hops; $s =~ s/\^H(\d+)(\^~?)$/\^H$hops$2/ if $hops; } diff --git a/perl/DXProtVars.pm b/perl/DXProtVars.pm index a5f6bc43..98fd201f 100644 --- a/perl/DXProtVars.pm +++ b/perl/DXProtVars.pm @@ -15,7 +15,7 @@ package DXProt; $pc50_interval = 14*60; # the version of DX cluster (tm) software I am masquerading as -$myprot_version = 5300; +$myprot_version = 5251; # default hopcount to use $def_hopcount = 30; diff --git a/perl/DXProtout.pm b/perl/DXProtout.pm index a5498a0c..a8a609b9 100644 --- a/perl/DXProtout.pm +++ b/perl/DXProtout.pm @@ -123,7 +123,8 @@ sub pc17 # Request init string sub pc18 { - return "PC18^DXSpider Version: $main::version Build: $main::build^$DXProt::myprot_version^"; + my $v = $DXProt::myprot_version + $main::version; + return "PC18^DXSpider Version: $main::version Build: $main::build^$v^"; } # diff --git a/perl/ExtMsg.pm b/perl/ExtMsg.pm index 133a1513..f08a07c9 100644 --- a/perl/ExtMsg.pm +++ b/perl/ExtMsg.pm @@ -159,7 +159,7 @@ sub to_connected delete $conn->{timeout}; $conn->nolinger; &{$conn->{rproc}}($conn, "$dir$call|$sort"); - $conn->_send_file("$main::data/connected") unless $conn->{outgoing}; + $conn->_send_file("$main::data/connected") unless $conn->{outbound}; } sub new_client { @@ -212,12 +212,9 @@ sub start_connect my $call = shift; my $fn = shift; my $conn = ExtMsg->new(\&main::new_channel); - $conn->{outgoing} = 1; + $conn->{outbound} = 1; $conn->conns($call); - - my $f = new IO::File $fn; - push @{$conn->{cmd}}, <$f>; - $f->close; + push @{$conn->{cmd}}, @_; $conn->{state} = 'WC'; $conn->_dotimeout($deftimeout); $conn->_docmd; @@ -264,11 +261,17 @@ sub _doconnect dbg("CONNECT $conn->{cnum} sort: $sort command: $line") if isdbg('connect'); if ($sort eq 'telnet') { # this is a straight network connect - my ($host, $port) = split /\s+/, $line; + my ($host, $port, $type) = split /\s+/, $line; + if ($type && ref($conn) ne $type) { + bless $conn, $type; + $conn->set_newchannel_rproc; + dbg("$conn->{cnum} to $host $port reblessed as $type") if isdbg('connect'); + } $port = 23 if !$port; $r = $conn->connect($host, $port); if ($r) { dbg("Connected $conn->{cnum} to $host $port") if isdbg('connect'); + } else { dbg("***Connect $conn->{cnum} Failed to $host $port $!") if isdbg('connect'); } diff --git a/perl/Filter.pm b/perl/Filter.pm index 4443fc55..ff4ab2e8 100644 --- a/perl/Filter.pm +++ b/perl/Filter.pm @@ -198,6 +198,7 @@ sub it my $key; my $type = 'Dunno'; my $asc = '?'; + my $data = ref $_[0] ? shift : \@_; my $r = @keys > 0 ? 0 : 1; foreach $key (@keys) { @@ -205,7 +206,7 @@ sub it if ($filter->{reject} && exists $filter->{reject}->{code}) { $type = 'reject'; $asc = $filter->{reject}->{user}; - if (&{$filter->{reject}->{code}}(\@_)) { + if (&{$filter->{reject}->{code}}($data)) { $r = 0; last; } else { @@ -215,7 +216,7 @@ sub it if ($filter->{accept} && exists $filter->{accept}->{code}) { $type = 'accept'; $asc = $filter->{accept}->{user}; - if (&{$filter->{accept}->{code}}(\@_)) { + if (&{$filter->{accept}->{code}}($data)) { $r = 1; last; } else { @@ -228,7 +229,7 @@ sub it my $hops = $self->{hops} if exists $self->{hops}; if (isdbg('filter')) { - my $args = join '\',\'', map {defined $_ ? $_ : 'undef'} @_; + my $args = join '\',\'', map {defined $_ ? $_ : 'undef'} @$data; my $true = $r ? "OK " : "REJ"; my $sort = $self->{sort}; my $dir = $self->{name} =~ /^in_/i ? "IN " : "OUT"; diff --git a/perl/Spot.pm b/perl/Spot.pm index 8708ac4d..e918c0c6 100644 --- a/perl/Spot.pm +++ b/perl/Spot.pm @@ -122,7 +122,7 @@ sub prepare $out[4] =~ s/-\d+$//o; # remove leading and trailing spaces - $_[3] = unpad($_[3]); + unpad($out[3]); # add the 'dxcc' country on the end for both spotted and spotter, then the cluster call diff --git a/perl/Thingy.pm b/perl/Thingy.pm index 61068e06..c358389f 100644 --- a/perl/Thingy.pm +++ b/perl/Thingy.pm @@ -2,6 +2,9 @@ # Thingy handling # # This is the new fundamental protocol engine handler +# +# This is where all the new things (and eventually all the old things +# as well) happen. # # $Id$ # @@ -12,12 +15,27 @@ use strict; package Thingy; -use vars qw($VERSION $BRANCH); +use vars qw($VERSION $BRANCH @queue @permin @persec); $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; +@queue = (); # the input / processing queue + +# +# these are set up using the Thingy->add_second_process($addr, $name) +# and Thingy->add_minute_process($addr, $name) +# +# They replace the old cycle in cluster.pl +# + +@persec = (); # this replaces the cycle in cluster.pl +@permin = (); # this is an extra per minute cycle + +my $lastsec = time; +my $lastmin = time; + use DXChannel; use DXDebug; @@ -35,12 +53,17 @@ sub new sub send { my $thing = shift; - my $chan = shift; + my $dxchan = shift; my $class; if (@_) { $class = shift; - } elsif ($chan->isa('DXChannel')) { - $class = ref $chan; + } elsif ($dxchan->isa('DXChannel')) { + $class = ref $dxchan; + } + + # do output filtering + if ($thing->can('out_filter')) { + return unless $thing->out_filter; } # generate the line which may (or not) be cached @@ -50,11 +73,92 @@ sub send } else { no strict 'refs'; my $sub = "gen_$class"; - push @out, $thing->$sub() if $thing->can($sub); + push @out, $thing->$sub($dxchan) if $thing->can($sub); + } + $dxchan->send(@out) if @out; +} + +# broadcast to all except @_ +sub broadcast +{ + my $thing = shift; + dbg("Thingy::broadcast: " . $thing->ascii) if isdbg('thing'); + + foreach my $dxchan (DXChannel::get_all()) { + next if $dxchan == $main::me; + next if grep $dxchan == $_, @_; + $thing->send($dxchan); + } +} + +# queue this thing for processing +sub queue +{ + my $thing = shift; + my $dxchan = shift; + $thing->{dxchan} = $dxchan->call; + push @queue, $thing; +} + +# this is the main commutator loop. In due course it will +# become the *only* commutator loop +sub process +{ + my $thing; + while (@queue) { + $thing = shift @queue; + my $dxchan = DXChannel->get($thing->{dxchan}); + if ($dxchan) { + if ($thing->can('in_filter')) { + next unless $thing->in_filter($dxchan); + } + $thing->handle($dxchan); + } + } + + # per second and per minute processing + if ($main::systime != $lastsec) { + if ($main::systime >= $lastmin+60) { + foreach my $r (@permin) { + &{$r->[0]}(); + } + $lastmin = $main::systime; + } + foreach my $r (@persec) { + &{$r->[0]}(); + } + $lastsec = $main::systime; } - $chan->send(@out) if @out; } +sub add_minute_process +{ + my $pkg = shift; + my $addr = shift; + my $name = shift; + dbg('Adding $name to Thingy per minute queue'); + push @permin, [$addr, $name]; +} + +sub add_second_process +{ + my $pkg = shift; + my $addr = shift; + my $name = shift; + dbg('Adding $name to Thingy per second queue'); + push @persec, [$addr, $name]; +} + +sub ascii +{ + my $thing = shift; + my $dd = new Data::Dumper([$thing]); + $dd->Indent(0); + $dd->Terse(1); + $dd->Sortkeys(1); + $dd->Quotekeys($] < 5.005 ? 1 : 0); + return $dd->Dumpxs; +} 1; diff --git a/perl/Thingy/Dx.pm b/perl/Thingy/Dx.pm new file mode 100644 index 00000000..9b7a181b --- /dev/null +++ b/perl/Thingy/Dx.pm @@ -0,0 +1,158 @@ +# +# Dx Thingy handling +# +# $Id$ +# +# Copyright (c) 2005 Dirk Koopman G1TLH +# + +use strict; + +package Thingy::Dx; + +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 DXChannel; +use DXDebug; +use DXUtil; +use Thingy; +use Spot; + +use vars qw(@ISA); +@ISA = qw(Thingy); + +sub gen_Aranea +{ + my $thing = shift; + unless ($thing->{Aranea}) { + my $sd = $thing->{spotdata}; + my @items = ( + f=>$sd->[0], + c=>$sd->[1], + ); + push @items, ('b', $sd->[4]) unless $thing->{user}; + push @items, ('st', sprintf("%X", $sd->[2] / 60), 'o', $sd->[7]) unless $sd->[7] eq $main::mycall; + push @items, ('i', $sd->[3]) if $sd->[3]; + $thing->{Aranea} = Aranea::genmsg($thing, 'DX', @items); + } + return $thing->{Aranea}; +} + +sub from_Aranea +{ + my $thing = shift; + return unless $thing; + my $t = hex($thing->{st}) if exists $thing->{st}; + $t ||= $thing->{time} / 60; + my @spot = Spot::prepare( + $thing->{f}, + $thing->{c}, + $t*60, + ($thing->{i} || ''), + ($thing->{b} || $thing->{fromuser} || $thing->{user} || $thing->{origin}), + ($thing->{o} || $thing->{origin}), + ); + $thing->{spotdata} = \@spot; + return $thing; +} + +sub gen_DXProt +{ + my $thing = shift; + unless ($thing->{DXProt}) { + my $sd = $thing->{spotdata}; + my $hops = $thing->{hops} || DXProt::get_hops(11); + my $text = $sd->[3] || ' '; + $text =~ s/\^/%5E/g; + my $t = $sd->[2]; + $thing->{DXProt} = sprintf "PC11^%.1f^$sd->[1]^%s^%s^$text^$sd->[4]^$sd->[7]^$hops^~", $sd->[0], cldate($t), ztime($t); + } + return $thing->{DXProt}; +} + +sub gen_DXCommandmode +{ + my $thing = shift; + my $dxchan = shift; + + # these are always generated, never cached + return unless $dxchan->{dx}; + + my $buf; + if ($dxchan->{ve7cc}) { + $buf = VE7CC::dx_spot($dxchan, $thing->{spotdata}); + } else { + $buf = $dxchan->format_dx_spot($thing->{spotdata}); + $buf .= "\a\a" if $dxchan->{beep}; + $buf =~ s/\%5E/^/g; + } + return $buf; +} + +sub from_DXProt +{ + my $thing = shift; + while (@_) { + my $k = shift; + $thing->{$k} = shift; + } + ($thing->{hops}) = $thing->{DXProt} =~ /\^H(\d+)\^?~?$/ if exists $thing->{DXProt}; + return $thing; +} + +sub handle +{ + my $thing = shift; + my $dxchan = shift; + + my $spot = $thing->{spotdata}; + if (Spot::dup(@$spot[0..4])) { + dbg("PCPROT: Duplicate Spot ignored\n") if isdbg('chanerr'); + return; + } + + # add it + Spot::add(@$spot); + + $thing->broadcast($dxchan); +} + +sub in_filter +{ + my $thing = shift; + my $dxchan = shift; + + # global spot filtering on INPUT + if ($dxchan->{inspotsfilter}) { + my ($filter, $hops) = $dxchan->{inspotsfilter}->it($thing->{spotdata}); + unless ($filter) { + dbg("PCPROT: Rejected by input spot filter") if isdbg('chanerr'); + return; + } + } + return 1; +} + +sub out_filter +{ + my $thing = shift; + my $dxchan = shift; + + # global spot filtering on INPUT + if ($dxchan->{inspotsfilter}) { + my ($filter, $hops) = $dxchan->{inspotsfilter}->it($thing->{spotdata}); + unless ($filter) { + dbg("PCPROT: Rejected by input spot filter") if isdbg('chanerr'); + return; + } + $thing->{hops} = $hops if $hops; + } elsif ($dxchan->{isolate}) { + return; + } + return 1; +} +1; diff --git a/perl/Thingy/Hello.pm b/perl/Thingy/Hello.pm index 111abf8b..f2d2d5d1 100644 --- a/perl/Thingy/Hello.pm +++ b/perl/Thingy/Hello.pm @@ -21,27 +21,57 @@ use DXDebug; use Verify; use Thingy; -use vars qw(@ISA); +use vars qw(@ISA $verify_on_login); @ISA = qw(Thingy); +$verify_on_login = 1; # make sure that a HELLO coming from + # the dxchan call is authentic + sub gen_Aranea { my $thing = shift; unless ($thing->{Aranea}) { - my $auth = $thing->{auth} = Verify->new($main::mycall, $main::systime); - $thing->{Aranea} = Aranea::genmsg($thing, 'HELLO', sw=>'DXSpider', + my $s = sprintf "%X", int(rand() * 100000000); + my $auth = Verify->new("DXSp,$main::mycall,$s,$main::version,$main::build"); + $thing->{Aranea} = Aranea::genmsg($thing, 'HELLO', sw=>'DXSp', v=>$main::version, b=>$main::build, + 's'=>$s, auth=>$auth->challenge($main::me->user->passphrase) ); } return $thing->{Aranea}; } -sub from_Aranea +sub handle { - my $line = shift; - my $thing = Aranea::input($line); - return unless $thing; + my $thing = shift; + my $dxchan = shift; + + # verify authenticity + if ($dxchan->call eq $thing->{origin}) { + if ($verify_on_login) { + my $pp = $dxchan->user->passphrase; + unless ($pp) { + dbglog('err', "Thingy::Hello::handle: verify on and $thing->{origin} has no passphrase"); + $dxchan->disconnect; + return; + } + my $auth = Verify->new("DXSp,$thing->{origin},$thing->{s},$thing->{v},$thing->{b}"); + unless ($auth->verify($thing->{auth}, $dxchan->user->passphrase)) { + dbglog('err', "Thingy::Hello::handle: verify on and $thing->{origin} failed auth check"); + $dxchan->disconnect; + return; + } + } + if ($dxchan->{state} ne 'normal') { + $dxchan->start($dxchan->{conn}->{csort}, $dxchan->{conn}->{outbound} ? 'O' : 'A'); + if ($dxchan->{outbound}) { + my $thing = Thingy::Hello->new(origin=>$main::mycall, group=>'ROUTE'); + $thing->send($dxchan); + } + } + } + $thing->broadcast($dxchan); } 1; diff --git a/perl/Verify.pm b/perl/Verify.pm index 5e0fffe1..849b2ed2 100644 --- a/perl/Verify.pm +++ b/perl/Verify.pm @@ -25,45 +25,31 @@ sub new { my $class = shift; my $self = bless {}, ref($class) || $class; - if (@_) { - $self->newseed(@_); - $self->newsalt; - } + $self->newsalt(@_); return $self; } -sub newseed -{ - my $self = shift; - return $self->{seed} = sha1_base64('RbG4tST2dYPWnh6bfAaq7pPSL04', @_); -} - sub newsalt { my $self = shift; - return $self->{salt} = substr sha1_base64($self->{seed}, rand, rand, rand), 0, 6; + return $self->{salt} = sha1_base64('RbG4tST2dYPWnh6bfAaq7pPSL04', @_); } sub challenge { my $self = shift; - return $self->{salt} . sha1_base64($self->{salt}, $self->{seed}, @_); + my $p = substr(sha1_base64($self->{salt}, @_), -6, 6); + return $p; } sub verify { my $self = shift; my $answer = shift; - my $p = sha1_base64($self->{salt}, $self->{seed}, @_); + my $p = substr(sha1_base64($self->{salt}, @_), -6, 6); return $p eq $answer; } -sub seed -{ - my $self = shift; - return @_ ? $self->{seed} = shift : $self->{seed}; -} - sub salt { my $self = shift; diff --git a/perl/cluster.pl b/perl/cluster.pl index 1448ba91..eea057db 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -121,7 +121,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.01"; # the version no of the software $starttime = 0; # the starting time of the cluster #@outstanding_connects = (); # list of outstanding connects @listeners = (); # list of listeners @@ -178,7 +178,7 @@ sub new_channel already_conn($conn, $call, DXM::msg($lang, 'concluster', $call, $main::mycall)); return; } - if ($bumpexisting) { + if ($bumpexisting && $call ne $main::mycall) { my $ip = $conn->{peerhost} || 'unknown'; $dxchan->send_now('D', DXM::msg($lang, 'conbump', $call, $ip)); Log('DXCommand', "$call bumped off by $ip, disconnected"); @@ -448,7 +448,7 @@ DXProt->init(); Aranea->init(); # put in a DXCluster node for us here so we can add users and take them away -$routeroot = Route::Node->new($mycall, $version*100+5300, Route::here($main::me->here)|Route::conf($main::me->conf)); +$routeroot = Route::Node->new($mycall, $version*100+5251, Route::here($main::me->here)|Route::conf($main::me->conf)); # make sure that there is a routing OUTPUT node default file #unless (Filter::read_in('route', 'node_default', 0)) { @@ -491,11 +491,13 @@ for (;;) { my $timenow = time; DXChannel::process(); + Thingy::process(); # $DB::trace = 0; # do timed stuff, ongoing processing happens one a second if ($timenow != $systime) { + rand(); # keep randomising to reduce (but not eliminate) predictability reap if $zombies; $systime = $timenow; DXCron::process(); # do cron jobs