X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fcluster.pl;h=4c0f374c3eca9bfc54304b4826bef353bb851bab;hb=c83b1ca22765fc07e5adcdc8dac24cbd066c9b95;hp=bd8de8c3c2229ffc1195819680063ae06b0e28ec;hpb=c8a6bc3e45bfbbaad776f4a6f22b3e501c8fc1c9;p=spider.git diff --git a/perl/cluster.pl b/perl/cluster.pl index bd8de8c3..4c0f374c 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -31,7 +31,6 @@ $yes = 'Yes'; # visual representation of yes $no = 'No'; # ditto for no $user_interval = 11*60; # the interval between unsolicited prompts if no traffic - # make sure that modules are searched in the order local then perl BEGIN { umask 002; @@ -41,12 +40,16 @@ BEGIN { eval { require local::lib; }; - import local::lib unless ($@); + unless ($@) { +# import local::lib; + import local::lib qw(/spider/perl5lib); + } # root of directory tree for this system $root = "/spider"; $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'}; + unshift @INC, "$root/perl5lib" unless grep {$_ eq "$root/perl5lib"} @INC; unshift @INC, "$root/perl"; # this IS the right way round! unshift @INC, "$root/local"; @@ -250,16 +253,16 @@ sub new_channel } # is he locked out ? + my $lock; $user = DXUser::get_current($call); $conn->conns($call); my $basecall = $call; - $basecall =~ s/-\d+$//; # remember this for later multiple user processing - my $lock; + $basecall =~ s/-\d+$//; # remember this for later multiple user processing, it's used for other stuff than checking lockout status if ($user) { # make sure we act on any locked status that the actual incoming call has. $lock = $user->lockout; - } elsif ($allowmultiple && $call ne $basecall) { - # if we are allowing multiple connections and there is a basecall minus incoming ssid, use the basecall's lock status + } elsif ($basecall ne $call) { + # if there isn't a SSID on the $call, then try the base $user = DXUser::get_current($basecall); $lock = $user->lockout if $user; } @@ -412,6 +415,7 @@ sub cease UDPMsg::finish(); # end everything else + RBN::finish(); DXUser::finish(); DXDupe::finish(); @@ -484,12 +488,14 @@ sub setup_start } # open the debug file, set various FHs to be unbuffered - dbginit($broadcast_debug ? \&DXCommandmode::broadcast_debug : undef); + dbginit(undef, $broadcast_debug ? \&DXCommandmode::broadcast_debug : undef); foreach (@debug) { dbgadd($_); } STDOUT->autoflush(1); + # log our path + dbg "Perl path: " . join(':', @INC); # try to load the database if (DXSql::init($dsn)) { @@ -562,6 +568,9 @@ sub setup_start dbg("loading user file system ..."); DXUser::init(4); # version 4 == json format + Filter::init(); # doesn't do much, but has to be done + + # 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; @@ -651,26 +660,23 @@ sub setup_start 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 + my $script = new Script "startup"; + $script->run($main::me) if $script; + + # initial the Spot stuff + dbg("Starting DX Spot system"); + Spot->init(); # + dbg("reading existing message headers ..."); DXMsg->init(); DXMsg::clean_old(); @@ -683,6 +689,9 @@ sub setup_start dbg("reading database descriptors ..."); DXDb::load(); + dbg("starting RBN ..."); + RBN::init(); + # starting local stuff dbg("doing local initialisation ..."); QSL::init(1); @@ -696,8 +705,6 @@ sub setup_start # 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"); } @@ -737,7 +744,7 @@ sub idle_loop $main::me->disconnect; } - Mojo::IOLoop->stop if --$ending <= 0; + Mojo::IOLoop->stop_gracefully if --$ending <= 0; } } @@ -766,7 +773,8 @@ sub per_sec DXUser::process(); AGWMsg::process(); DXCron::process(); # do cron jobs - + RBN::process(); + Timer::handler(); DXLog::flushall(); }