From: minima Date: Mon, 24 Jan 2005 09:08:54 +0000 (+0000) Subject: start the Aranea additions X-Git-Tag: R_1_52~217 X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?p=spider.git;a=commitdiff_plain;h=6f20114b034d329c1e2a4f91f0aba2f6ec4002d4 start the Aranea additions --- diff --git a/perl/AGWMsg.pm b/perl/AGWMsg.pm index f6fc5074..cb64177e 100644 --- a/perl/AGWMsg.pm +++ b/perl/AGWMsg.pm @@ -104,6 +104,11 @@ sub finish } } +sub login +{ + goto &main::login; # save some writing, this was the default +} + sub active { return $sock; diff --git a/perl/AMsg.pm b/perl/AMsg.pm index 06d281d1..19fe9208 100644 --- a/perl/AMsg.pm +++ b/perl/AMsg.pm @@ -4,19 +4,22 @@ # # $Id$ # -# Copyright (c) 2001 - Dirk Koopman G1TLH +# Copyright (c) 2005 - Dirk Koopman G1TLH # +use strict; + package AMsg; -use strict; use Msg; use DXVars; use DXUtil; use DXDebug; -use IO::File; -use IO::Socket; -use IPC::Open3; +use Aranea; +use Verify; +use DXLog; +use Thingy; +use Thingy::Hello; use vars qw($VERSION $BRANCH); $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); @@ -26,41 +29,13 @@ $main::branch += $BRANCH; use vars qw(@ISA $deftimeout); -@ISA = qw(ExtMsg); +@ISA = qw(ExtMsg Msg); $deftimeout = 60; sub enqueue { my ($conn, $msg) = @_; - unless ($msg =~ /^[ABZ]/) { - if ($msg =~ /^E[-\w]+\|([01])/ && $conn->{csort} eq 'telnet') { - $conn->{echo} = $1; - if ($1) { -# $conn->send_raw("\xFF\xFC\x01"); - } else { -# $conn->send_raw("\xFF\xFB\x01"); - } - } else { - $msg =~ s/^[-\w]+\|//; - push (@{$conn->{outqueue}}, $msg . $conn->{lineend}); - } - } -} - -sub send_raw -{ - my ($conn, $msg) = @_; - my $sock = $conn->{sock}; - return unless defined($sock); - push (@{$conn->{outqueue}}, $msg); - dbg("connect $conn->{cnum}: $msg") if $conn->{state} ne 'C' && isdbg('connect'); - Msg::set_event_handler ($sock, "write" => sub {$conn->_send(0)}); -} - -sub echo -{ - my $conn = shift; - $conn->{echo} = shift; + push (@{$conn->{outqueue}}, $msg . $conn->{lineend}); } sub dequeue @@ -71,7 +46,7 @@ sub dequeue if ($conn->{csort} eq 'ax25' && exists $conn->{msg}) { $conn->{msg} =~ s/\cM/\cJ/g; } - if ($conn->{state} eq 'WC') { + if ($conn->{state} eq 'WC' ) { if (exists $conn->{cmd}) { if (@{$conn->{cmd}}) { dbg("connect $conn->{cnum}: $conn->{msg}") if isdbg('connect'); @@ -90,38 +65,13 @@ sub dequeue } while (defined ($msg = shift @lines)) { dbg("connect $conn->{cnum}: $msg") if $conn->{state} ne 'C' && isdbg('connect'); - - $msg =~ s/\xff\xfa.*\xff\xf0|\xff[\xf0-\xfe].//g; # remove telnet options -# $msg =~ s/[\x00-\x08\x0a-\x19\x1b-\x1f\x80-\x9f]/./g; # immutable CSI sequence + control characters - if ($conn->{state} eq 'C') { - &{$conn->{rproc}}($conn, "I$conn->{call}|$msg"); - } elsif ($conn->{state} eq 'WL' ) { - $msg = uc $msg; - if (is_callsign($msg) && $msg !~ m|/| ) { - my $sort = $conn->{csort}; - $sort = 'local' if $conn->{peerhost} eq "127.0.0.1"; - my $uref; - if ($main::passwdreq || ($uref = DXUser->get_current($msg)) && $uref->passwd ) { - $conn->conns($msg); - $conn->{state} = 'WP'; - $conn->{decho} = $conn->{echo}; - $conn->{echo} = 0; - $conn->send_raw('password: '); - } else { - $conn->to_connected($msg, 'A', $sort); - } - } else { - $conn->send_now("Sorry $msg is an invalid callsign"); - $conn->disconnect; - } - } elsif ($conn->{state} eq 'WP' ) { + &{$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}; - $conn->{echo} = $conn->{decho}; - delete $conn->{decho}; $sort = 'local' if $conn->{peerhost} eq "127.0.0.1"; $conn->{usedpasswd} = 1; $conn->to_connected($conn->{call}, 'A', $sort); @@ -138,7 +88,7 @@ sub dequeue } } } - } + } } sub to_connected @@ -151,7 +101,141 @@ sub to_connected delete $conn->{timeout}; $conn->nolinger; &{$conn->{rproc}}($conn, "$dir$call|$sort"); - $conn->_send_file("$main::data/connected") unless $conn->{outgoing}; } +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 new file mode 100644 index 00000000..1d0a912f --- /dev/null +++ b/perl/Aranea.pm @@ -0,0 +1,232 @@ +# +# 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/DXChannel.pm b/perl/DXChannel.pm index ca3afd6f..acd4245c 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -117,6 +117,7 @@ $count = 0; ve7cc => '0,VE7CC program special,yesno', lastmsgpoll => '0,Last Msg Poll,atime', inscript => '9,In a script,yesno', + inqueue => '9,Input Queue,parray', ); use vars qw($VERSION $BRANCH); @@ -168,6 +169,7 @@ sub alloc $self->{itu} = $dxcc[1]->itu; $self->{cq} = $dxcc[1]->cq; } + $self->{inqueue} = []; $count++; dbg("DXChannel $self->{call} created ($count)") if isdbg('chan'); @@ -175,6 +177,16 @@ sub alloc return $channels{$call} = $self; } +sub rec +{ + my ($self, $msg) = @_; + + # queue the message and the channel object for later processing + if (defined $msg) { + push @{$self->{inqueue}}, $msg; + } +} + # obtain a channel object by callsign [$obj = DXChannel->get($call)] sub get { @@ -185,7 +197,6 @@ sub get # obtain all the channel objects sub get_all { - my ($pkg) = @_; return values(%channels); } @@ -255,7 +266,7 @@ sub is_bbs sub is_node { my $self = shift; - return $self->{'sort'} =~ /[ACRSX]/; + return $self->{'sort'} =~ /[ACRSXW]/; } # is it an ak1a node ? sub is_ak1a @@ -278,6 +289,13 @@ sub is_clx return $self->{'sort'} eq 'C'; } +# it is Aranea +sub is_aranea +{ + my $self = shift; + return $self->{'sort'} eq 'W'; +} + # is it a spider node sub is_spider { @@ -439,7 +457,6 @@ sub disconnect my $self = shift; my $user = $self->{user}; - main::clean_inqueue($self); # clear out any remaining incoming frames $user->close() if defined $user; $self->{conn}->disconnect; $self->del(); @@ -551,7 +568,7 @@ sub broadcast_nodes { my $s = shift; # the line to be rebroadcast my @except = @_; # to all channels EXCEPT these (dxchannel refs) - my @dxchan = DXChannel::get_all_nodes(); + my @dxchan = get_all_nodes(); my $dxchan; # send it if it isn't the except list and isn't isolated and still has a hop count @@ -571,7 +588,7 @@ sub broadcast_all_nodes { my $s = shift; # the line to be rebroadcast my @except = @_; # to all channels EXCEPT these (dxchannel refs) - my @dxchan = DXChannel::get_all_nodes(); + my @dxchan = get_all_nodes(); my $dxchan; # send it if it isn't the except list and isn't isolated and still has a hop count @@ -592,7 +609,7 @@ sub broadcast_users my $sort = shift; # the type of transmission my $fref = shift; # a reference to an object to filter on my @except = @_; # to all channels EXCEPT these (dxchannel refs) - my @dxchan = DXChannel::get_all_users(); + my @dxchan = get_all_users(); my $dxchan; my @out; @@ -636,6 +653,42 @@ sub broadcast_list } } +sub process +{ + foreach my $dxchan (get_all()) { + + while (my $data = shift @{$dxchan->{inqueue}}) { + my ($sort, $call, $line) = $dxchan->decode_input($data); + next unless defined $sort; + + # do the really sexy console interface bit! (Who is going to do the TK interface then?) + dbg("<- $sort $call $line") if $sort ne 'D' && isdbg('chan'); + if ($dxchan->{disconnecting}) { + dbg('In disconnection, ignored'); + next; + } + + # handle A records + my $user = $dxchan->user; + if ($sort eq 'A' || $sort eq 'O') { + $dxchan->start($line, $sort); + } elsif ($sort eq 'I') { + die "\$user not defined for $call" if !defined $user; + + # normal input + $dxchan->normal($line); + } elsif ($sort eq 'Z') { + $dxchan->disconnect; + } elsif ($sort eq 'D') { + ; # ignored (an echo) + } elsif ($sort eq 'G') { + $dxchan->enhanced($line); + } else { + print STDERR atime, " Unknown command letter ($sort) received from $call\n"; + } + } + } +} #no strict; sub AUTOLOAD diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 48410eb2..5e324fa4 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -48,7 +48,7 @@ $main::branch += $BRANCH; use vars qw($pc11_max_age $pc23_max_age $last_pc50 $eph_restime $eph_info_restime $eph_pc34_restime $last_hour $last10 %eph %pings %rcmds $ann_to_talk $pingint $obscount %pc19list $chatdupeage $chatimportfn - $investigation_int $pc19_version + $investigation_int $pc19_version $myprot_version %nodehops $baddx $badspotter $badnode $censorpc $rspfcheck $allowzero $decode_dk0wcy $send_opernam @checklist); @@ -206,6 +206,21 @@ sub init { do "$main::data/hop_table.pl" if -e "$main::data/hop_table.pl"; confess $@ if $@; + + my $user = DXUser->get($main::mycall); + die "User $main::mycall not setup or disappeared RTFM" unless $user; + + $myprot_version += $main::version*100; + $main::me = DXProt->new($main::mycall, 0, $user); + $main::me->{here} = 1; + $main::me->{state} = "indifferent"; + $main::me->{sort} = 'S'; # S for spider + $main::me->{priv} = 9; + $main::me->{metric} = 0; + $main::me->{pingave} = 0; + $main::me->{registered} = 1; + $main::me->{version} = $main::version; + $main::me->{build} = $main::build; } # diff --git a/perl/ExtMsg.pm b/perl/ExtMsg.pm index f1472789..133a1513 100644 --- a/perl/ExtMsg.pm +++ b/perl/ExtMsg.pm @@ -32,6 +32,11 @@ use vars qw(@ISA $deftimeout); @ISA = qw(Msg); $deftimeout = 60; +sub login +{ + goto &main::login; # save some writing, this was the default +} + sub enqueue { my ($conn, $msg) = @_; diff --git a/perl/IntMsg.pm b/perl/IntMsg.pm index a940347d..0318c2b3 100644 --- a/perl/IntMsg.pm +++ b/perl/IntMsg.pm @@ -23,6 +23,11 @@ use vars qw(@ISA); @ISA = qw(Msg); +sub login +{ + goto &main::login; # save some writing, this was the default +} + sub enqueue { my ($conn, $msg) = @_; diff --git a/perl/Thingy.pm b/perl/Thingy.pm index 885e7f0f..2483d273 100644 --- a/perl/Thingy.pm +++ b/perl/Thingy.pm @@ -8,6 +8,8 @@ # Copyright (c) 2004 Dirk Koopman G1TLH # +use strict; + package Thingy; use vars qw($VERSION $BRANCH); @@ -16,36 +18,43 @@ $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)) $main::build += $VERSION; $main::branch += $BRANCH; - use DXChannel; use DXDebug; -use vars qw(@queue); -@queue = (); # the thingy queue - # we expect all thingies to be subclassed sub new { my $class = shift; - my $self = {@_}; + my $thing = {@_}; - bless $self, $class; - return $self; + bless $thing, $class; + return $thing; } -# add the Thingy to the queue -sub add +# send it out in the format asked for, if available +sub send { - push @queue, shift; + my $thing = shift; + my $chan = shift; + my $class; + if (@_) { + $class = shift; + } elsif ($chan->isa('DXChannel')) { + $class = ref $chan; + } + + # generate the line which may (or not) be cached + my @out; + if (my $ref = $thing->{class}) { + push @out, ref $ref ? @$ref : $ref; + } else { + no strict 'refs'; + my $sub = "gen_$class"; + push @out, $thing->$sub if $thing->can($sub); + } + $chan->send(@out) if @out; } -# dispatch Thingies to action it. -sub process -{ - my $t = pop @queue if @queue; - - $t->process if $t; -} 1; diff --git a/perl/Thingy/Hello.pm b/perl/Thingy/Hello.pm new file mode 100644 index 00000000..111abf8b --- /dev/null +++ b/perl/Thingy/Hello.pm @@ -0,0 +1,47 @@ +# +# 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/Verify.pm b/perl/Verify.pm index 58694eb5..5e0fffe1 100644 --- a/perl/Verify.pm +++ b/perl/Verify.pm @@ -7,16 +7,14 @@ # $Id$ # +use strict; + package Verify; -use DXChannel; use DXUtil; use DXDebug; -use Time::HiRes qw(gettimeofday); use Digest::SHA1 qw(sha1_base64); -use strict; - 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)); @@ -27,35 +25,48 @@ sub new { my $class = shift; my $self = bless {}, ref($class) || $class; - $self->{seed} = shift if @_; + if (@_) { + $self->newseed(@_); + $self->newsalt; + } return $self; } -sub challenge +sub newseed { my $self = shift; - my @t = gettimeofday(); - my $r = unpack("xxNxx", pack("d", rand)); - @t = map {$_ ^ $r} @t; - dbg("challenge r: $r seed: $t[0] $t[1]" ) if isdbg('verify'); - $r = unpack("xxNxx", pack("d", rand)); - @t = map {$_ ^ $r} @t; - dbg("challenge r: $r seed: $t[0] $t[1]" ) if isdbg('verify'); - return $self->{seed} = sha1_base64(@t, gettimeofday, rand, rand, rand, @_); + return $self->{seed} = sha1_base64('RbG4tST2dYPWnh6bfAaq7pPSL04', @_); } -sub response +sub newsalt { my $self = shift; - return sha1_base64($self->{seed}, @_); + return $self->{salt} = substr sha1_base64($self->{seed}, rand, rand, rand), 0, 6; +} + +sub challenge +{ + my $self = shift; + return $self->{salt} . sha1_base64($self->{salt}, $self->{seed}, @_); } sub verify { my $self = shift; my $answer = shift; - my $p = sha1_base64($self->{seed}, @_); + my $p = sha1_base64($self->{salt}, $self->{seed}, @_); return $p eq $answer; } +sub seed +{ + my $self = shift; + return @_ ? $self->{seed} = shift : $self->{seed}; +} + +sub salt +{ + my $self = shift; + return @_ ? $self->{salt} = shift : $self->{salt}; +} 1; diff --git a/perl/cluster.pl b/perl/cluster.pl index 20726684..1448ba91 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -68,7 +68,7 @@ use DXCommandmode; use DXProtVars; use DXProtout; use DXProt; -use QXProt; +use Aranea; use DXMsg; use DXCron; use DXConnect; @@ -226,29 +226,10 @@ sub new_channel # set callbacks $conn->set_error(sub {error_handler($dxchan)}); - $conn->set_rproc(sub {my ($conn,$msg) = @_; rec($dxchan, $conn, $msg);}); - rec($dxchan, $conn, $msg); + $conn->set_rproc(sub {my ($conn,$msg) = @_; $dxchan->rec($msg);}); + $dxchan->rec($msg); } -sub rec -{ - my ($dxchan, $conn, $msg) = @_; - - # queue the message and the channel object for later processing - if (defined $msg) { - my $self = bless {}, "inqueue"; - $self->{dxchan} = $dxchan; - $self->{data} = $msg; - push @inqueue, $self; - } -} - -# remove any outstanding entries on the inqueue after a disconnection (usually) -sub clean_inqueue -{ - my $dxchan = shift; - @inqueue = grep {$_->{dxchan} != $dxchan} @inqueue; -} sub login { @@ -325,45 +306,6 @@ sub reap # this is where the input queue is dealt with and things are dispatched off to other parts of # the cluster -sub process_inqueue -{ - while (@inqueue) { - my $self = shift @inqueue; - return if !$self; - - my $data = $self->{data}; - my $dxchan = $self->{dxchan}; - my $error; - my ($sort, $call, $line) = DXChannel::decode_input($dxchan, $data); - return unless defined $sort; - - # do the really sexy console interface bit! (Who is going to do the TK interface then?) - dbg("<- $sort $call $line") if $sort ne 'D' && isdbg('chan'); - if ($self->{disconnecting}) { - dbg('In disconnection, ignored'); - next; - } - - # handle A records - my $user = $dxchan->user; - if ($sort eq 'A' || $sort eq 'O') { - $dxchan->start($line, $sort); - } elsif ($sort eq 'I') { - die "\$user not defined for $call" if !defined $user; - - # normal input - $dxchan->normal($line); - } elsif ($sort eq 'Z') { - $dxchan->disconnect; - } elsif ($sort eq 'D') { - ; # ignored (an echo) - } elsif ($sort eq 'G') { - $dxchan->enhanced($line); - } else { - print STDERR atime, " Unknown command letter ($sort) received from $call\n"; - } - } -} sub uptime { @@ -438,10 +380,12 @@ dbg("Internal port: $clusteraddr $clusterport using IntMsg"); foreach my $l (@main::listen) { no strict 'refs'; my $pkg = $l->[2] || 'ExtMsg'; - $conn = $pkg->new_server($l->[0], $l->[1], \&login); - $conn->conns("Server $l->[0]/$l->[1] using $pkg"); + my $login = $l->[3] || 'login'; + + $conn = $pkg->new_server($l->[0], $l->[1], \&{"${pkg}::${login}"}); + $conn->conns("Server $l->[0]/$l->[1] using ${pkg}::${login}"); push @listeners, $conn; - dbg("External Port: $l->[0] $l->[1] using $pkg"); + dbg("External Port: $l->[0] $l->[1] using ${pkg}::${login}"); } dbg("AGW Listener") if $AGWMsg::enable; @@ -501,7 +445,7 @@ Spot->init(); # initialise the protocol engine dbg("Start Protocol Engines ..."); DXProt->init(); -QXProt->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)); @@ -545,7 +489,9 @@ for (;;) { Msg->event_loop(10, 0.010); my $timenow = time; - process_inqueue(); # read in lines from the input queue and despatch them + + DXChannel::process(); + # $DB::trace = 0; # do timed stuff, ongoing processing happens one a second @@ -555,7 +501,7 @@ for (;;) { DXCron::process(); # do cron jobs DXCommandmode::process(); # process ongoing command mode stuff DXProt::process(); # process ongoing ak1a pcxx stuff - QXProt::process(); + Aranea::process(); DXConnect::process(); DXMsg::process(); DXDb::process(); @@ -563,9 +509,6 @@ for (;;) { DXDupe::process(); AGWMsg::process(); - # this where things really start to happen (in DXSpider 2) - Thingy::process(); - eval { Local::process(); # do any localised processing };