locators
show/locator gb7dxc - bearing and distance to gb7dxc if poss.
+* It is important that you remember when you have tie hashes using MLDBM
+ et al. If you do a DXUser->get($call) you will get a different (older)
+ thing than the one in $self->$user. This is almost certainly NOT what
+ you want if want to modify a user that is currently connected.
+
* Anything you output with a > as the last character is taken to mean
that this is a prompt and will not have a \r or \n appended to it.
# $Id$
#
+use strict;
my ($self, $line) = @_;
-my @list = /\s+/, $line; # generate a list of callsigns
-@list = ($self->call) if (!@list || $self->priv < 9); # my channel if no callsigns
+my @list = split /\s+/, $line; # generate a list of callsigns
+@list = ($self->call) if !@list || $self->priv < 9; # my channel if no callsigns
my $call;
my @out;
+#
+# show either the current user or a nominated set
+#
+# $Id$
+#
+
+my ($self, $line) = @_;
+my @list = DXChannel->get_all();
+my $chan;
+my @out;
+foreach $chan (@list) {
+ push @out, "Callsign: $chan->{call}";
+}
+
+return (1, @out);
call => '0,Callsign',
conn => '9,Msg Conn ref',
user => '9,DXUser ref',
- t => '0,Time,atime',
+ startt => '0,Start Time,atime',
+ t => '9,Time,atime',
priv => '9,Privilege',
state => '0,Current State',
oldstate => '5,Last State',
list => '9,Dep Chan List',
name => '0,User Name',
- consort => '9,Connection Type'
+ consort => '9,Connection Type',
+ sort => '9,Type of Channel',
);
$self->{call} = $call;
$self->{conn} = $conn if defined $conn; # if this isn't defined then it must be a list
$self->{user} = $user if defined $user;
- $self->{t} = time;
+ $self->{startt} = $self->{t} = time;
$self->{state} = 0;
$self->{oldstate} = 0;
bless $self, $pkg;
{
my $self = shift;
my $conn = $self->{conn};
-
- # is this a list of channels ?
- if (!defined $conn) {
- die "tried to send_now to an invalid channel list" if !defined $self->{list};
- my $lself;
- foreach $lself (@$self->{list}) {
- $lself->send_now(@_); # it's recursive :-)
- }
- } else {
- my $sort = shift;
- my $call = $self->{call};
- my $line;
+ my $sort = shift;
+ my $call = $self->{call};
+ my $line;
- foreach $line (@_) {
- chomp $line;
- dbg('chan', "-> $sort $call $line\n");
- $conn->send_now("$sort$call|$line");
- }
+ foreach $line (@_) {
+ chomp $line;
+ dbg('chan', "-> $sort $call $line\n");
+ $conn->send_now("$sort$call|$line");
}
+ $self->{t} = time;
}
#
{
my $self = shift;
my $conn = $self->{conn};
-
- # is this a list of channels ?
- if (!defined $conn) {
- die "tried to send to an invalid channel list" if !defined $self->{list};
- my $lself;
- foreach $lself (@$self->{list}) {
- $lself->send(@_); # here as well :-) :-)
- }
- } else {
- my $call = $self->{call};
- my $line;
-
- foreach $line (@_) {
- chomp $line;
- dbg('chan', "-> D $call $line\n");
- $conn->send_later("D$call|$line");
- }
+ my $call = $self->{call};
+ my $line;
+
+ foreach $line (@_) {
+ chomp $line;
+ dbg('chan', "-> D $call $line\n");
+ $conn->send_later("D$call|$line");
}
+ $self->{t} = time;
}
# send a file (always later)
$self->{priv} = $user->priv;
$self->{priv} = 0 if $line =~ /^(ax|te)/; # set the connection priv to 0 - can be upgraded later
$self->{consort} = $line; # save the connection type
+ $self->sort('U'); # set the channel type
}
#
#
sub process
{
+ my $t = time;
+ my @chan = DXChannel->get_all();
+ my $chan;
+
+ foreach $chan (@chan) {
+ next if $chan->sort ne 'U';
+ # send a prompt if no activity out on this channel
+ if ($t >= $chan->t + $main::user_interval) {
+ $chan->prompt() if $chan->{state} =~ /^prompt/o;
+ $chan->t($t);
+ }
+ }
}
#
@ISA = qw(DXChannel);
+use strict;
+
use DXUtil;
use DXChannel;
use DXUser;
my $self = shift;
my $call = $self->call;
+ # set the channel sort
+ $self->sort('A');
+
+ # set unbuffered
+ self->send_now('B',"0");
+
# do we have him connected on the cluster somewhere else?
- $self->pc38();
- $self->pc18();
+ $self->send(pc38());
+ $self->send(pc18());
$self->{state} = 'incoming';
}
#
sub process
{
-
+ my $t = time;
+ my @chan = DXChannel->get_all();
+ my $chan;
+
+ foreach $chan (@chan) {
+ next if $chan->sort ne 'A';
+
+ # send a pc50 out on this channel
+ if ($t >= $chan->t + $main::pc50_interval) {
+ $chan->send(pc50());
+ $chan->t($t);
+ }
+ }
}
#
}
#
-# All the various PC routines
+# some active measures
#
-sub pc18
+sub broadcast
{
+ my $s = shift;
+ $s = shift if ref $s; # if I have been called $self-> ignore it.
+ my @except = @_; # to all channels EXCEPT these (dxchannel refs)
+ my @chan = DXChannel->get_all();
+ my ($chan, $except);
+
+L: foreach $chan (@chan) {
+ next if $chan->sort != 'A'; # only interested in ak1a channels
+ foreach $except (@except) {
+ next L if $except == $chan; # ignore channels in the 'except' list
+ }
+ chan->send($s); # send it
+ }
+}
+#
+# All the PCxx generation routines
+#
+
+sub pc18
+{
+ return "PC18^wot a load of twaddle^$main::myprot_version^~";
}
+# send all the DX clusters I reckon are connected
sub pc38
{
-
+ my @list = DXNode->get_all();
+ my $list;
+ my @nodes;
+
+ foreach $list (@list) {
+ push @nodes, $list->call;
+ }
+ return "PC38^" . join(',', @nodes) . "^~";
}
+sub pc50
+{
+ my $n = DXUsers->count;
+ return "PC50^$main::mycall^$n^H99^";
+}
1;
__END__
@ISA = qw(Exporter);
@EXPORT_OK = qw($mycall $myname $myalias $mylatitude $mylongtitude $mylocator
- $myqth $myemail $myprot
+ $myqth $myemail $myprot_version
$clusterport $clusteraddr $debugfn
$def_hopcount $root $data $system $cmd
$userfn $motd $local_cmd $mybbsaddr
+ $pc50_interval, $user_interval
);
$debugfn = "/tmp/debug_cluster";
# the version of DX cluster (tm) software I am masquerading as
-$myprot = "5447";
+$myprot_version = "5447";
# your favorite way to say 'Yes'
$yes = 'Yes';
# your favorite way to say 'No'
$no = 'No';
+# the interval between pc50s (in seconds)
+$pc50_interval = 14*60;
+
+# the interval between unsolicited prompts if not traffic
+$user_interval = 11*60;
+
# default hopcount to use - note this will override any incoming hop counts, if they are greater
$def_hopcount = 7;
# $Id$
#
+# search local then perl directories
BEGIN {
+ unshift @INC, "/spider/perl"; # this IS the right way round!
unshift @INC, "/spider/local";
- unshift @INC, "/spider/perl";
}
use Msg;
$conn = 0; # the connection object for the cluster
$lastbit = ""; # the last bit of an incomplete input line
$mynl = "\n"; # standard terminator
+$lasttime = time; # lasttime something happened on the interface
+$outqueue = ""; # the output queue length
+$buffered = 1; # buffer output
+$savenl = ""; # an NL that has been saved from last time
# cease communications
sub cease
if ($sort eq 'D') {
my $snl = $mynl;
+ my $newsavenl = "";
$snl = "" if $mode == 0;
- $snl = ' ' if ($mode && $line =~ />$/);
+ if ($mode && $line =~ />$/) {
+ $newsavenl = $snl;
+ $snl = ' ';
+ }
$line =~ s/\n/\r/og if $mode == 1;
#my $p = qq($line$snl);
- print $line, $snl;
+ if ($buffered) {
+ if (length $outqueue >= 128) {
+ print $outqueue;
+ $outqueue = "";
+ }
+ $outqueue .= "$savenl$line$snl";
+ $lasttime = time;
+ } else {
+ print $savenl, $line, $snl;;
+ }
+ $savenl = $newsavenl;
} elsif ($sort eq 'M') {
$mode = $line; # set new mode from cluster
setmode();
+ } elsif ($sort eq 'B') {
+ if ($buffered && $outqueue) {
+ print $outqueue;
+ $outqueue = "";
+ }
+ $buffered = $line; # set buffered or unbuffered
} elsif ($sort eq 'Z') { # end, disconnect, go, away .....
cease(0);
}
- }
+ }
+ $lasttime = time;
}
sub rec_stdin
foreach $first (@lines) {
$conn->send_now("D$call|$first");
}
- $lastbit = $buf;
+ $lastbit = $buf;
+ $savenl = ""; # reset savenl 'cos we will have done a newline on input
} else {
$conn->send_now("D$call|$buf");
}
} elsif ($r == 0) {
cease(1);
}
+ $lasttime = time;
}
$call = uc shift @ARGV;
$conn->send_now("A$call|$connsort");
Msg->set_event_handler(\*STDIN, "read" => \&rec_stdin);
-$lasttime = time;
for (;;) {
my $t;
Msg->event_loop(1, 0.010);
$t = time;
- if (t > $lasttime+660 && $connsort =~ /^ax/o) { # every e
- print pack('xx');
- STDOUT->fflush();
+ if ($t > $lasttime) {
+ if ($outqueue) {
+ print $outqueue;
+ $outqueue = "";
+ }
$lasttime = $t;
}
}
#!/usr/bin/perl
#
-# A thing that implements dxcluster 'protocol'
+# This is the DX cluster 'daemon'. It sits in the middle of its little
+# web of client routines sucking and blowing data where it may.
#
-# This is a perl module/program that sits on the end of a dxcluster
-# 'protocol' connection and deals with anything that might come along.
-#
-# this program is called by ax25d and gets raw ax25 text on its input
+# Hence the name of 'spider' (although it may become 'dxspider')
#
# Copyright (c) 1998 Dirk Koopman G1TLH
#
# $Id$
#
+# make sure that modules are searched in the order local then perl
+BEGIN {
+ unshift @INC, '/spider/perl'; # this IS the right way round!
+ unshift @INC, '/spider/local';
+}
+
use Msg;
use DXVars;
use DXUtil;
my $timenow;
Msg->event_loop(1, 0.001);
$timenow = time;
+ process_inqueue(); # read in lines from the input queue and despatch them
+
+ # do timed stuff, ongoing processing happens one a second
if ($timenow != $systime) {
$systime = $timenow;
$cldate = &cldate();
$ztime = &ztime();
+ DXCommandmode::process(); # process ongoing command mode stuff
+ DXProt::process(); # process ongoing ak1a pcxx stuff
}
- process_inqueue(); # read in lines from the input queue and despatch them
- DXCommandmode::process(); # process ongoing command mode stuff
- DXProt::process(); # process ongoing ak1a pcxx stuff
}
projects / spider.git / commitdiff