}
}
+sub login
+{
+ goto &main::login; # save some writing, this was the default
+}
+
sub active
{
return $sock;
#
# $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+)/ );
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
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');
}
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);
}
}
}
- }
+ }
}
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($_);
+ }
+}
--- /dev/null
+#
+# 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;
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);
$self->{itu} = $dxcc[1]->itu;
$self->{cq} = $dxcc[1]->cq;
}
+ $self->{inqueue} = [];
$count++;
dbg("DXChannel $self->{call} created ($count)") if isdbg('chan');
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
{
# obtain all the channel objects
sub get_all
{
- my ($pkg) = @_;
return values(%channels);
}
sub is_node
{
my $self = shift;
- return $self->{'sort'} =~ /[ACRSX]/;
+ return $self->{'sort'} =~ /[ACRSXW]/;
}
# is it an ak1a node ?
sub is_ak1a
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
{
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();
{
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
{
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
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;
}
}
+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
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);
{
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;
}
#
@ISA = qw(Msg);
$deftimeout = 60;
+sub login
+{
+ goto &main::login; # save some writing, this was the default
+}
+
sub enqueue
{
my ($conn, $msg) = @_;
@ISA = qw(Msg);
+sub login
+{
+ goto &main::login; # save some writing, this was the default
+}
+
sub enqueue
{
my ($conn, $msg) = @_;
# Copyright (c) 2004 Dirk Koopman G1TLH
#
+use strict;
+
package Thingy;
use vars qw($VERSION $BRANCH);
$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;
--- /dev/null
+#
+# 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;
# $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));
{
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;
use DXProtVars;
use DXProtout;
use DXProt;
-use QXProt;
+use Aranea;
use DXMsg;
use DXCron;
use DXConnect;
# 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
{
# 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
{
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;
# 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));
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
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();
DXDupe::process();
AGWMsg::process();
- # this where things really start to happen (in DXSpider 2)
- Thingy::process();
-
eval {
Local::process(); # do any localised processing
};
projects / spider.git / commitdiff