X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fcluster.pl;h=37ace021654a4858cab156ab4196e66c083e61e5;hb=b9dffeff7239952814342dad19db3a51def6fab7;hp=e7f386977baad7a5137884f74e5d2adb13655274;hpb=2b58ccdf81685a1167a43c38705a0d84b9d8d661;p=spider.git diff --git a/perl/cluster.pl b/perl/cluster.pl index e7f38697..37ace021 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -23,9 +23,17 @@ BEGIN { unshift @INC, "$root/perl"; # this IS the right way round! unshift @INC, "$root/local"; + # do some validation of the input + die "The directory $root doesn't exist, please RTFM" unless -d $root; + die "$root/local doesn't exist, please RTFM" unless -d "$root/local"; + die "$root/local/DXVars.pm doesn't exist, please RTFM" unless -e "$root/local/DXVars.pm"; + + mkdir "$root/local_cmd", 0777 unless -d "$root/local_cmd"; + + # try to create and lock a lockfile (this isn't atomic but # should do for now - $lockfn = "$root/perl/cluster.lck"; # lock file name + $lockfn = "$root/local/cluster.lck"; # lock file name if (-e $lockfn) { open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!"; my $pid = ; @@ -67,6 +75,7 @@ use DXBearing; use DXDb; use DXHash; use DXDupe; +use Script; use Prefix; use Spot; use Bands; @@ -84,11 +93,21 @@ use Timer; use Route; use Route::Node; use Route::User; +use Editable; +use Mrtg; +use USDB; +use UDPMsg; +use QSL; +use RouteDB; +use DXXml; +use DXSql; +use IsoTime; use Data::Dumper; use IO::File; use Fcntl ':flock'; use POSIX ":sys_wait_h"; +use Version; use Local; @@ -97,24 +116,20 @@ 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 $is_win $routeroot + $clusterport $mycall $decease $is_win $routeroot $me $reqreg $bumpexisting + $allowdxby $dbh $dsn $dbuser $dbpass $do_xml ); @inqueue = (); # the main input queue, an array of hashes $systime = 0; # the time now (in seconds) -$version = "1.48"; # the version no of the software $starttime = 0; # the starting time of the cluster -#@outstanding_connects = (); # list of outstanding connects +@outstanding_connects = (); # list of outstanding connects @listeners = (); # list of listeners +$reqreg = 0; # 1 = registration required, 2 = deregister people +$bumpexisting = 1; # 1 = allow new connection to disconnect old, 0 - don't allow it +$allowdxby = 0; # 1 = allow "dx by ", 0 - don't allow it -use vars qw($VERSION $BRANCH $build $branch); -$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); -$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0; -$main::build += 15; # add an offset to make it bigger than last system -$main::build += $VERSION; -$main::branch += $BRANCH; - # send a message to call on conn and disconnect sub already_conn { @@ -140,15 +155,44 @@ sub new_channel my ($conn, $msg) = @_; my ($sort, $call, $line) = DXChannel::decode_input(0, $msg); return unless defined $sort; - + + unless (is_callsign($call)) { + already_conn($conn, $call, DXM::msg($lang, "illcall", $call)); + return; + } + # set up the basic channel info # is there one already connected to me - locally? - my $user = DXUser->get($call); - my $dxchan = DXChannel->get($call); + my $user = DXUser->get_current($call); + my $dxchan = DXChannel::get($call); if ($dxchan) { - my $mess = DXM::msg($lang, ($user && $user->is_node) ? 'concluster' : 'conother', $call, $main::mycall); - already_conn($conn, $call, $mess); - return; + if ($user && $user->is_node) { + already_conn($conn, $call, DXM::msg($lang, 'concluster', $call, $main::mycall)); + return; + } + if ($bumpexisting) { + my $ip = $conn->{peerhost} || 'unknown'; + $dxchan->send_now('D', DXM::msg($lang, 'conbump', $call, $ip)); + LogDbg('DXCommand', "$call bumped off by $ip, disconnected"); + $dxchan->disconnect; + } else { + already_conn($conn, $call, DXM::msg($lang, 'conother', $call, $main::mycall)); + return; + } + } + + # is he locked out ? + my $basecall = $call; + $basecall =~ s/-\d+$//; + my $baseuser = DXUser->get_current($basecall); + my $lock = $user->lockout if $user; + if ($baseuser && $baseuser->lockout || $lock) { + if (!$user || !defined $lock || $lock) { + my $host = $conn->{peerhost} || "unknown"; + LogDbg('DXCommand', "$call on $host is locked out, disconnected"); + $conn->disconnect; + return; + } } if ($user) { @@ -157,40 +201,26 @@ sub new_channel $user = DXUser->new($call); } - # is he locked out ? - if ($user->lockout) { - Log('DXCommand', "$call is locked out, disconnected"); - $conn->disconnect; - return; - } - # create the channel - $dxchan = DXCommandmode->new($call, $conn, $user) if $user->is_user; - $dxchan = DXProt->new($call, $conn, $user) if $user->is_node; - $dxchan = BBS->new($call, $conn, $user) if $user->is_bbs; - die "Invalid sort of user on $call = $sort" if !$dxchan; + if ($user->is_node) { + $dxchan = DXProt->new($call, $conn, $user); + } elsif ($user->is_user) { + $dxchan = DXCommandmode->new($call, $conn, $user); + } elsif ($user->is_bbs) { + $dxchan = BBS->new($call, $conn, $user); + } else { + die "Invalid sort of user on $call = $sort"; + } # check that the conn has a callsign $conn->conns($call) if $conn->isa('IntMsg'); # set callbacks $conn->set_error(sub {error_handler($dxchan)}); - $conn->set_rproc(sub {my ($conn,$msg) = @_; rec($dxchan, $conn, $msg);}); - rec($dxchan, $conn, $msg); + $conn->set_rproc(sub {my ($conn,$msg) = @_; $dxchan->rec($msg);}); + $dxchan->rec($msg); } -sub rec -{ - my ($dxchan, $conn, $msg) = @_; - - # queue the message and the channel object for later processing - if (defined $msg) { - my $self = bless {}, "inqueue"; - $self->{dxchan} = $dxchan; - $self->{data} = $msg; - push @inqueue, $self; - } -} sub login { @@ -215,19 +245,22 @@ sub cease dbg("Local::finish error $@") if $@; # disconnect nodes - foreach $dxchan (DXChannel->get_all_nodes) { - $dxchan->disconnect(2) unless $dxchan == $DXProt::me; + foreach $dxchan (DXChannel::get_all_nodes) { + $dxchan->disconnect(2) unless $dxchan == $main::me; } Msg->event_loop(100, 0.01); # disconnect users - foreach $dxchan (DXChannel->get_all_users) { + foreach $dxchan (DXChannel::get_all_users) { $dxchan->disconnect; } # disconnect AGW AGWMsg::finish(); + # disconnect UDP customers + UDPMsg::finish(); + # end everything else Msg->event_loop(100, 0.01); DXUser::finish(); @@ -241,10 +274,12 @@ sub cease $l->close_server; } - dbg("DXSpider version $version, build $build ended") if isdbg('chan'); - Log('cluster', "DXSpider V$version, build $build ended"); + LogDbg('cluster', "DXSpider V$version, build $build ended"); dbgclose(); Logclose(); + + $dbh->finish if $dbh; + unlink $lockfn; # $SIG{__WARN__} = $SIG{__DIE__} = sub {my $a = shift; cluck($a); }; exit(0); @@ -264,39 +299,6 @@ sub reap # this is where the input queue is dealt with and things are dispatched off to other parts of # the cluster -sub process_inqueue -{ - my $self = shift @inqueue; - return if !$self; - - my $data = $self->{data}; - my $dxchan = $self->{dxchan}; - my $error; - my ($sort, $call, $line) = DXChannel::decode_input($dxchan, $data); - return unless defined $sort; - - # do the really sexy console interface bit! (Who is going to do the TK interface then?) - dbg("<- $sort $call $line\n") if $sort ne 'D' && isdbg('chan'); - - # handle A records - my $user = $dxchan->user; - if ($sort eq 'A' || $sort eq 'O') { - $dxchan->start($line, $sort); - } elsif ($sort eq 'I') { - die "\$user not defined for $call" if !defined $user; - # normal input - $dxchan->normal($line); - $dxchan->disconnect if ($dxchan->{state} eq 'bye'); - } elsif ($sort eq 'Z') { - $dxchan->disconnect; - } elsif ($sort eq 'D') { - ; # ignored (an echo) - } elsif ($sort eq 'G') { - $dxchan->enhanced($line); - } else { - print STDERR atime, " Unknown command letter ($sort) received from $call\n"; - } -} sub uptime { @@ -323,6 +325,10 @@ sub AGWrestart $starttime = $systime = time; $lang = 'en' unless $lang; +unless ($DB::VERSION) { + $SIG{INT} = $SIG{TERM} = \&cease; +} + # open the debug file, set various FHs to be unbuffered dbginit(\&DXCommandmode::broadcast_debug); foreach (@debug) { @@ -330,19 +336,26 @@ foreach (@debug) { } STDOUT->autoflush(1); -# calculate build number -$build += $main::version; -$build = "$build.$branch" if $branch; +# try to load the database +if (DXSql::init($dsn)) { + $dbh = DXSql->new($dsn); + $dbh = $dbh->connect($dsn, $dbuser, $dbpass) if $dbh; +} -Log('cluster', "DXSpider V$version, build $build started"); +# try to load XML::Simple +DXXml::init(); # banner -dbg("Copyright (c) 1998-2001 Dirk Koopman G1TLH"); -dbg("DXSpider Version $version, build $build started"); +my ($year) = (gmtime)[5]; +$year += 1900; +LogDbg('cluster', "DXSpider V$version, build $build started"); +dbg("Copyright (c) 1998-$year Dirk Koopman G1TLH"); # load Prefixes dbg("loading prefixes ..."); -Prefix::load(); +dbg(USDB::init()); +my $r = Prefix::init(); +confess $r if $r; # load band data dbg("loading band data ..."); @@ -352,20 +365,37 @@ Bands::load(); dbg("loading user file system ..."); DXUser->init($userfn, 1); +# look for the sysop and the alias user and complain if they aren't there +{ + my $ref = DXUser->get($mycall); + die "$mycall missing, run the create_sysop.pl script and please RTFM" unless $ref && $ref->priv == 9; + $ref = DXUser->get($myalias); + die "$myalias missing, run the create_sysop.pl script and please RTFM" unless $ref && $ref->priv == 9; +} + # start listening for incoming messages/connects dbg("starting listeners ..."); my $conn = IntMsg->new_server($clusteraddr, $clusterport, \&login); -$conn->conns("Server $clusteraddr/$clusterport"); +$conn->conns("Server $clusteraddr/$clusterport using IntMsg"); push @listeners, $conn; -dbg("Internal port: $clusteraddr $clusterport"); +dbg("Internal port: $clusteraddr $clusterport using IntMsg"); foreach my $l (@main::listen) { - $conn = ExtMsg->new_server($l->[0], $l->[1], \&login); - $conn->conns("Server $l->[0]/$l->[1]"); + no strict 'refs'; + my $pkg = $l->[2] || 'ExtMsg'; + my $login = $l->[3] || 'login'; + + $conn = $pkg->new_server($l->[0], $l->[1], \&{"${pkg}::${login}"}); + $conn->conns("Server $l->[0]/$l->[1] using ${pkg}::${login}"); push @listeners, $conn; - dbg("External Port: $l->[0] $l->[1]"); + dbg("External Port: $l->[0] $l->[1] using ${pkg}::${login}"); } + +dbg("AGW Listener") if $AGWMsg::enable; AGWrestart(); +dbg("UDP Listener") if $UDPMsg::enable; +UDPMsg::init(\&new_channel); + # load bad words dbg("load badwords: " . (BadWords::load or "Ok")); @@ -393,32 +423,38 @@ unless ($is_win) { } # start dupe system +dbg("Starting Dupe system"); DXDupe::init(); # read in system messages +dbg("Read in Messages"); DXM->init(); # read in command aliases +dbg("Read in Aliases"); CmdAlias->init(); # initialise the Geomagnetic data engine +dbg("Start WWV"); Geomag->init(); +dbg("Start WCY"); WCY->init(); # initial the Spot stuff +dbg("Starting DX Spot system"); Spot->init(); # initialise the protocol engine -dbg("reading in duplicate spot and WWV info ..."); +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($DXProt::me->here)|Route::conf($DXProt::me->conf)); +$routeroot = Route::Node->new($mycall, $version*100+5300, Route::here($main::me->here)|Route::conf($main::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 $mycall" ); +# 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 @@ -436,19 +472,16 @@ DXDb::load(); # starting local stuff dbg("doing local initialisation ..."); +QSL::init(1); eval { Local::init(); }; dbg("Local::init error $@") if $@; -dbg("cleaning out old debug files"); -DXDebug::dbgclean(); - -# print various flags -#dbg("seful info - \$^D: $^D \$^W: $^W \$^S: $^S \$^P: $^P"); - # 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"); @@ -457,15 +490,18 @@ for (;;) { Msg->event_loop(10, 0.010); my $timenow = time; - process_inqueue(); # read in lines from the input queue and despatch them + + DXChannel::process(); + # $DB::trace = 0; # do timed stuff, ongoing processing happens one a second if ($timenow != $systime) { - reap if $zombies; - $systime = $timenow; + reap() if $zombies; + IsoTime::update($systime = $timenow); DXCron::process(); # do cron jobs DXCommandmode::process(); # process ongoing command mode stuff + DXXml::process(); DXProt::process(); # process ongoing ak1a pcxx stuff DXConnect::process(); DXMsg::process(); @@ -473,7 +509,7 @@ for (;;) { DXUser::process(); DXDupe::process(); AGWMsg::process(); - + eval { Local::process(); # do any localised processing };