X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fcluster.pl;h=fb8753e24fd45782e85f351e1e233d7b457b8f8d;hb=b32570d9978c9e99a8652e52491cf92540bf876b;hp=20e80ddbfe16f61978b8f5731431a94c2e19375f;hpb=5b0cb88ef61ecda87a29033d8fc70edc617afc62;p=spider.git diff --git a/perl/cluster.pl b/perl/cluster.pl index 20e80ddb..fb8753e2 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -61,7 +61,6 @@ use DXProtVars; use DXProtout; use DXProt; use DXMsg; -use DXCluster; use DXCron; use DXConnect; use DXBearing; @@ -69,6 +68,7 @@ use DXDb; use DXHash; use DXDupe; use Prefix; +use Spot; use Bands; use Keps; use Minimuf; @@ -81,6 +81,9 @@ use BBS; use WCY; use BadWords; use Timer; +use Route; +use Route::Node; +use Route::User; use Data::Dumper; use IO::File; @@ -94,12 +97,12 @@ package main; use strict; use vars qw(@inqueue $systime $version $starttime $lockfn @outstanding_connects $zombies $root @listeners $lang $myalias @debug $userfn $clusteraddr - $clusterport $mycall $decease $build $is_win + $clusterport $mycall $decease $build $is_win $routeroot ); @inqueue = (); # the main input queue, an array of hashes $systime = 0; # the time now (in seconds) -$version = "1.47"; # the version no of the software +$version = "1.48"; # the version no of the software $starttime = 0; # the starting time of the cluster #@outstanding_connects = (); # list of outstanding connects @listeners = (); # list of listeners @@ -109,7 +112,8 @@ $starttime = 0; # the starting time of the cluster sub already_conn { my ($conn, $call, $mess) = @_; - + + $conn->disable_read(1); dbg('chan', "-> D $call $mess\n"); $conn->send_now("D$call|$mess"); sleep(2); @@ -140,24 +144,9 @@ sub new_channel return; } - # is there one already connected elsewhere in the cluster? if ($user) { - if (($user->is_node || $call eq $myalias) && !DXCluster->get_exact($call)) { - ; - } else { - if (my $ref = DXCluster->get_exact($call)) { - my $mess = DXM::msg($lang, 'concluster', $call, $ref->mynode->call); - already_conn($conn, $call, $mess); - return; - } - } $user->{lang} = $main::lang if !$user->{lang}; # to autoupdate old systems } else { - if (my $ref = DXCluster->get_exact($call)) { - my $mess = DXM::msg($lang, 'concluster', $call, $ref->mynode->call); - already_conn($conn, $call, $mess); - return; - } $user = DXUser->new($call); } @@ -206,8 +195,10 @@ sub cease { my $dxchan; - $SIG{'TERM'} = 'IGNORE'; - $SIG{'INT'} = 'IGNORE'; + unless ($is_win) { + $SIG{'TERM'} = 'IGNORE'; + $SIG{'INT'} = 'IGNORE'; + } DXUser::sync; @@ -217,28 +208,21 @@ sub cease dbg('local', "Local::finish error $@") if $@; # disconnect nodes - foreach $dxchan (DXChannel->get_all()) { - next unless $dxchan->is_node; - $dxchan->disconnect unless $dxchan == $DXProt::me; + foreach $dxchan (DXChannel->get_all_nodes) { + $dxchan->disconnect(2) unless $dxchan == $DXProt::me; } - Msg->event_loop(1, 0.05); - Msg->event_loop(1, 0.05); + Msg->event_loop(100, 0.01); # disconnect users - foreach $dxchan (DXChannel->get_all()) { - next if $dxchan->is_node; - $dxchan->disconnect(2) unless $dxchan == $DXProt::me; + foreach $dxchan (DXChannel->get_all_users) { + $dxchan->disconnect; } # disconnect AGW AGWMsg::finish(); - - Msg->event_loop(1, 0.05); - Msg->event_loop(1, 0.05); - Msg->event_loop(1, 0.05); - Msg->event_loop(1, 0.05); - Msg->event_loop(1, 0.05); - Msg->event_loop(1, 0.05); + + # end everything else + Msg->event_loop(100, 0.01); DXUser::finish(); DXDupe::finish(); @@ -347,16 +331,20 @@ while () { push @fn, $1; } close CL; +my $subbuild; foreach my $fn (@fn) { + $fn =~ s|::|/|g; open(CL, "$main::root/perl/${fn}.pm") or next; while () { - if (/^#\s+\$Id:\s+[\w\._]+,v\s+(\d+\.\d+)/ ) { + if (/^#\s+\$Id:\s+[\w\._]+,v\s+(\d+\.\d+)\.?(\d+.\d+)?/ ) { $build += $1; + $subbuild += $2 if $2; last; } } close CL; } +$build = "$build.$subbuild" if $subbuild; Log('cluster', "DXSpider V$version, build $build started"); @@ -393,11 +381,11 @@ AGWrestart(); dbg('err', "load badwords: " . (BadWords::load or "Ok")); # prime some signals +unless ($DB::VERSION) { + $SIG{INT} = $SIG{TERM} = sub { $decease = 1 }; +} + unless ($is_win) { - unless ($DB::VERSION) { - $SIG{INT} = \&cease; - $SIG{TERM} = \&cease; - } $SIG{HUP} = 'IGNORE'; $SIG{CHLD} = sub { $zombies++ }; @@ -436,7 +424,13 @@ dbg('err', "reading in duplicate spot and WWV info ..."); DXProt->init(); # put in a DXCluster node for us here so we can add users and take them away -DXNode->new($DXProt::me, $mycall, 0, 1, $DXProt::myprot_version); +$routeroot = Route::Node->new($mycall, $version*100+5300, Route::here($DXProt::me->here)|Route::conf($DXProt::me->conf)); + +# make sure that there is a routing OUTPUT node default file +unless (Filter::read_in('route', 'node_default', 0)) { + my $dxcc = $DXProt::me->dxcc; + $Route::filterdef->cmd($DXProt::me, 'route', 'accept', "node_default call_dxcc $dxcc" ); +} # read in any existing message headers and clean out old crap dbg('err', "reading existing message headers ...");