X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fcluster.pl;h=b6c38166b6dba898a1a513f730b015b4850f9673;hb=5756741d9682667ae5b0442c4e6f609bd481b6eb;hp=d62b88b10840e291033e627f10b3e037b90b5698;hpb=c7abd10080945488d7ea9d850aba2a8b565b4c57;p=spider.git diff --git a/perl/cluster.pl b/perl/cluster.pl index d62b88b1..b6c38166 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -31,6 +31,17 @@ use vars qw($root $is_win $systime $lockfn @inqueue $starttime $lockfn @outstand #$no = 'No'; # ditto for no #$user_interval = 11*60; # the interval between unsolicited prompts if no traffic +package main; + +# set default paths, these should be overwritten by DXVars.pm +use vars qw($data $system $cmd $localcmd $userfn $clusteraddr $clusterport $yes $no $user_interval $lang $local_data); + +$lang = 'en'; # default language +$yes = 'Yes'; # visual representation of yes +$no = 'No'; # ditto for no +$user_interval = 11*60; # the interval between unsolicited prompts if no traffic + + # make sure that modules are searched in the order local then perl BEGIN { umask 002; @@ -62,8 +73,13 @@ BEGIN { mkdir "$root/local_cmd", 02774 unless -d "$root/local_cmd"; # locally stored data lives here - my $local_data = "$root/local_data"; + $local_data = "$root/local_data"; mkdir $local_data, 02774 unless -d $local_data; + $data = "$root/data"; + $system = "$root/sys"; + $cmd = "$root/cmd"; + $localcmd = "$root/local_cmd"; + $userfn = "$data/users"; # try to create and lock a lockfile (this isn't atomic but # should do for now @@ -152,7 +168,7 @@ use DXSql; use IsoTime; use BPQMsg; use RBN; - +use DXCIDR; use Data::Dumper; use IO::File; @@ -160,8 +176,6 @@ use Fcntl ':flock'; use POSIX ":sys_wait_h"; use Web; -use vars qw($version $build $gitversion $gitbranch); - use strict; use Local; @@ -173,7 +187,6 @@ $yes //= 'Yes'; # visual representation of yes $no //= 'No'; # ditto for no $user_interval //= 11*60; # the interval between unsolicited prompts if no traffic - @inqueue = (); # the main input queue, an array of hashes $systime = 0; # the time now (in seconds) $starttime = 0; # the starting time of the cluster @@ -205,6 +218,16 @@ our $clssecs; # the amount of cpu time the DXSpider process have consumed our $cldsecs; # the amount of cpu time any child processes have consumed our $allowslashcall; # Allow / in connecting callsigns (ie PA0/G1TLH, or even PA0/G1TLH/2) +our @localhost_names = qw(127.0.0.1 ::1); # all ip addresses that will need to be aliased below (ipv4 or ipv6) + +our $localhost_alias_ipv4; # these are the IPV4 & 6 aliases for localhost connected clients +our $localhost_alias_ipv6; # for things (PC92, PC61 etc) that expose IP addresses. These *may* + # be set by Msg.pm stuff if they are left undefined but, if you need + # certanty then set/var them in the startup file. + +our $save_route_cache; # save and restore route cache on restart. Probably only useful for G1TLH testing + +use vars qw($version $subversion $build $gitversion $gitbranch); # send a message to call on conn and disconnect sub already_conn @@ -233,7 +256,8 @@ sub new_channel already_conn($conn, $call, "Maximum no of web connected connects ($Web::maxssid) exceeded"); return; } - $call = $newcall; + $call = normalise_call($newcall); + $user = DXUser::get_current($call); unless ($user) { $user = DXUser->new($call); @@ -255,6 +279,15 @@ sub new_channel $conn->send_now("C$call"); } else { # "Normal" connections + + # normalise calls like G1TST-0/G1TST-00/G1TST-01 to G1TST and G1TST-1 respectively + my $ncall = normalise_call($call); + if ($call ne $ncall) { + LogDbg('err', "new_channel login invalid $call converted to $ncall"); + $msg =~ s/$call/$ncall/; + $call = $ncall; + } + # is it a valid callsign (in format)? unless (is_callsign($call)) { already_conn($conn, $call, DXM::msg($lang, "illcall", $call)); return; @@ -262,8 +295,8 @@ sub new_channel # is he locked out ? my $lock; - $user = DXUser::get_current($call); $conn->conns($call); + $user = DXUser::get_current($call); my $basecall = $call; $basecall =~ s/-\d+$//; # remember this for later multiple user processing, it's used for other stuff than checking lockout status if ($user) { @@ -276,13 +309,20 @@ sub new_channel } # now deal with the lock + my $host = $conn->peerhost; if ($lock) { - my $host = $conn->peerhost; LogDbg('', "$call on $host is locked out, disconnected"); $conn->disconnect; return; } + # Is he from a badip? + if (DXCIDR::find($host)) { + LogDbg('', "$call on $host is from a badip $host, disconnected"); + $conn->disconnect; + return; + } + # set up the basic channel info for "Normal" Users # is there one already connected to me - locally? @@ -390,7 +430,7 @@ sub login return \&new_channel; } -our $ceasing; +my $ceasing; # cease running this program, close down all the connections nicely sub cease @@ -400,6 +440,8 @@ sub cease cluck("ceasing") if $ceasing; return if $ceasing++; + + dbg("DXSpider Ceasing"); unless ($is_win) { $SIG{'TERM'} = 'IGNORE'; @@ -423,18 +465,23 @@ sub cease UDPMsg::finish(); # end everything else + QSL::finish(); RBN::finish(); - DXUser::finish(); DXDupe::finish(); # close all databases DXDb::closeall; + # Write route cache + Route::write_cache() if $save_route_cache; + # close all listeners foreach my $l (@listeners) { $l->close_server; } + DXUser::finish(); + LogDbg('cluster', "DXSpider v$version build $build (git: $gitbranch/$gitversion) using perl $^V on $^O ended"); dbg("bye bye everyone - bye bye"); dbgclose(); @@ -476,10 +523,8 @@ sub AGWrestart AGWMsg::init(\&new_channel); } - sub setup_start { - ############################################################# # # The start of the main line of code @@ -555,6 +600,7 @@ sub setup_start $SIG{__DIE__} = $w; } + # setup location of motd & issue localdata_mv($motd); $motd = localdata($motd); @@ -568,7 +614,8 @@ sub setup_start my ($year) = (gmtime)[5]; $year += 1900; LogDbg('cluster', "DXSpider v$version build $build (git: $gitbranch/$gitversion) using perl $^V on $^O started"); - dbg("Copyright (c) 1998-$year Dirk Koopman G1TLH"); + LogDbg('cluster', "Copyright (c) 1998-$year Dirk Koopman G1TLH"); + LogDbg('cluster', "Capabilities: ve7cc rbn"); # load Prefixes dbg("loading prefixes ..."); @@ -609,6 +656,9 @@ sub setup_start } } + # read any route cache there might be + Route::read_cache() if $save_route_cache; + # start listening for incoming messages/connects dbg("starting listeners ..."); my $conn = IntMsg->new_server($clusteraddr, $clusterport, \&login); @@ -626,6 +676,7 @@ sub setup_start dbg("External Port: $l->[0] $l->[1] using ${pkg}::${login}"); } + dbg("AGW Listener") if $AGWMsg::enable; AGWrestart(); @@ -636,13 +687,16 @@ sub setup_start UDPMsg::init(\&new_channel); # load bad words - dbg("load badwords: " . (BadWords::load or "Ok")); + BadWords::load(); # prime some signals unless ($DB::VERSION) { $SIG{INT} = $SIG{TERM} = sub { $ending = 10; }; } + # get any bad IPs + DXCIDR::init(); + unless ($is_win) { $SIG{HUP} = 'IGNORE'; $SIG{CHLD} = sub { $zombies++ }; @@ -818,6 +872,7 @@ sub per_minute sub per_10_minute { RBN::per_10_minute(); + Route::write_cache() if $save_route_cache; } sub per_hour @@ -837,6 +892,7 @@ sub start_node Mojo::IOLoop->start unless Mojo::IOLoop->is_running; dbg("After Web::start_node"); + } setup_start(); @@ -857,3 +913,10 @@ cease(0); exit(0); +sub END +{ + unless ($ceasing) { + print "DXSpider Ending\n"; + cease(); + } +}