-#!/usr/bin/perl -w
+#!/usr/bin/env perl
#
# 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.
#
#
+package main;
+
require 5.10.1;
+use warnings;
# make sure that modules are searched in the order local then perl
BEGIN {
die "$root/local doesn't exist, please RTFM" unless -d "$root/local";
die "$root/local/DXVars.pm doesn't exist, please RTFM" unless -e "$root/local/DXVars.pm";
- mkdir "$root/local_cmd", 0777 unless -d "$root/local_cmd";
-
+ # create some directories
+ mkdir "$root/local_cmd", 02777 unless -d "$root/local_cmd";
+ mkdir "$root/local_data", 02777 unless -d "$root/local_data";
# try to create and lock a lockfile (this isn't atomic but
# should do for now
- $lockfn = "$root/local/cluster.lck"; # lock file name
+ $lockfn = "$root/local_data/cluster.lck"; # lock file name
if (-w $lockfn) {
open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!";
my $pid = <CLLOCK>;
if ($pid) {
chomp $pid;
- die "Lockfile ($lockfn) and process $pid exist, another cluster running?" if kill 0, $pid;
+ if (kill 0, $pid) {
+ warn "Lockfile ($lockfn) and process $pid exist, another cluster running?\n";
+ exit 1;
+ }
}
unlink $lockfn;
close CLLOCK;
$systime = time;
}
+
use Mojo::IOLoop;
use DXVars;
+use SysVar;
+
use Msg;
use IntMsg;
use Internet;
use Fcntl ':flock';
use POSIX ":sys_wait_h";
use Version;
+use Web;
use Local;
$zombies $root @listeners $lang $myalias @debug $userfn $clusteraddr
$clusterport $mycall $decease $is_win $routeroot $me $reqreg $bumpexisting
$allowdxby $dbh $dsn $dbuser $dbpass $do_xml $systime_days $systime_daystart
- $can_encode $maxconnect_user $maxconnect_node $idle_interval
+ $can_encode $maxconnect_user $maxconnect_node $idle_interval $log_flush_interval
+ $broadcast_debug
);
@inqueue = (); # the main input queue, an array of hashes
$maxconnect_node = 0; # Ditto but for nodes. In either case if a new incoming connection
# takes the no of references in the routing table above these numbers
# then the connection is refused. This only affects INCOMING connections.
-$idle_interval = 0.500; # the wait between invocations of the main idle loop processing.
-our $ending; # signal that we are ending;
+$idle_interval = 0.500; # the wait between invocations of the main idle loop processing.
+$log_flush_interval = 2; # interval to wait between log flushes
+
+our $ending; # signal that we are ending;
+our $broadcast_debug; # allow broadcasting of debug info down "enhanced" user connections
# send a message to call on conn and disconnect
AGWMsg::process();
Timer::handler();
- DXLog::flush_all();
+ DXLog::flushall();
}
if (defined &Local::process) {
}
}
+sub setup_start
+{
-#############################################################
-#
-# The start of the main line of code
-#
-#############################################################
-
-$starttime = $systime = time;
-$systime_days = int ($systime / 86400);
-$systime_daystart = $systime_days * 86400;
-$lang = 'en' unless $lang;
-
-unless ($DB::VERSION) {
- $SIG{INT} = $SIG{TERM} = \&cease;
-}
-
-# open the debug file, set various FHs to be unbuffered
-dbginit(\&DXCommandmode::broadcast_debug);
-foreach (@debug) {
- dbgadd($_);
-}
-STDOUT->autoflush(1);
+ #############################################################
+ #
+ # The start of the main line of code
+ #
+ #############################################################
-# try to load the database
-if (DXSql::init($dsn)) {
- $dbh = DXSql->new($dsn);
- $dbh = $dbh->connect($dsn, $dbuser, $dbpass) if $dbh;
-}
+ $starttime = $systime = time;
+ $systime_days = int ($systime / 86400);
+ $systime_daystart = $systime_days * 86400;
+ $lang = 'en' unless $lang;
-# try to load Encode
-{
- local $^W = 0;
- my $w = $SIG{__DIE__};
- $SIG{__DIE__} = 'IGNORE';
- eval { require Encode; };
- unless ($@) {
- import Encode;
- $can_encode = 1;
+ unless ($DB::VERSION) {
+ $SIG{INT} = $SIG{TERM} = \&cease;
}
- $SIG{__DIE__} = $w;
-}
-
-# try to load XML::Simple
-DXXml::init();
-# banner
-my ($year) = (gmtime)[5];
-$year += 1900;
-LogDbg('cluster', "DXSpider V$version, build $build (git: $gitversion) started");
-dbg("Copyright (c) 1998-$year Dirk Koopman G1TLH");
-
-# load Prefixes
-dbg("loading prefixes ...");
-dbg(USDB::init());
-my $r = Prefix::init();
-confess $r if $r;
+ # open the debug file, set various FHs to be unbuffered
+ dbginit($broadcast_debug ? \&DXCommandmode::broadcast_debug : undef);
+ foreach (@debug) {
+ dbgadd($_);
+ }
+ STDOUT->autoflush(1);
-# load band data
-dbg("loading band data ...");
-Bands::load();
+
+ # try to load the database
+ if (DXSql::init($dsn)) {
+ $dbh = DXSql->new($dsn);
+ $dbh = $dbh->connect($dsn, $dbuser, $dbpass) if $dbh;
+ }
-# initialise User file system
-dbg("loading user file system ...");
-DXUser->init($userfn, 1);
+ # try to load Encode and Git
+ {
+ local $^W = 0;
+ my $w = $SIG{__DIE__};
+ $SIG{__DIE__} = 'IGNORE';
+ eval { require Encode; };
+ unless ($@) {
+ import Encode;
+ $can_encode = 1;
+ }
+ eval { require Git; };
+ unless ($@) {
+ import Git;
+
+ # determine the real version number
+ my $repo = Git->repository(Directory => "$root/.git");
+ if ($repo) {
+ my $desc = $repo->command_oneline(['describe', '--long'], STDERR => 0);
+ if ($desc) {
+ my ($v, $s, $b, $g) = $desc =~ /^([\d.]+)(?:\.(\d+))?-(\d+)-g([0-9a-f]+)/;
+ $version = $v;
+ $build = $b || 0;
+ $gitversion = "$g\[r]";
+ }
+ }
+ }
+ $SIG{__DIE__} = $w;
+ }
-# look for the sysop and the alias user and complain if they aren't there
-{
- die "\$myalias \& \$mycall are the same ($mycall)!, they must be different (hint: make \$mycall = '${mycall}-2';). Oh and don't forget to rerun create_sysop.pl!" if $mycall eq $myalias;
- my $ref = DXUser::get($mycall);
- die "$mycall missing, run the create_sysop.pl script and please RTFM" unless $ref && $ref->priv == 9;
- $ref = DXUser::get($myalias);
- die "$myalias missing, run the create_sysop.pl script and please RTFM" unless $ref && $ref->priv == 9;
-}
+ # try to load XML::Simple
+ DXXml::init();
+
+ # banner
+ my ($year) = (gmtime)[5];
+ $year += 1900;
+ LogDbg('cluster', "DXSpider V$version, build $build (git: $gitversion) started");
+ dbg("Copyright (c) 1998-$year Dirk Koopman G1TLH");
+
+ # load Prefixes
+ dbg("loading prefixes ...");
+ dbg(USDB::init());
+ my $r = Prefix::init();
+ confess $r if $r;
+
+ # load band data
+ dbg("loading band data ...");
+ Bands::load();
+
+ # initialise User file system
+ dbg("loading user file system ...");
+ DXUser::init(1);
+
+ # look for the sysop and the alias user and complain if they aren't there
+ {
+ die "\$myalias \& \$mycall are the same ($mycall)!, they must be different (hint: make \$mycall = '${mycall}-2';). Oh and don't forget to rerun create_sysop.pl!" if $mycall eq $myalias;
+ my $ref = DXUser::get($mycall);
+ die "$mycall missing, run the create_sysop.pl script and please RTFM" unless $ref && $ref->priv == 9;
+ my $oldsort = $ref->sort;
+ if ($oldsort ne 'S') {
+ $ref->sort('S');
+ dbg "Resetting node type from $oldsort -> DXSpider ('S')";
+ }
+ $ref = DXUser::get($myalias);
+ die "$myalias missing, run the create_sysop.pl script and please RTFM" unless $ref && $ref->priv == 9;
+ $oldsort = $ref->sort;
+ if ($oldsort ne 'U') {
+ $ref->sort('U');
+ dbg "Resetting sysop user type from $oldsort -> User ('U')";
+ }
+ }
-# start listening for incoming messages/connects
-dbg("starting listeners ...");
-my $conn = IntMsg->new_server($clusteraddr, $clusterport, \&login);
-$conn->conns("Server $clusteraddr/$clusterport using IntMsg");
-push @listeners, $conn;
-dbg("Internal port: $clusteraddr $clusterport using IntMsg");
-foreach my $l (@main::listen) {
- no strict 'refs';
- my $pkg = $l->[2] || 'ExtMsg';
- 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}");
+ # start listening for incoming messages/connects
+ dbg("starting listeners ...");
+ my $conn = IntMsg->new_server($clusteraddr, $clusterport, \&login);
+ $conn->conns("Server $clusteraddr/$clusterport using IntMsg");
push @listeners, $conn;
- dbg("External Port: $l->[0] $l->[1] using ${pkg}::${login}");
-}
-
-dbg("AGW Listener") if $AGWMsg::enable;
-AGWrestart();
-
-dbg("BPQ Listener") if $BPQMsg::enable;
-BPQMsg::init(\&new_channel);
+ dbg("Internal port: $clusteraddr $clusterport using IntMsg");
+ foreach my $l (@main::listen) {
+ no strict 'refs';
+ my $pkg = $l->[2] || 'ExtMsg';
+ 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}::${login}");
+ }
-dbg("UDP Listener") if $UDPMsg::enable;
-UDPMsg::init(\&new_channel);
+ dbg("AGW Listener") if $AGWMsg::enable;
+ AGWrestart();
-# load bad words
-dbg("load badwords: " . (BadWords::load or "Ok"));
+ dbg("BPQ Listener") if $BPQMsg::enable;
+ BPQMsg::init(\&new_channel);
-# prime some signals
-unless ($DB::VERSION) {
- $SIG{INT} = $SIG{TERM} = sub { $ending = 10; };
-}
+ dbg("UDP Listener") if $UDPMsg::enable;
+ UDPMsg::init(\&new_channel);
-unless ($is_win) {
- $SIG{HUP} = 'IGNORE';
- $SIG{CHLD} = sub { $zombies++ };
+ # load bad words
+ dbg("load badwords: " . (BadWords::load or "Ok"));
- $SIG{PIPE} = sub { dbg("Broken PIPE signal received"); };
- $SIG{IO} = sub { dbg("SIGIO received"); };
- $SIG{WINCH} = $SIG{STOP} = $SIG{CONT} = 'IGNORE';
- $SIG{KILL} = 'DEFAULT'; # as if it matters....
+ # prime some signals
+ unless ($DB::VERSION) {
+ $SIG{INT} = $SIG{TERM} = sub { $ending = 10; };
+ }
- # catch the rest with a hopeful message
- for (keys %SIG) {
- if (!$SIG{$_}) {
- # dbg("Catching SIG $_") if isdbg('chan');
- $SIG{$_} = sub { my $sig = shift; DXDebug::confess("Caught signal $sig"); };
+ unless ($is_win) {
+ $SIG{HUP} = 'IGNORE';
+ $SIG{CHLD} = sub { $zombies++ };
+
+ $SIG{PIPE} = sub { dbg("Broken PIPE signal received"); };
+ $SIG{IO} = sub { dbg("SIGIO received"); };
+ $SIG{WINCH} = $SIG{STOP} = $SIG{CONT} = 'IGNORE';
+ $SIG{KILL} = 'DEFAULT'; # as if it matters....
+
+ # catch the rest with a hopeful message
+ for (keys %SIG) {
+ if (!$SIG{$_}) {
+ # dbg("Catching SIG $_") if isdbg('chan');
+ $SIG{$_} = sub { my $sig = shift; DXDebug::confess("Caught signal $sig"); };
+ }
}
}
-}
-# start dupe system
-dbg("Starting Dupe system");
-DXDupe::init();
-
-# read in system messages
-dbg("Read in Messages");
-DXM->init();
-
-# read in command aliases
-dbg("Read in Aliases");
-CmdAlias->init();
-
-# initialise the Geomagnetic data engine
-dbg("Start WWV");
-Geomag->init();
-dbg("Start WCY");
-WCY->init();
-
-# initial the Spot stuff
-dbg("Starting DX Spot system");
-Spot->init();
-
-# initialise the protocol engine
-dbg("Start Protocol Engines ...");
-DXProt->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));
-$routeroot->do_pc9x(1);
-$routeroot->via_pc92(1);
-
-# make sure that there is a routing OUTPUT node default file
-#unless (Filter::read_in('route', 'node_default', 0)) {
-# my $dxcc = $main::me->dxcc;
-# $Route::filterdef->cmd($main::me, 'route', 'accept', "node_default call $mycall" );
-#}
-
-# read in any existing message headers and clean out old crap
-dbg("reading existing message headers ...");
-DXMsg->init();
-DXMsg::clean_old();
-
-# read in any cron jobs
-dbg("reading cron jobs ...");
-DXCron->init();
-
-# read in database desriptors
-dbg("reading database descriptors ...");
-DXDb::load();
-
-# starting local stuff
-dbg("doing local initialisation ...");
-QSL::init(1);
-if (defined &Local::init) {
- eval {
- Local::init();
- };
- dbg("Local::init error $@") if $@;
-}
+ # start dupe system
+ dbg("Starting Dupe system");
+ DXDupe::init();
+
+ # read in system messages
+ dbg("Read in Messages");
+ DXM->init();
+
+ # read in command aliases
+ dbg("Read in Aliases");
+ CmdAlias->init();
+
+ # initialise the Geomagnetic data engine
+ dbg("Start WWV");
+ Geomag->init();
+ dbg("Start WCY");
+ WCY->init();
+
+ # initial the Spot stuff
+ dbg("Starting DX Spot system");
+ Spot->init();
+
+ # initialise the protocol engine
+ dbg("Start Protocol Engines ...");
+ DXProt->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));
+ $routeroot->do_pc9x(1);
+ $routeroot->via_pc92(1);
+
+ # make sure that there is a routing OUTPUT node default file
+ #unless (Filter::read_in('route', 'node_default', 0)) {
+ # my $dxcc = $main::me->dxcc;
+ # $Route::filterdef->cmd($main::me, 'route', 'accept', "node_default call $mycall" );
+ #}
+
+ # read in any existing message headers and clean out old crap
+ dbg("reading existing message headers ...");
+ DXMsg->init();
+ DXMsg::clean_old();
+
+ # read in any cron jobs
+ dbg("reading cron jobs ...");
+ DXCron->init();
+
+ # read in database desriptors
+ dbg("reading database descriptors ...");
+ DXDb::load();
+
+ # starting local stuff
+ dbg("doing local initialisation ...");
+ QSL::init(1);
+ if (defined &Local::init) {
+ eval {
+ Local::init();
+ };
+ dbg("Local::init error $@") if $@;
+ }
-# this, such as it is, is the main loop!
-dbg("orft we jolly well go ...");
-my $script = new Script "startup";
-$script->run($main::me) if $script;
+ # this, such as it is, is the main loop!
+ dbg("orft we jolly well go ...");
+ my $script = new Script "startup";
+ $script->run($main::me) if $script;
+
+ #open(DB::OUT, "|tee /tmp/aa");
+}
+
-#open(DB::OUT, "|tee /tmp/aa");
+setup_start();
my $main_loop = Mojo::IOLoop->recurring($idle_interval => \&idle_loop);
+my $log_flush_loop = Mojo::IOLoop->recurring($log_flush_interval => \&DXLog::flushall);
-Mojo::IOLoop->start unless Mojo::IOLoop->is_running;
+Web::start_node();
-dbg("After Mojo::IOLoop");
cease(0);
exit(0);
projects / spider.git / blobdiff