X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fcluster.pl;h=0839dff5a7dd1931a39430e67e69cbb54eb34ebe;hb=refs%2Fheads%2Fnewusers;hp=7492368a9da75b1a78797be9e1381bc4ae7f16bb;hpb=ca828d0e2a21d9a6540361ca4878df71f125e120;p=spider.git diff --git a/perl/cluster.pl b/perl/cluster.pl index 7492368a..0839dff5 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -13,6 +13,7 @@ package main; require 5.10.1; + use warnings; use vars qw($root $is_win $systime $lockfn @inqueue $starttime $lockfn @outstanding_connects @@ -30,10 +31,12 @@ $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; - + $SIG{'__WARN__'} = sub { warn $_[0] if $DOWARN }; + # take into account any local::lib that might be present eval { require local::lib; @@ -87,14 +90,12 @@ BEGIN { use DXVars; use SysVar; -use strict; - # order here is important - DXDebug snarfs Carp et al so that Mojo errors go into the debug log -use DXDebug; - use Mojolicious 7.26; use Mojo::IOLoop; +$DOWARN = 1; +use DXDebug; use Msg; use IntMsg; use Internet; @@ -146,16 +147,19 @@ use DXXml; use DXSql; use IsoTime; use BPQMsg; - +use RBN; use Data::Dumper; use IO::File; use Fcntl ':flock'; use POSIX ":sys_wait_h"; -use Version; use Web; +use vars qw($version $build $gitversion $gitbranch); + +use strict; + use Local; @@ -245,23 +249,30 @@ sub new_channel } # is he locked out ? + $user = DXUser::get_current($call); my $basecall = $call; $basecall =~ s/-\d+$//; # remember this for later multiple user processing - 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; - LogDbg('DXCommand', "$call on $host is locked out, disconnected"); - $conn->disconnect; - return; - } + my $lock; + if ($user) { + # make sure we act on any locked status that the actual incoming call has. + $lock = $user->lockout; + } elsif ($allowmultiple && $call ne $basecall) { + # if we are allowing multiple connections and there is a basecall minus incoming ssid, use the basecall's lock status + $user = DXUser::get_current($basecall); + $lock = $user->lockout if $user; + } + + # now deal with the lock + if ($lock) { + my $host = $conn->peerhost; + LogDbg('', "$call on $host is locked out, disconnected"); + $conn->disconnect; + return; } # set up the basic channel info for "Normal" Users # is there one already connected to me - locally? - $user = DXUser::get_current($call); $dxchan = DXChannel::get($call); my $newcall = $call; if ($dxchan) { @@ -275,7 +286,7 @@ sub new_channel my $allow = 0; if (@lastconns >= $DXUser::maxconnlist) { $allow = $lastconns[-1]->[0] - $lastconns[0]->[0] < $min_reconnection_rate; - } + } # search for a spare ssid L1: for (my $count = $call =~ /-\d+$/?0:1; $allow && $count < $allowmultiple; ) { # remember we have one call already my $lastid = 1; @@ -297,7 +308,7 @@ sub new_channel if ($bumpexisting) { my $ip = $dxchan->hostname; $dxchan->send_now('D', DXM::msg($lang, 'conbump', $call, $ip)); - LogDbg('DXCommand', "$call bumped off by $ip, disconnected"); + LogDbg('', "$call bumped off by $ip, disconnected"); $dxchan->disconnect; } else { already_conn($conn, $call, DXM::msg($lang, 'conother', $call, $main::mycall)); @@ -321,7 +332,7 @@ sub new_channel $v = defined $c ? $c : $m; if ($v && @n >= $v+$allowmultiple) { my $nodes = join ',', @n; - LogDbg('DXCommand', "$call has too many connections ($v) at $nodes - disconnected"); + LogDbg('', "$call has too many connections ($v) at $nodes - disconnected"); already_conn($conn, $call, DXM::msg($lang, 'contomany', $call, $v, $nodes)); return; } @@ -338,7 +349,9 @@ sub new_channel $user->startt($systime); # mark the start time of this connection if ($user->is_node) { - $dxchan = DXProt->new($call, $conn, $user); + $dxchan = DXProt->new($call, $conn, $user); + } elsif ($user->is_rbn) { + $dxchan = RBN->new($newcall, $conn, $user); } elsif ($user->is_user) { $dxchan = DXCommandmode->new($newcall, $conn, $user); } else { @@ -348,7 +361,7 @@ sub new_channel # set callbacks - $conn->set_error(sub {my $err = shift; LogDbg('DXCommand', "Comms error '$err' received for call $dxchan->{call}"); $dxchan->disconnect(1);}); + $conn->set_error(sub {my $err = shift; LogDbg('', "Comms error '$err' received for call $dxchan->{call}"); $dxchan->disconnect(1);}); $conn->set_on_eof(sub {$dxchan->disconnect}); $conn->set_rproc(sub {my ($conn,$msg) = @_; $dxchan->rec($msg);}); if ($sort eq 'W') { @@ -408,7 +421,7 @@ sub cease $l->close_server; } - LogDbg('cluster', "DXSpider V$version, build $build (git: $gitversion) ended"); + LogDbg('cluster', "DXSpider V$version, build $build (git: $gitbranch/$gitversion) ended"); dbg("bye bye everyone - bye bye"); dbgclose(); Logclose(); @@ -475,7 +488,7 @@ sub setup_start } STDOUT->autoflush(1); - + # try to load the database if (DXSql::init($dsn)) { $dbh = DXSql->new($dsn); @@ -492,6 +505,8 @@ sub setup_start import Encode; $can_encode = 1; } + $gitbranch = 'none'; + $gitversion = 'none'; eval { require Git; }; unless ($@) { import Git; @@ -503,12 +518,20 @@ sub setup_start if ($desc) { my ($v, $s, $b, $g) = $desc =~ /^([\d.]+)(?:\.(\d+))?-(\d+)-g([0-9a-f]+)/; $s ||= ''; - dbg("Git: $desc"); - dbg("Git: V=$v S=$s B=$b g=$g"); + dbg("Git: $desc") if isdbg('git'); + dbg("Git: V=$v S=$s B=$b g=$g") if isdbg('git'); $version = $v; $build = $b || 0; $gitversion = "$g\[r]"; } + my @branch = $repo->command([qw{branch}], STDERR=>0); + for (@branch) { + my ($star, $b) = split /\s+/; + if ($star eq '*') { + $gitbranch = $b; + last; + } + } } } $SIG{__DIE__} = $w; @@ -520,7 +543,7 @@ sub setup_start # banner my ($year) = (gmtime)[5]; $year += 1900; - LogDbg('cluster', "DXSpider V$version, build $build (git: $gitversion) started"); + LogDbg('cluster', "DXSpider V$version, build $build (git: $gitbranch/$gitversion) started"); dbg("Copyright (c) 1998-$year Dirk Koopman G1TLH"); # load Prefixes @@ -545,14 +568,14 @@ sub setup_start my $oldsort = $ref->sort; if ($oldsort ne 'S') { $ref->sort('S'); - dbg "Resetting node type from $oldsort -> DXSpider ('S')"; + dbg("Resetting node type from $oldsort -> DXSpider ('S')"); } $ref = DXUser::get($myalias); die "$myalias missing, run the create_sysop.pl script and please RTFM" unless $ref && $ref->priv == 9; $oldsort = $ref->sort; if ($oldsort ne 'U') { $ref->sort('U'); - dbg "Resetting sysop user type from $oldsort -> User ('U')"; + dbg("Resetting sysop user type from $oldsort -> User ('U')"); } }