X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fcluster.pl;h=d34a3337b270cf27a1c912e2a17594f1047ed77e;hb=04ff9a5a6bf8f3ab55bc2922b76a44e2798af8ee;hp=eabc56e62dc1737437a2c27ba2d520fe8e15592f;hpb=50658a091d92a13b20823326a9f864d1a08817ba;p=spider.git diff --git a/perl/cluster.pl b/perl/cluster.pl index eabc56e6..d34a3337 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -25,7 +25,7 @@ BEGIN { # try to create and lock a lockfile (this isn't atomic but # should do for now - $lockfn = "$root/perl/cluster.lock"; # lock file name + my $lockfn = "$root/perl/cluster.lock"; # lock file name if (-e $lockfn) { open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!"; my $pid = ; @@ -39,6 +39,8 @@ BEGIN { } use Msg; +use IntMsg; +use ExtMsg; use DXVars; use DXDebug; use DXLog; @@ -72,21 +74,19 @@ use Local; package main; +#use strict; +#use vars qw(@inqueue $systime $version $starttime $lockfn @outstanding_connects $zombies $root +# $lang $myalias @debug $userfn $clusteraddr $clusterport $mycall $decease ); + @inqueue = (); # the main input queue, an array of hashes $systime = 0; # the time now (in seconds) -$version = "1.45"; # the version no of the software +$version = "1.47"; # the version no of the software $starttime = 0; # the starting time of the cluster $lockfn = "cluster.lock"; # lock file name @outstanding_connects = (); # list of outstanding connects - -# handle disconnections -sub disconnect -{ - my $dxchan = shift; - return if !defined $dxchan; - $dxchan->disconnect(); -} +@listeners = (); # list of listeners + # send a message to call on conn and disconnect sub already_conn { @@ -98,7 +98,7 @@ sub already_conn dbg('chan', "-> Z $call bye\n"); $conn->send_now("Z$call|bye"); # this will cause 'client' to disconnect sleep(1); - $conn->disconnect(); + $conn->disconnect; } # handle incoming messages @@ -201,19 +201,15 @@ sub cease # disconnect nodes foreach $dxchan (DXChannel->get_all()) { next unless $dxchan->is_node; - disconnect($dxchan) unless $dxchan == $DXProt::me; + $dxchan->disconnect unless $dxchan == $DXProt::me; } 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); # disconnect users foreach $dxchan (DXChannel->get_all()) { next if $dxchan->is_node; - disconnect($dxchan) unless $dxchan == $DXProt::me; + $dxchan->disconnect unless $dxchan == $DXProt::me; } Msg->event_loop(1, 0.05); Msg->event_loop(1, 0.05); @@ -226,7 +222,12 @@ sub cease # close all databases DXDb::closeall; - + + # close all listeners + for (@listeners) { + $_->close_server; + } + dbg('chan', "DXSpider version $version ended"); Log('cluster', "DXSpider V$version stopped"); dbgclose(); @@ -239,11 +240,13 @@ sub cease # the reaper of children sub reap { - $SIG{'CHLD'} = \&reap; my $cpid; - while (($cpid = waitpid(1, &WNOHANG) != -1)) { + while (($cpid = waitpid(-1, WNOHANG)) > 0) { + dbg('reap', "cpid: $cpid"); @outstanding_connects = grep {$_->{pid} != $cpid} @outstanding_connects; + $zombies-- if $zombies > 0; } + dbg('reap', "cpid: $cpid"); } # this is where the input queue is dealt with and things are dispatched off to other parts of @@ -270,10 +273,10 @@ sub process_inqueue die "\$user not defined for $call" if !defined $user; # normal input $dxchan->normal($line); - disconnect($dxchan) if ($dxchan->{state} eq 'bye'); + $dxchan->disconnect if ($dxchan->{state} eq 'bye'); } elsif ($sort eq 'Z') { $dxchan->conn(undef); - disconnect($dxchan); + $dxchan->disconnect; } elsif ($sort eq 'D') { ; # ignored (an echo) } else { @@ -298,6 +301,7 @@ sub uptime ############################################################# $starttime = $systime = time; +$lang = 'en' unless $lang; # open the debug file, set various FHs to be unbuffered dbginit(); @@ -309,7 +313,7 @@ STDOUT->autoflush(1); Log('cluster', "DXSpider V$version started"); # banner -dbg('err', "DXSpider DX Cluster Version $version", "Copyright (c) 1998-2000 Dirk Koopman G1TLH"); +dbg('err', "DXSpider DX Cluster Version $version", "Copyright (c) 1998-2001 Dirk Koopman G1TLH"); # load Prefixes dbg('err', "loading prefixes ..."); @@ -324,28 +328,39 @@ dbg('err', "loading user file system ..."); DXUser->init($userfn, 1); # start listening for incoming messages/connects -dbg('err', "starting listener ..."); -Msg->new_server("$clusteraddr", $clusterport, \&login); +use Listeners; + +dbg('err', "starting listeners ..."); +push @listeners, IntMsg->new_server("$clusteraddr", $clusterport, \&login); +dbg('err', "Internal port: $clusteraddr $clusterport"); +for (@main::listen) { + push @listeners, ExtMsg->new_server($_->[0], $_->[1], \&login); + dbg('err', "External Port: $_->[0] $_->[1]"); +} # load bad words dbg('err', "load badwords: " . (BadWords::load or "Ok")); # prime some signals -$SIG{INT} = \&cease; -$SIG{TERM} = \&cease; -$SIG{HUP} = 'IGNORE'; -$SIG{CHLD} = \&reap; - -$SIG{PIPE} = sub { dbg('err', "Broken PIPE signal received"); }; -$SIG{IO} = sub { dbg('err', "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('chan', "Catching SIG $_"); - $SIG{$_} = sub { my $sig = shift; DXDebug::confess("Caught signal $sig"); }; +unless ($^O =~ /^MS/) { + unless ($DB::VERSION) { + $SIG{INT} = \&cease; + $SIG{TERM} = \&cease; + } + $SIG{HUP} = 'IGNORE'; + $SIG{CHLD} = sub { $zombies++ }; + + $SIG{PIPE} = sub { dbg('err', "Broken PIPE signal received"); }; + $SIG{IO} = sub { dbg('err', "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('chan', "Catching SIG $_"); + $SIG{$_} = sub { my $sig = shift; DXDebug::confess("Caught signal $sig"); }; + } } } @@ -369,7 +384,6 @@ Spot->init(); 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); @@ -402,19 +416,17 @@ dbg('err', "orft we jolly well go ..."); #open(DB::OUT, "|tee /tmp/aa"); for (;;) { - my $timenow; # $DB::trace = 1; Msg->event_loop(1, 0.1); - $timenow = time; + my $timenow = time; process_inqueue(); # read in lines from the input queue and despatch them # $DB::trace = 0; # do timed stuff, ongoing processing happens one a second if ($timenow != $systime) { + reap if $zombies; $systime = $timenow; - $cldate = &cldate(); - $ztime = &ztime(); DXCron::process(); # do cron jobs DXCommandmode::process(); # process ongoing command mode stuff DXProt::process(); # process ongoing ak1a pcxx stuff