2 # The new protocol for real at last
6 # Copyright (c) 2005 Dirk Koopman G1TLH
20 use Time::HiRes qw(gettimeofday tv_interval);
28 use vars qw($VERSION $BRANCH);
29 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
30 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0));
31 $main::build += $VERSION;
32 $main::branch += $BRANCH;
34 use vars qw(@ISA $ntpflag $dupeage);
38 $ntpflag = 0; # should be set in startup if NTP in use
39 $dupeage = 12*60*60; # duplicates stored half a day
51 my $self = DXChannel::alloc(@_);
53 # add this node to the table, the values get filled in later
56 $main::routeroot->add($call, '5000', Route::here(1)) if $call ne $main::mycall;
57 $self->{'sort'} = 'W';
63 my ($self, $line, $sort) = @_;
64 my $call = $self->{call};
65 my $user = $self->{user};
68 my $host = $self->{conn}->{peerhost} || "unknown";
69 Log('Aranea', "$call connected from $host");
71 # remember type of connection
72 $self->{consort} = $line;
73 $self->{outbound} = $sort eq 'O';
74 my $priv = $user->priv;
75 $priv = $user->priv(1) unless $priv;
76 $self->{priv} = $priv; # other clusters can always be 'normal' users
77 $self->{lang} = $user->lang || 'en';
78 $self->{consort} = $line; # save the connection type
82 # sort out registration
83 $self->{registered} = 1;
85 # get the output filters
86 $self->{spotsfilter} = Filter::read_in('spots', $call, 0) || Filter::read_in('spots', 'node_default', 0);
87 $self->{wwvfilter} = Filter::read_in('wwv', $call, 0) || Filter::read_in('wwv', 'node_default', 0);
88 $self->{wcyfilter} = Filter::read_in('wcy', $call, 0) || Filter::read_in('wcy', 'node_default', 0);
89 $self->{annfilter} = Filter::read_in('ann', $call, 0) || Filter::read_in('ann', 'node_default', 0) ;
90 $self->{routefilter} = Filter::read_in('route', $call, 0) || Filter::read_in('route', 'node_default', 0) unless $self->{isolate} ;
93 # get the INPUT filters (these only pertain to Clusters)
94 $self->{inspotsfilter} = Filter::read_in('spots', $call, 1) || Filter::read_in('spots', 'node_default', 1);
95 $self->{inwwvfilter} = Filter::read_in('wwv', $call, 1) || Filter::read_in('wwv', 'node_default', 1);
96 $self->{inwcyfilter} = Filter::read_in('wcy', $call, 1) || Filter::read_in('wcy', 'node_default', 1);
97 $self->{inannfilter} = Filter::read_in('ann', $call, 1) || Filter::read_in('ann', 'node_default', 1);
98 $self->{inroutefilter} = Filter::read_in('route', $call, 1) || Filter::read_in('route', 'node_default', 1) unless $self->{isolate};
100 $self->conn->echo(0) if $self->conn->can('echo');
102 # ping neighbour node stuff
103 my $ping = $user->pingint;
104 $ping = $DXProt::pingint unless defined $ping;
105 $self->{pingint} = $ping;
106 $self->{nopings} = $user->nopings || $DXProt::obscount;
107 $self->{pingtime} = [ ];
108 $self->{pingave} = 999;
109 $self->{metric} ||= 100;
110 $self->{lastping} = $main::systime;
112 $self->state('init');
113 $self->{pc50_t} = $main::systime;
115 # send info to all logged in thingies
116 $self->tell_login('loginn');
118 # run a script send the output to the debug file
119 my $script = new Script(lc $call) || new Script('node_default');
120 $script->run($self) if $script;
121 $self->send("Hello?");
125 # This is the normal despatcher
129 my ($self, $line) = @_;
135 # periodic processing
142 $dayno = (gmtime($main::systime))[3];
146 # generate new header (this is a general subroutine, not a method
147 # because it has to be used before a channel is fully initialised).
156 my $date = ((($dayno << 1) | $ntpflag) << 18) | ($main::systime % 86400);
157 my $r = "$mycall,$to," . sprintf('%06X%04X,0', $date, $seqno);
158 $r .= ",$from" if $from;
160 $seqno = 0 if $seqno > 0x0ffff;
164 # subroutines to encode and decode values in lists
168 $s =~ s/([\%=|,\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg;
175 $s =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg;
183 my $head = genheader($thing->{origin},
184 ($thing->{group} || $thing->{touser} || $thing->{tonode}),
185 ($thing->{user} || $thing->{fromuser} || $thing->{fromnode})
190 my $v = tencode(shift);
194 return "$head|$data";
200 my ($head, $data) = split /\|/, $line, 2;
201 return unless $head && $data;
202 my ($origin, $group, $dts, $hop, $user) = split /,/, $head;
203 return if DXDupe::add("Ara,$origin,$dts", $dupeage);
205 my ($cmd, $rdata) = split /,/, $data, 2;
206 my $class = 'Thingy::' . ucfirst $cmd;
209 # create the appropriate Thingy
210 if (defined *$class) {
211 $thing = $class->new();
213 # reconstitute the header but wth hop increased by one
214 $head = join(',', $origin, $group, $dts, $hop);
215 $head .= ",$user" if $user;
216 $thing->{Aranea} = "$head|$data";
219 $thing->{origin} = $origin;
220 $thing->{group} = $group;
221 $thing->{time} = decode_dts($dts);
222 $thing->{user} = $user if $user;
223 $thing->{hopsaway} = $hop;
225 while (my ($k,$v) = split /,/, $rdata) {
226 $thing->{$k} = tdecode($v);