From 0154b38552abaaa4e79ebd9f3e647352acacbcc7 Mon Sep 17 00:00:00 2001 From: minima Date: Tue, 10 Jan 2006 12:15:07 +0000 Subject: [PATCH] remove all traces of Aranea. Add DXSQL.pm permanently but use $dsn to switch on. --- perl/AMsg.pm | 241 ------------------------------------------- perl/Aranea.pm | 232 ----------------------------------------- perl/DXSql.pm | 2 + perl/DXVars.pm.issue | 3 + perl/DXXml.pm | 2 + perl/Thingy/Hello.pm | 47 --------- perl/cluster.pl | 21 ++-- 7 files changed, 13 insertions(+), 535 deletions(-) delete mode 100644 perl/AMsg.pm delete mode 100644 perl/Aranea.pm delete mode 100644 perl/Thingy/Hello.pm diff --git a/perl/AMsg.pm b/perl/AMsg.pm deleted file mode 100644 index 65672647..00000000 --- a/perl/AMsg.pm +++ /dev/null @@ -1,241 +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); -$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 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->to_connected($conn->{call}, 'O', $conn->{csort}); - } - } 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 'WA' ) { - my $uref = DXUser->get_current($conn->{call}); - $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; - } - } 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}); - } - } - } - } - } -} - -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; -} - -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->{outgoing} = 0; - $conn->{state} = 'WH'; # wait for return authorize - my $thing = $conn->{lastthing} = Thingy::Hello->new(origin=>$main::mycall, group=>'ROUTE'); - $thing->send($conn, 'Aranea'); - } - } else { - dbg("ExtMsg: error on accept ($!)") if isdbg('err'); - } -} - -sub start_connect -{ - 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; -} - -# -# happens next on receive -# - -sub new_channel -{ - my ($conn, $msg) = @_; - my $thing = Aranea::input($msg); - return unless defined $thing; - - my $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) { - 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) if $conn->isa('IntMsg'); - - # set callbacks - $conn->set_error(sub {main::error_handler($dxchan)}); - $conn->set_rproc(sub {my ($conn,$msg) = @_; $dxchan->rec($msg)}); - $dxchan->rec($msg); -} - -sub send -{ - my $conn = shift; - for (@_) { - $conn->send_later($_); - } -} diff --git a/perl/Aranea.pm b/perl/Aranea.pm deleted file mode 100644 index 1d0a912f..00000000 --- a/perl/Aranea.pm +++ /dev/null @@ -1,232 +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 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 vars qw(@ISA $ntpflag $dupeage); - -@ISA = qw(DXChannel); - -$ntpflag = 0; # should be set in startup if NTP in use -$dupeage = 12*60*60; # duplicates stored half a day - -my $seqno = 0; -my $dayno = 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; - $main::routeroot->add($call, '5000', Route::here(1)) if $call ne $main::mycall; - $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('init'); - $self->{pc50_t} = $main::systime; - - # send info to all logged in thingies - $self->tell_login('loginn'); - - # 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?"); -} - -# -# This is the normal despatcher -# -sub normal -{ - my ($self, $line) = @_; - - -} - -# -# periodic processing -# - -sub process -{ - - # calc day number - $dayno = (gmtime($main::systime))[3]; -} - -# -# generate new header (this is a general subroutine, not a method -# because it has to be used before a channel is fully initialised). -# - -sub genheader -{ - my $mycall = shift; - my $to = shift; - my $from = shift; - - my $date = ((($dayno << 1) | $ntpflag) << 18) | ($main::systime % 86400); - my $r = "$mycall,$to," . sprintf('%06X%04X,0', $date, $seqno); - $r .= ",$from" if $from; - $seqno++; - $seqno = 0 if $seqno > 0x0ffff; - return $r; -} - -# subroutines to encode and decode values in lists -sub tencode -{ - my $s = shift; - $s =~ s/([\%=|,\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg; - return $s; -} - -sub tdecode -{ - my $s = shift; - $s =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg; - return $s; -} - -sub genmsg -{ - my $thing = shift; - my $name = shift; - my $head = genheader($thing->{origin}, - ($thing->{group} || $thing->{touser} || $thing->{tonode}), - ($thing->{user} || $thing->{fromuser} || $thing->{fromnode}) - ); - my $data = "$name,"; - while (@_) { - my $k = lc shift; - my $v = tencode(shift); - $data .= "$k=$v,"; - } - chop $data; - return "$head|$data"; -} - -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++; - my ($cmd, $rdata) = split /,/, $data, 2; - my $class = 'Thingy::' . ucfirst $cmd; - my $thing; - - # create the appropriate Thingy - if (defined *$class) { - $thing = $class->new(); - - # reconstitute the header but wth hop increased by one - $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->{user} = $user if $user; - $thing->{hopsaway} = $hop; - - while (my ($k,$v) = split /,/, $rdata) { - $thing->{$k} = tdecode($v); - } - } - return $thing; -} - -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 111abf8b..00000000 --- a/perl/Thingy/Hello.pm +++ /dev/null @@ -1,47 +0,0 @@ -# -# Hello Thingy handling -# -# $Id$ -# -# Copyright (c) 2005 Dirk Koopman G1TLH -# - -use strict; - -package Thingy::Hello; - -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 Verify; -use Thingy; - -use vars qw(@ISA); -@ISA = qw(Thingy); - -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', - v=>$main::version, - b=>$main::build, - auth=>$auth->challenge($main::me->user->passphrase) - ); - } - return $thing->{Aranea}; -} - -sub from_Aranea -{ - my $line = shift; - my $thing = Aranea::input($line); - return unless $thing; -} -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(); -- 2.43.0