projects
/
spider.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
decrement the build to account for added modul
[spider.git]
/
perl
/
cluster.pl
diff --git
a/perl/cluster.pl
b/perl/cluster.pl
index 59ff51782a9a5f5b06bef219ec871a28ab8b9f85..a2664b7730f3f64676fcce922d3461b66fddc0e5 100755
(executable)
--- a/
perl/cluster.pl
+++ b/
perl/cluster.pl
@@
-26,14
+26,14
@@
BEGIN {
# do some validation of the input
die "The directory $root doesn't exist, please RTFM" unless -d $root;
die "$root/local doesn't exist, please RTFM" unless -d "$root/local";
# do some validation of the input
die "The directory $root doesn't exist, please RTFM" unless -d $root;
die "$root/local doesn't exist, please RTFM" unless -d "$root/local";
- die "$root/local/DXVars doesn't exist, please RTFM" unless -e "$root/local/DXVars.pm";
+ die "$root/local/DXVars
.pm
doesn't exist, please RTFM" unless -e "$root/local/DXVars.pm";
- mkdir "$root/local_cmd"
unless -e
"$root/local_cmd";
+ mkdir "$root/local_cmd"
, 0777 unless -d
"$root/local_cmd";
# try to create and lock a lockfile (this isn't atomic but
# should do for now
# try to create and lock a lockfile (this isn't atomic but
# should do for now
- $lockfn = "$root/
per
l/cluster.lck"; # lock file name
+ $lockfn = "$root/
loca
l/cluster.lck"; # lock file name
if (-e $lockfn) {
open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!";
my $pid = <CLLOCK>;
if (-e $lockfn) {
open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!";
my $pid = <CLLOCK>;
@@
-95,6
+95,13
@@
use Route;
use Route::Node;
use Route::User;
use Editable;
use Route::Node;
use Route::User;
use Editable;
+use Mrtg;
+use USDB;
+use UDPMsg;
+use QSL;
+use Thingy;
+use RouteDB;
+use AMsg;
use Data::Dumper;
use IO::File;
use Data::Dumper;
use IO::File;
@@
-113,7
+120,7
@@
use vars qw(@inqueue $systime $version $starttime $lockfn @outstanding_connects
@inqueue = (); # the main input queue, an array of hashes
$systime = 0; # the time now (in seconds)
@inqueue = (); # the main input queue, an array of hashes
$systime = 0; # the time now (in seconds)
-$version = "1.
49
"; # the version no of the software
+$version = "1.
51
"; # the version no of the software
$starttime = 0; # the starting time of the cluster
#@outstanding_connects = (); # list of outstanding connects
@listeners = (); # list of listeners
$starttime = 0; # the starting time of the cluster
#@outstanding_connects = (); # list of outstanding connects
@listeners = (); # list of listeners
@@
-121,8
+128,8
@@
$reqreg = 0; # 1 = registration required, 2 = deregister people
use vars qw($VERSION $BRANCH $build $branch);
$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
use vars qw($VERSION $BRANCH $build $branch);
$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
-$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/
) || 0
;
-$main::build += 1
2;
# add an offset to make it bigger than last system
+$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/
|| (0,0))
;
+$main::build += 1
;
# add an offset to make it bigger than last system
$main::build += $VERSION;
$main::branch += $BRANCH;
$main::build += $VERSION;
$main::branch += $BRANCH;
@@
-160,7
+167,7
@@
sub new_channel
# set up the basic channel info
# is there one already connected to me - locally?
# set up the basic channel info
# is there one already connected to me - locally?
- my $user = DXUser->get($call);
+ my $user = DXUser->get
_current
($call);
my $dxchan = DXChannel->get($call);
if ($dxchan) {
my $mess = DXM::msg($lang, ($user && $user->is_node) ? 'concluster' : 'conother', $call, $main::mycall);
my $dxchan = DXChannel->get($call);
if ($dxchan) {
my $mess = DXM::msg($lang, ($user && $user->is_node) ? 'concluster' : 'conother', $call, $main::mycall);
@@
-171,7
+178,7
@@
sub new_channel
# is he locked out ?
my $basecall = $call;
$basecall =~ s/-\d+$//;
# is he locked out ?
my $basecall = $call;
$basecall =~ s/-\d+$//;
- my $baseuser = DXUser->get($basecall);
+ my $baseuser = DXUser->get
_current
($basecall);
my $lock = $user->lockout if $user;
if ($baseuser && $baseuser->lockout || $lock) {
if (!$user || !defined $lock || $lock) {
my $lock = $user->lockout if $user;
if ($baseuser && $baseuser->lockout || $lock) {
if (!$user || !defined $lock || $lock) {
@@
-188,11
+195,8
@@
sub new_channel
$user = DXUser->new($call);
}
$user = DXUser->new($call);
}
-
# create the channel
# create the channel
- if ($user->is_spider) {
- $dxchan = QXProt->new($call, $conn, $user);
- } elsif ($user->is_node) {
+ if ($user->is_node) {
$dxchan = DXProt->new($call, $conn, $user);
} elsif ($user->is_user) {
$dxchan = DXCommandmode->new($call, $conn, $user);
$dxchan = DXProt->new($call, $conn, $user);
} elsif ($user->is_user) {
$dxchan = DXCommandmode->new($call, $conn, $user);
@@
-224,6
+228,13
@@
sub rec
}
}
}
}
+# remove any outstanding entries on the inqueue after a disconnection (usually)
+sub clean_inqueue
+{
+ my $dxchan = shift;
+ @inqueue = grep {$_->{dxchan} != $dxchan} @inqueue;
+}
+
sub login
{
return \&new_channel;
sub login
{
return \&new_channel;
@@
-260,6
+271,9
@@
sub cease
# disconnect AGW
AGWMsg::finish();
# disconnect AGW
AGWMsg::finish();
+ # disconnect UDP customers
+ UDPMsg::finish();
+
# end everything else
Msg->event_loop(100, 0.01);
DXUser::finish();
# end everything else
Msg->event_loop(100, 0.01);
DXUser::finish();
@@
-309,7
+323,7
@@
sub process_inqueue
return unless defined $sort;
# do the really sexy console interface bit! (Who is going to do the TK interface then?)
return unless defined $sort;
# do the really sexy console interface bit! (Who is going to do the TK interface then?)
- dbg("<- $sort $call $line
\n
") if $sort ne 'D' && isdbg('chan');
+ dbg("<- $sort $call $line") if $sort ne 'D' && isdbg('chan');
if ($self->{disconnecting}) {
dbg('In disconnection, ignored');
next;
if ($self->{disconnecting}) {
dbg('In disconnection, ignored');
next;
@@
-380,7
+394,9
@@
dbg("DXSpider Version $version, build $build started");
# load Prefixes
dbg("loading prefixes ...");
# load Prefixes
dbg("loading prefixes ...");
-Prefix::load();
+dbg(USDB::init());
+my $r = Prefix::init();
+confess $r if $r;
# load band data
dbg("loading band data ...");
# load band data
dbg("loading band data ...");
@@
-401,17
+417,24
@@
DXUser->init($userfn, 1);
# start listening for incoming messages/connects
dbg("starting listeners ...");
my $conn = IntMsg->new_server($clusteraddr, $clusterport, \&login);
# start listening for incoming messages/connects
dbg("starting listeners ...");
my $conn = IntMsg->new_server($clusteraddr, $clusterport, \&login);
-$conn->conns("Server $clusteraddr/$clusterport");
+$conn->conns("Server $clusteraddr/$clusterport
using IntMsg
");
push @listeners, $conn;
push @listeners, $conn;
-dbg("Internal port: $clusteraddr $clusterport");
+dbg("Internal port: $clusteraddr $clusterport
using IntMsg
");
foreach my $l (@main::listen) {
foreach my $l (@main::listen) {
- $conn = ExtMsg->new_server($l->[0], $l->[1], \&login);
- $conn->conns("Server $l->[0]/$l->[1]");
+ 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");
push @listeners, $conn;
push @listeners, $conn;
- dbg("External Port: $l->[0] $l->[1]");
+ dbg("External Port: $l->[0] $l->[1]
using $pkg
");
}
}
+
+dbg("AGW Listener") if $AGWMsg::enable;
AGWrestart();
AGWrestart();
+dbg("UDP Listener") if $UDPMsg::enable;
+UDPMsg::init(\&new_channel);
+
# load bad words
dbg("load badwords: " . (BadWords::load or "Ok"));
# load bad words
dbg("load badwords: " . (BadWords::load or "Ok"));
@@
-439,24
+462,31
@@
unless ($is_win) {
}
# start dupe system
}
# start dupe system
+dbg("Starting Dupe system");
DXDupe::init();
# read in system messages
DXDupe::init();
# read in system messages
+dbg("Read in Messages");
DXM->init();
# read in command aliases
DXM->init();
# read in command aliases
+dbg("Read in Aliases");
CmdAlias->init();
# initialise the Geomagnetic data engine
CmdAlias->init();
# initialise the Geomagnetic data engine
+dbg("Start WWV");
Geomag->init();
Geomag->init();
+dbg("Start WCY");
WCY->init();
# initial the Spot stuff
WCY->init();
# initial the Spot stuff
+dbg("Starting DX Spot system");
Spot->init();
# initialise the protocol engine
Spot->init();
# initialise the protocol engine
-dbg("
reading in duplicate spot and WWV info
...");
+dbg("
Start Protocol Engines
...");
DXProt->init();
DXProt->init();
+QXProt->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));
# 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));
@@
-482,6
+512,7
@@
DXDb::load();
# starting local stuff
dbg("doing local initialisation ...");
# starting local stuff
dbg("doing local initialisation ...");
+QSL::init(1);
eval {
Local::init();
};
eval {
Local::init();
};
@@
-516,7
+547,10
@@
for (;;) {
DXUser::process();
DXDupe::process();
AGWMsg::process();
DXUser::process();
DXDupe::process();
AGWMsg::process();
-
+
+ # this where things really start to happen (in DXSpider 2)
+ Thingy::process();
+
eval {
Local::process(); # do any localised processing
};
eval {
Local::process(); # do any localised processing
};