+++ /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;
projects / spider.git / blobdiff