X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fcluster.pl;h=a84918bd10e4616eed0725256194ab57b352485b;hb=a453254d687774f352822492d500330a09fd7ebe;hp=ceb099ca7eb4f6b64977447e6a800d7c5be0c1e6;hpb=de6161942af879983173417d630b6327b50a423a;p=spider.git diff --git a/perl/cluster.pl b/perl/cluster.pl index ceb099ca..a84918bd 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -59,6 +59,9 @@ use Geomag; use CmdAlias; use Filter; use Local; +use DXDb; +use Data::Dumper; + use Fcntl ':flock'; use Carp qw(cluck); @@ -67,9 +70,10 @@ package main; @inqueue = (); # the main input queue, an array of hashes $systime = 0; # the time now (in seconds) -$version = "1.33"; # the version no of the software +$version = "1.37"; # 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 @@ -90,7 +94,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 @@ -100,28 +104,30 @@ sub rec my $dxchan = DXChannel->get_by_cnum($conn); # get the dxconnnect object for this message if (defined $err && $err) { - disconnect($dxchan) if defined $dxchan; + if ($dxchan) { + $dxchan->disconnect; + } return; } # set up the basic channel info - this needs a bit more thought - there is duplication here if (!defined $dxchan) { my ($sort, $call, $line) = $msg =~ /^(\w)(\S+)\|(.*)$/; - - # is there one already connected to me ? + + # is there one already connected to me - locally? my $user = DXUser->get($call); if (DXChannel->get($call)) { - my $mess = DXM::msg($lang, $user->sort eq 'A' ? 'concluster' : 'conother', $call); + my $mess = DXM::msg($lang, ($user && $user->sort eq 'A') ? 'concluster' : 'conother', $call); already_conn($conn, $call, $mess); return; } - # is there one already connected elsewhere in the cluster (and not a cluster) + # is there one already connected elsewhere in the cluster? if ($user) { if (($user->sort eq 'A' || $call eq $myalias) && !DXCluster->get_exact($call)) { ; } else { - if (DXCluster->get($call) || DXChannel->get($call)) { + if (DXCluster->get_exact($call)) { my $mess = DXM::msg($lang, $user->sort eq 'A' ? 'concluster' : 'conother', $call); already_conn($conn, $call, $mess); return; @@ -129,7 +135,7 @@ sub rec } $user->{lang} = $main::lang if !$user->{lang}; # to autoupdate old systems } else { - if (DXCluster->get($call)) { + if (DXCluster->get_exact($call)) { my $mess = DXM::msg($lang, 'conother', $call); already_conn($conn, $call, $mess); return; @@ -147,6 +153,7 @@ sub rec # create the channel $dxchan = DXCommandmode->new($call, $conn, $user) if ($user->sort eq 'U'); $dxchan = DXProt->new($call, $conn, $user) if ($user->sort eq 'A'); + $dxchan = BBS->new($call, $conn, $user) if ($user->sort eq 'B'); die "Invalid sort of user on $call = $sort" if !$dxchan; } @@ -177,9 +184,9 @@ sub cease }; dbg('local', "Local::finish error $@") if $@; - # disconnect users + # disconnect nodes foreach $dxchan (DXChannel->get_all()) { - next if $dxchan->is_ak1a; + next unless $dxchan->is_ak1a; disconnect($dxchan) unless $dxchan == $DXProt::me; } Msg->event_loop(1, 0.05); @@ -189,9 +196,9 @@ sub cease Msg->event_loop(1, 0.05); Msg->event_loop(1, 0.05); - # disconnect nodes + # disconnect users foreach $dxchan (DXChannel->get_all()) { - next unless $dxchan->is_ak1a; + next if $dxchan->is_ak1a; disconnect($dxchan) unless $dxchan == $DXProt::me; } Msg->event_loop(1, 0.05); @@ -200,13 +207,11 @@ sub cease 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); - Msg->event_loop(1, 0.05); - Msg->event_loop(1, 0.05); - Msg->event_loop(1, 0.05); DXUser::finish(); + + # close all databases + DXDb::closeall; + dbg('chan', "DXSpider version $version ended"); Log('cluster', "DXSpider V$version stopped"); dbgclose(); @@ -221,6 +226,7 @@ sub reap { $SIG{'CHLD'} = \&reap; my $cpid = wait; + @outstanding_connects = grep {$_->{pid} != $cpid} @outstanding_connects; } # this is where the input queue is dealt with and things are dispatched off to other parts of @@ -241,9 +247,6 @@ sub process_inqueue # translate any crappy characters into hex characters if ($line =~ /[\x00-\x06\x08\x0a-\x1f\x7f-\xff]/o) { $line =~ s/([\x00-\x1f\x7f-\xff])/uc sprintf("%%%02x",ord($1))/eg; - ++$error; -# dbg('chan', "<- $sort $call **CRAP**: $line"); -# return; } # do the really sexy console interface bit! (Who is going to do the TK interface then?) @@ -255,15 +258,11 @@ sub process_inqueue $dxchan->start($line, $sort); } elsif ($sort eq 'I') { die "\$user not defined for $call" if !defined $user; - - if ($error) { - dbg('chan', "DROPPED with $error duff characters"); - } else { - # normal input - $dxchan->normal($line); - } + # normal input + $dxchan->normal($line); disconnect($dxchan) if ($dxchan->{state} eq 'bye'); } elsif ($sort eq 'Z') { + $dxchan->conn(undef); disconnect($dxchan); } elsif ($sort eq 'D') { ; # ignored (an echo) @@ -300,7 +299,7 @@ STDOUT->autoflush(1); Log('cluster', "DXSpider V$version started"); # banner -print "DXSpider DX Cluster Version $version\nCopyright (c) 1998 Dirk Koopman G1TLH\n"; +print "DXSpider DX Cluster Version $version\nCopyright (c) 1998-1999 Dirk Koopman G1TLH\n"; # load Prefixes print "loading prefixes ...\n"; @@ -353,6 +352,10 @@ DXMsg::clean_old(); print "reading cron jobs ...\n"; DXCron->init(); +# read in database descriptors +print "reading database descriptors ...\n"; +DXDb::load(); + # starting local stuff print "doing local initialisation ...\n"; eval { @@ -382,6 +385,7 @@ for (;;) { DXProt::process(); # process ongoing ak1a pcxx stuff DXConnect::process(); DXMsg::process(); + DXDb::process(); eval { Local::process(); # do any localised processing };