From: minima Date: Tue, 10 Jan 2006 12:15:07 +0000 (+0000) Subject: remove all traces of Aranea. X-Git-Tag: R_1_52~40 X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=commitdiff_plain;h=ccf7c87f955ebc8534681247b70371c00b14609f;p=spider.git remove all traces of Aranea. Add DXSQL.pm permanently but use $dsn to switch on. --- diff --git a/perl/AMsg.pm b/perl/AMsg.pm deleted file mode 100644 index 4738403a..00000000 --- a/perl/AMsg.pm +++ /dev/null @@ -1,229 +0,0 @@ -# -# This class implements the new style comms for Aranea -# communications for Msg.pm -# -# $Id$ -# -# Copyright (c) 2005 - Dirk Koopman G1TLH -# - -use strict; - -package AMsg; - -use Msg; -use DXVars; -use DXUtil; -use DXDebug; -use Aranea; -use Verify; -use DXLog; -use Thingy; -use Thingy::Hello; - -use vars qw($VERSION $BRANCH); - -main::mkver($VERSION = q$Revision$); - -use vars qw(@ISA $deftimeout); - -@ISA = qw(ExtMsg Msg); -$deftimeout = 60; - -sub enqueue -{ - my ($conn, $msg) = @_; - push (@{$conn->{outqueue}}, $msg . $conn->{lineend}); -} - -sub dequeue -{ - my $conn = shift; - my $msg; - - if ($conn->{csort} eq 'ax25' && exists $conn->{msg}) { - $conn->{msg} =~ s/\cM/\cJ/g; - } - if ($conn->{state} eq 'WC' ) { - if (exists $conn->{cmd}) { - if (@{$conn->{cmd}}) { - dbg("connect $conn->{cnum}: $conn->{msg}") if isdbg('connect'); - $conn->_docmd($conn->{msg}); - } - } - if ($conn->{state} eq 'WC' && exists $conn->{cmd} && @{$conn->{cmd}} == 0) { - $conn->{state} = 'WH'; - } - } elsif ($conn->{msg} =~ /\cJ/) { - my @lines = $conn->{msg} =~ /([^\cM\cJ]*)\cM?\cJ/g; - if ($conn->{msg} =~ /\cJ$/) { - delete $conn->{msg}; - } else { - $conn->{msg} =~ s/([^\cM\cJ]*)\cM?\cJ//g; - } - while (defined ($msg = shift @lines)) { - 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 'WH' ) { - # this is the first stage that we have a callsign - # do we have a hello? - $msg =~ s/[\r\n]+$//; - if ($msg =~ m{|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->{state} = 'WH'; - } - } - } - } - } -} - -sub login -{ - return \&new_channel; -} - -sub new_client { - my $server_conn = shift; - my $sock = $server_conn->{sock}->accept(); - if ($sock) { - my $conn = $server_conn->new($server_conn->{rproc}); - $conn->{sock} = $sock; - $conn->nolinger; - Msg::blocking($sock, 0); - $conn->{blocking} = 0; - eval {$conn->{peerhost} = $sock->peerhost}; - if ($@) { - dbg($@) if isdbg('connll'); - $conn->disconnect; - } else { - eval {$conn->{peerport} = $sock->peerport}; - $conn->{peerport} = 0 if $@; - my ($rproc, $eproc) = &{$server_conn->{rproc}} ($conn, $conn->{peerhost}, $conn->{peerport}); - dbg("accept $conn->{cnum} from $conn->{peerhost} $conn->{peerport}") if isdbg('connll'); - if ($eproc) { - $conn->{eproc} = $eproc; - Msg::set_event_handler ($sock, "error" => $eproc); - } - if ($rproc) { - $conn->{rproc} = $rproc; - my $callback = sub {$conn->_rcv}; - Msg::set_event_handler ($sock, "read" => $callback); - $conn->_dotimeout(60); - $conn->{echo} = 0; - } else { - &{$conn->{eproc}}() if $conn->{eproc}; - $conn->disconnect(); - } - Log('Aranea', "Incoming connection from $conn->{peerhost}"); - $conn->{outbound} = 0; - $conn->{state} = 'WH'; # wait for return authorize - my $thing = $conn->{lastthing} = Thingy::Hello->new(); - $thing->send($conn, 'Aranea'); - dbg("-> D $conn->{peerhost} $thing->{Aranea}") if isdbg('chan'); - } - } else { - dbg("ExtMsg: error on accept ($!)") if isdbg('err'); - } -} - -sub set_newchannel_rproc -{ - my $conn = shift; - $conn->{rproc} = \&new_channel; - $conn->{state} = 'WH'; -} - -# -# happens next on receive -# - -sub new_channel -{ - my ($conn, $msg) = @_; - my $call = $conn->{call} || $conn->{peerhost}; - - dbg("<- I $call $msg") if isdbg('chan'); - - my $thing = Aranea::input($msg); - unless ($thing) { - dbg("Invalid thingy: $msg from $conn->{peerhost}"); - $conn->send_now("Sorry"); - $conn->disconnect; - return; - } - - $call = $thing->{origin}; - unless (is_callsign($call)) { - main::already_conn($conn, $call, DXM::msg($main::lang, "illcall", $call)); - return; - } - - # set up the basic channel info - # is there one already connected to me - locally? - my $user = DXUser->get_current($call); - my $dxchan = DXChannel::get($call); - if ($dxchan) { - 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"); - dbg("$call bumped off by $ip, disconnected"); - $dxchan->disconnect; - } else { - main::already_conn($conn, $call, DXM::msg($main::lang, 'conother', $call, $main::mycall)); - return; - } - } - - # is he locked out ? - my $basecall = $call; - $basecall =~ s/-\d+$//; - my $baseuser = DXUser->get_current($basecall); - my $lock = $user->lockout if $user; - if ($baseuser && $baseuser->lockout || $lock) { - if (!$user || !defined $lock || $lock) { - my $host = $conn->{peerhost} || "unknown"; - Log('DXCommand', "$call on $host is locked out, disconnected"); - $conn->disconnect; - return; - } - } - - if ($user) { - $user->{lang} = $main::lang if !$user->{lang}; # to autoupdate old systems - } else { - $user = DXUser->new($call); - } - - # create the channel - $dxchan = Aranea->new($call, $conn, $user); - - # check that the conn has a callsign - $conn->conns($call); - - # set callbacks - $conn->set_error(sub {main::error_handler($dxchan)}); - $conn->set_rproc(sub {my ($conn,$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 -{ - my $conn = shift; - for (@_) { - $conn->send_later($_); - } -} diff --git a/perl/Aranea.pm b/perl/Aranea.pm deleted file mode 100644 index 7765af34..00000000 --- a/perl/Aranea.pm +++ /dev/null @@ -1,535 +0,0 @@ -# -# The new protocol for real at last -# -# $Id$ -# -# Copyright (c) 2005 Dirk Koopman G1TLH -# - -package Aranea; - -use strict; - -use DXUtil; -use DXChannel; -use DXUser; -use DXM; -use DXLog; -use DXDebug; -use Filter; -use Time::HiRes qw(gettimeofday tv_interval); -use DXHash; -use Route; -use Route::Node; -use Script; -use Verify; -use DXDupe; -use Thingy; -use Thingy::Rt; -use Thingy::Hello; -use Thingy::Bye; -use RouteDB; -use DXProt; -use DXCommandmode; - -use vars qw($VERSION $BRANCH); - -main::mkver($VERSION = q$Revision$); - -use vars qw(@ISA $ntpflag $dupeage $cf_interval $hello_interval); - -@ISA = qw(DXChannel); - -$ntpflag = 0; # should be set in startup if NTP in use -$dupeage = 12*60*60; # duplicates stored half a day -$cf_interval = 30*60; # interval between config broadcasts -$hello_interval = 3*60*60; # interval between hello broadcasts for me and local users - -my $seqno = 0; -my $dayno = 0; -my $daystart = 0; - -sub init -{ - -} - -sub new -{ - my $self = DXChannel::alloc(@_); - - # add this node to the table, the values get filled in later - my $pkg = shift; - my $call = shift; - $self->{'sort'} = 'W'; - return $self; -} - -sub start -{ - my ($self, $line, $sort) = @_; - my $call = $self->{call}; - my $user = $self->{user}; - - # log it - my $host = $self->{conn}->{peerhost} || "unknown"; - Log('Aranea', "$call connected from $host"); - - # remember type of connection - $self->{consort} = $line; - $self->{outbound} = $sort eq 'O'; - my $priv = $user->priv; - $priv = $user->priv(1) unless $priv; - $self->{priv} = $priv; # other clusters can always be 'normal' users - $self->{lang} = $user->lang || 'en'; - $self->{consort} = $line; # save the connection type - $self->{here} = 1; - $self->{width} = 80; - - # sort out registration - $self->{registered} = 1; - - # get the output filters - $self->{spotsfilter} = Filter::read_in('spots', $call, 0) || Filter::read_in('spots', 'node_default', 0); - $self->{wwvfilter} = Filter::read_in('wwv', $call, 0) || Filter::read_in('wwv', 'node_default', 0); - $self->{wcyfilter} = Filter::read_in('wcy', $call, 0) || Filter::read_in('wcy', 'node_default', 0); - $self->{annfilter} = Filter::read_in('ann', $call, 0) || Filter::read_in('ann', 'node_default', 0) ; - $self->{routefilter} = Filter::read_in('route', $call, 0) || Filter::read_in('route', 'node_default', 0) unless $self->{isolate} ; - - - # get the INPUT filters (these only pertain to Clusters) - $self->{inspotsfilter} = Filter::read_in('spots', $call, 1) || Filter::read_in('spots', 'node_default', 1); - $self->{inwwvfilter} = Filter::read_in('wwv', $call, 1) || Filter::read_in('wwv', 'node_default', 1); - $self->{inwcyfilter} = Filter::read_in('wcy', $call, 1) || Filter::read_in('wcy', 'node_default', 1); - $self->{inannfilter} = Filter::read_in('ann', $call, 1) || Filter::read_in('ann', 'node_default', 1); - $self->{inroutefilter} = Filter::read_in('route', $call, 1) || Filter::read_in('route', 'node_default', 1) unless $self->{isolate}; - - $self->conn->echo(0) if $self->conn->can('echo'); - - # ping neighbour node stuff - my $ping = $user->pingint; - $ping = $DXProt::pingint unless defined $ping; - $self->{pingint} = $ping; - $self->{nopings} = $user->nopings || $DXProt::obscount; - $self->{pingtime} = [ ]; - $self->{pingave} = 999; - $self->{metric} ||= 100; - $self->{lastping} = $main::systime; - - $self->state('normal'); - $self->{pc50_t} = $main::systime; - - # send info to all logged in thingies - $self->tell_login('loginn'); - - # broadcast our configuration to the world - unless ($self->{outbound}) { - my $thing = Thingy::Rt->new_cf; - $thing->broadcast; - $main::me->lastcf($main::systime); - } - - # 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; -} - -# -# This is the normal despatcher -# -sub normal -{ - my ($self, $line) = @_; - my $thing = input($line); - $thing->queue($self) if $thing; -} - -# -# periodic processing (every second) -# - -my $lastmin = time; - -sub process -{ - - # calc day number - my $d = (gmtime($main::systime))[3]; - if ($d != $dayno) { - $dayno = $d; - $daystart = $main::systime - ($main::systime % 86400); - } - if ($main::systime >= $lastmin + 60) { - per_minute(); - $lastmin = $main::systime; - } -} - -sub per_minute -{ - # send hello and cf packages periodically - foreach my $dxchan (DXChannel::get_all()) { - next if $dxchan->is_aranea; - if ($main::systime >= $dxchan->lasthello + $hello_interval) { - my $thing = Thingy::Hello->new(h => $dxchan->here); - $thing->{user} = $dxchan->{call} unless $dxchan == $main::me; - if (my $v = $dxchan->{version}) { - if ($dxchan->is_spider) { - $thing->{sw} = 'DXSp'; - } - $thing->{v} = $v; - } - $thing->{b} = $dxchan->{build} if $dxchan->{build}; - $thing->broadcast($dxchan); - $dxchan->lasthello($main::systime); - } - if ($dxchan->is_node) { - if ($main::systime >= $dxchan->lastcf + $cf_interval) { - my $call = $dxchan->call; - if ($dxchan == $main::me) { - - # i am special but, currently, still a node - my $thing = Thingy::Rt->new_cf; - $thing->broadcast; - $dxchan->lastcf($main::systime); - } else { - - # i am a pc protocol node connected directly - my $thing = Thingy::Rt->new(); - $thing->{user} = $call unless $dxchan == $main::me; - if (my $nref = Route::Node::get($call)) { - $thing->copy_pc16_data($nref); - $thing->broadcast($dxchan); - $dxchan->lastcf($main::systime); - } else { - dbg("Aranea::per_minute: Route::Node for $call disappeared"); - $dxchan->disconnect; - } - } - } - } - } -} - -sub disconnect -{ - my $self = shift; - my $call = $self->call; - - return if $self->{disconnecting}++; - - my $thing = Thingy::Bye->new(origin=>$main::mycall, user=>$call); - $thing->broadcast($self); - - # get rid of any PC16/17/19 - DXProt::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; - DXProt::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 - DXProt::route_pc21($self, $main::mycall, undef, @rout) if @rout; - - # remove outstanding pings - Thingy::Ping::forget($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; -} - -# -# generate new header (this is a general subroutine, not a method -# 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 $touser = shift; - - my $s = "$mycall,$dts,$hop"; - $s .= ",$user" if $user; - if ($group) { - $s .= "," unless $user; - $s .= ",$group" if $group; - $s .= ",$touser" if $touser; - } - return $s; -} - -sub genheader -{ - my $mycall = shift; - my $to = shift; - my $from = shift; - my $touser = shift; - - my $date = ((($dayno << 1) | $ntpflag) << 18) | ($main::systime % 86400); - my $r = formathead($mycall, sprintf('%6X%04X', $date, $seqno), 0, $from, $to, $touser); - $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 "A6 A4", $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'" 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 length $s ? $s : ''; -} - -sub genmsg -{ - my $thing = shift; - my $list = ref $_[0] ? shift : \@_; - my ($name) = uc ref $thing; - $name =~ /::(\w+)$/; - $name = $1; - my $group = $thing->{group}; - my $head = genheader($thing->{origin}, - $group, - ($thing->{user} || $thing->{fromuser} || $thing->{fromnode}), - $thing->{touser} - ); - - my $data = uc $name . ','; - while (@$list) { - my $k = lc shift @$list; - my $v = $thing->{$k}; - $data .= "$k=" . tencode($v) . ',' if defined $v; - } - chop $data; - 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, $dts, $hop, $user, $group, $tocall) = split /,/, $head; - return if DXDupe::check("Ara,$origin,$dts", $dupeage); - my $err; - $err .= "incomplete header," unless $origin && $dts && defined $hop; - my ($cmd, $rdata) = split /,/, $data, 2; - - # validate it further - $err .= "missing cmd or data," unless $cmd && $data; - $err .= "invalid command ($cmd)," unless $cmd =~ /^[A-Z][A-Z0-9]*$/; - - $err .= "from me," if $origin eq $main::mycall; - $err .= "invalid group ($group)," if $group && $group !~ /^[-A-Z0-9]{2,}$/; - $err .= "invalid tocall ($tocall)," if $tocall && !is_callsign($tocall); - $err .= "invalid fromcall ($user)," if $user && !is_callsign($user); - - my $class = 'Thingy::' . ucfirst(lc $cmd); - my $thing; - my ($t, $seqno, $ntp) = decode_dts($dts) unless $err; - dbg("dts: $dts = $ntp $t($main::systime) $seqno") if isdbg('dts'); - $err .= "invalid date/seq," unless $t; - - 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 = formathead($origin, $dts, ++$hop, $user, $group, $tocall); - $thing->{Aranea} = "$head|$data"; - - # store useful data - $thing->{origin} = $origin; - $thing->{time} = $t; - $thing->{group} = $group if $group; - $thing->{touser} = $tocall if $tocall; - $thing->{user} = $user if $user; - $thing->{hopsaway} = $hop; - - 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 - # 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/DXSql.pm b/perl/DXSql.pm index 5d45eb94..d0f7856b 100644 --- a/perl/DXSql.pm +++ b/perl/DXSql.pm @@ -22,6 +22,8 @@ our $active = 0; sub init { + my $dsn = shift; + return unless $dsn; return $active if $active; eval { diff --git a/perl/DXVars.pm.issue b/perl/DXVars.pm.issue index 6370a563..ff8e2b2c 100644 --- a/perl/DXVars.pm.issue +++ b/perl/DXVars.pm.issue @@ -86,6 +86,9 @@ $motd = "$data/motd"; # are we debugging ? @debug = qw(chan state msg cron connect); +# are we doing xml? +$do_xml = 0; + # the SQL database DBI dsn #$dsn = "dbi:SQLite:dbname=$root/data/dxspider.db"; #$dbuser = ""; diff --git a/perl/DXXml.pm b/perl/DXXml.pm index 16f40eaa..c6c8ee69 100644 --- a/perl/DXXml.pm +++ b/perl/DXXml.pm @@ -23,6 +23,8 @@ $xs = undef; # the XML::Simple parser instance sub init { + return unless $main::do_xml; + eval { require XML::Simple; }; unless ($@) { import XML::Simple; diff --git a/perl/Thingy/Hello.pm b/perl/Thingy/Hello.pm deleted file mode 100644 index 7221d789..00000000 --- a/perl/Thingy/Hello.pm +++ /dev/null @@ -1,151 +0,0 @@ -# -# Hello Thingy handling -# -# Note that this is a generator of pc19n and pc16n/pc16u -# and a consumer of fpc19n and fpc16n -# -# $Id$ -# -# Copyright (c) 2005 Dirk Koopman G1TLH -# - -use strict; - -package Thingy::Hello; - -use vars qw($VERSION $BRANCH); - -main::mkver($VERSION = q$Revision$); - -use DXChannel; -use DXDebug; -use Verify; -use Thingy; -use Thingy::RouteFilter; -use Thingy::Rt; - -use vars qw(@ISA $verify_on_login); -@ISA = qw(Thingy Thingy::RouteFilter); - -$verify_on_login = 1; # make sure that a HELLO coming from - # the dxchan call is authentic - -sub gen_Aranea -{ - my $thing = shift; - my $dxchan = shift; - - unless ($thing->{Aranea}) { - if ($thing->{user}) { - $thing->{h} ||= $dxchan->here; - } else { - $thing->{sw} ||= 'DXSp'; - $thing->{v} ||= $main::me->version; - $thing->{b} ||= $main::me->build; - $thing->{h} ||= $main::me->here; - $thing->add_auth; - } - - $thing->{Aranea} = Aranea::genmsg($thing, [qw(sw h v b s auth)]); - } - return $thing->{Aranea}; -} - -sub handle -{ - my $thing = shift; - my $dxchan = shift; - - my $origin = $thing->{origin}; - my $node = $dxchan->{call}; - - my $nref; - - $thing->{pc19n} ||= []; - - my $v = $thing->{v}; - if ($v) { - $v = $DXProt::myprot_version + int ($v*100) if $v > 2 && $v < 3; - $v = $DXProt::myprot_version + 150 unless $v >= 5400; - $v =~ s/\.\d+$//; - $thing->{pcv} = $v; - } - - # verify authenticity - if ($node eq $origin) { - - # for directly connected calls - if ($verify_on_login && !$thing->{user}) { - my $pp = $dxchan->user->passphrase; - unless ($pp) { - dbglog('err', "Thingy::Hello::handle: verify on and $origin has no passphrase"); - $dxchan->disconnect; - return; - } - my $auth = Verify->new("DXSp,$origin,$thing->{s},$thing->{v},$thing->{b}"); - unless ($auth->verify($thing->{auth}, $dxchan->user->passphrase)) { - dbglog('err', "Thingy::Hello::handle: verify on and $origin failed auth check"); - $dxchan->disconnect; - return; - } - } - if ($dxchan->{state} ne 'normal') { - $nref = $main::routeroot->add($origin, $thing->{pcv}, $thing->{h}); - push @{$thing->{pc19n}}, $nref if $nref; - $dxchan->start($dxchan->{conn}->{csort}, $dxchan->{conn}->{outbound} ? 'O' : 'A'); - if ($dxchan->{outbound}) { - my $thing = Thingy::Hello->new(); - $thing->send($dxchan); - - # broadcast our configuration to the world - $thing = Thingy::Rt->new_cf; - $thing->broadcast; - } - } - $nref = Route::Node::get($origin); - $nref->np(1); - } else { - - # for otherwise connected calls, that come in relayed from other nodes - # note that we cannot do any connections at this point - $nref = Route::Node::get($origin); - unless ($nref) { - my $v = $thing->{user} ? undef : $thing->{pcv}; - $nref = Route::Node->new($origin, $v, 1); - push @{$thing->{pc19n}}, $nref; - $nref->np(1); - } - } - - # handle "User" - if (my $user = $thing->{user}) { - my $ur = Route::get($user); - unless ($ur) { - my @ref; - my $uref = DXUser->get_current($user) || Thingy::Rt::_upd_user_rec($user, $origin)->put; - if ($uref->is_node || $uref->is_aranea) { - push @ref, $nref->add($user, $thing->{pcv} || 0, $thing->{h} || 0); - push @{$thing->{pc19n}}, @ref if @ref; - do $_->np(1) for @ref; - } else { - $thing->{pc16n} = $nref; - push @ref, $nref->add_user($user, $thing->{h} || 0); - $thing->{pc16u} = \@ref if @ref; - } - } - } else { - $nref->version($v) unless $nref->version; - $nref->build($thing->{b}) unless $nref->build; - $nref->sw($thing->{sw}) unless $nref->sw; - $nref->here($thing->{h}) if exists $thing->{h}; - } - - RouteDB::update($origin, $node, $thing->{hopsaway}); - RouteDB::update($thing->{user}, $node, $thing->{hopsaway}) if $thing->{user}; - - delete $thing->{pc19n} unless @{$thing->{pc19n}}; - - $thing->broadcast($dxchan); -} - -1; diff --git a/perl/cluster.pl b/perl/cluster.pl index 003ae845..a1da82ad 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -68,7 +68,6 @@ use DXCommandmode; use DXProtVars; use DXProtout; use DXProt; -use Aranea; use DXMsg; use DXCron; use DXConnect; @@ -99,10 +98,9 @@ use Mrtg; use USDB; use UDPMsg; use QSL; -use Thingy; use RouteDB; -use AMsg; use DXXml; +use DXSql; use Data::Dumper; use IO::File; @@ -117,7 +115,7 @@ use strict; use vars qw(@inqueue $systime $version $starttime $lockfn @outstanding_connects $zombies $root @listeners $lang $myalias @debug $userfn $clusteraddr $clusterport $mycall $decease $is_win $routeroot $me $reqreg $bumpexisting - $allowdxby $dbh $dsn $dbuser $dbpass + $allowdxby $dbh $dsn $dbuser $dbpass $do_xml ); @inqueue = (); # the main input queue, an array of hashes @@ -136,7 +134,7 @@ $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; -$main::build += 1; # fudge (put back for now) +$main::build += 4; # fudge (put back for now) @@ -351,14 +349,9 @@ $build += $main::version; $build = "$build.$branch" if $branch; # try to load the database -if ($dsn && -e "$root/perl/DXSql.pm") { - require DXSql; - import DXSql; - - if (DXSql::init()) { - $dbh = DXSql->new($dsn); - $dbh = $dbh->connect($dsn, $dbuser, $dbpass) if $dbh; - } +if (DXSql::init($dsn)) { + $dbh = DXSql->new($dsn); + $dbh = $dbh->connect($dsn, $dbuser, $dbpass) if $dbh; } # try to load XML::Simple @@ -466,7 +459,6 @@ Spot->init(); # initialise the protocol engine dbg("Start Protocol Engines ..."); 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)); @@ -522,7 +514,6 @@ for (;;) { DXCron::process(); # do cron jobs DXCommandmode::process(); # process ongoing command mode stuff DXProt::process(); # process ongoing ak1a pcxx stuff - Aranea::process(); DXConnect::process(); DXMsg::process(); DXDb::process();