From: minima Date: Sat, 18 Nov 2000 18:29:24 +0000 (+0000) Subject: made the reaping code a tad more sophisticated (probably in the correct X-Git-Tag: R_1_45~25 X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?p=spider.git;a=commitdiff_plain;h=01ba3df164dca5b803527a4b7db6e5d36a334f91 made the reaping code a tad more sophisticated (probably in the correct original meaning of that word!) --- diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 140b7726..6b0bb554 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -28,6 +28,7 @@ package DXChannel; use Msg; use DXM; use DXUtil; +use DXVars; use DXDebug; use Filter; diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 47e25c0b..6306226d 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -66,7 +66,7 @@ sub start $self->send_file($main::motd) if (-e $main::motd); $self->state('prompt'); # a bit of room for further expansion, passwords etc $self->{priv} = $user->priv || 0; - $self->{lang} = $user->lang || 'en'; + $self->{lang} = $user->lang || $main::lang || 'en'; $self->{pagelth} = $user->pagelth || 20; $self->{priv} = 0 if $line =~ /^(ax|te)/; # set the connection priv to 0 - can be upgraded later $self->{consort} = $line; # save the connection type @@ -118,7 +118,7 @@ sub start $self->send($self->msg('qll')) if !$user->qra || (!$user->lat && !$user->long); $self->send($self->msg('hnodee1')) if !$user->qth; $self->send($self->msg('m9')) if DXMsg::for_me($call); - $self->send($self->msg('pr', $call)); + $self->prompt; # decide on echo if (!$user->wantecho) { @@ -427,7 +427,7 @@ sub finish sub prompt { my $self = shift; - $self->send($self->msg($self->here ? 'pr' : 'pr2', $self->call)); + $self->send($self->msg($self->here ? 'pr' : 'pr2', $self->call, cldate($main::systime), ztime($main::systime))); } # broadcast a message to all users [except those mentioned after buffer] diff --git a/perl/Messages b/perl/Messages index 8494c7da..98a1cb11 100644 --- a/perl/Messages +++ b/perl/Messages @@ -167,8 +167,8 @@ package DXM; pinge1 => 'Cannot ping yourself!', pingint => 'Ping interval on $_[0] set to $_[1] secs', 'pos' => 'From Callsign: $_[0] Lat: $_[1] Long: $_[2]', - pr => '$_[0] de $main::mycall $main::cldate $main::ztime >', - pr2 => '($_[0]) de $main::mycall $main::cldate $main::ztime >', + pr => '$_[0] de $main::mycall $_[1] $_[2] >', + pr2 => '($_[0]) de $main::mycall $_[1] $_[2] >', priv => 'Privilege level changed on $_[0]', prx => '$main::mycall >', qll => 'Please enter your location with set/location or set/qra', @@ -292,8 +292,8 @@ package DXM; password => 'Wachtwoord gezet of gewijzigd voor $_[0]', pingo => 'Ping gestart naar $_[0]', pingi => 'Ping ontvangen van $_[0] $_[1] (Ave $_[2]) secs', - pr => '$_[0] de $main::mycall $main::cldate $main::ztime >', - pr2 => '($_[0]) de $main::mycall $main::cldate $main::ztime >', + pr => '$_[0] de $main::mycall $_[1] $_[2] >', + pr2 => '($_[0]) de $main::mycall $_[1] $[2] >', priv => 'Privilege level gewijzigd op $_[0]', prx => '$main::mycall >', qll => 'Geef uw locator met set/location of set/qra', diff --git a/perl/cluster.pl b/perl/cluster.pl index 1e850c90..3e9a5a11 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 = ; @@ -38,6 +38,7 @@ BEGIN { close CLLOCK; } + use Msg; use DXVars; use DXDebug; @@ -72,6 +73,10 @@ 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 @@ -240,9 +245,10 @@ sub cease sub reap { my $cpid; - while (($cpid = waitpid(1, &WNOHANG)) != -1) { + while (($cpid = waitpid(-1, WNOHANG)) != -1) { dbg('reap', "cpid: $cpid"); @outstanding_connects = grep {$_->{pid} != $cpid} @outstanding_connects; + $zombies-- if $zombies > 0; } dbg('reap', "cpid: $cpid"); } @@ -299,6 +305,7 @@ sub uptime ############################################################# $starttime = $systime = time; +$lang = 'en' unless $lang; # open the debug file, set various FHs to be unbuffered dbginit(); @@ -335,7 +342,7 @@ dbg('err', "load badwords: " . (BadWords::load or "Ok")); $SIG{INT} = \&cease; $SIG{TERM} = \&cease; $SIG{HUP} = 'IGNORE'; -$SIG{CHLD} = \&reap; +$SIG{CHLD} = sub { $zombies++ }; $SIG{PIPE} = sub { dbg('err', "Broken PIPE signal received"); }; $SIG{IO} = sub { dbg('err', "SIGIO received"); }; @@ -403,19 +410,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