X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fcluster.pl;h=5baf02973ac49a4c385c95d7fc1dcf8121febd09;hb=d9a5a954acbdca08db5c0d138e77329574cc4d52;hp=78f2f594b02706bcf7e44b1ffeaa4fbb9ad0c672;hpb=e3ac9a067624b85ab15ed01fbec05bb881ffa861;p=spider.git diff --git a/perl/cluster.pl b/perl/cluster.pl index 78f2f594..5baf0297 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -153,9 +153,10 @@ 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 Local; @@ -166,6 +167,16 @@ $starttime = 0; # the starting time of the cluster @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 +our $allowmultiple = 0; # This is used in conjunction with $bumpexisting, in a rather weird way. +our $min_reconnection_rate = 5*60; # minimum value of seconds between connections per user to allow co-existing users +our $max_ssid = 15; # highest ssid to be searched for a spare one on multiple connections + +# If $allowmultiple > 0 and the $reconnection_rate is some value of seconds +# based on the average connection time calculated from the $user->conntimel entries / frequency is +# less than $reconnection_rate then we assume that there is more than one device (probably HRD) trying +# to connect "at once". In which case we probe for a spare SSID for a user callsign to allow up to +# $allowmultiple connections per callsign. + $allowdxby = 0; # 1 = allow "dx by ", 0 - don't allow it $maxconnect_user = 3; # the maximum no of concurrent connections a user can have at a time $maxconnect_node = 0; # Ditto but for nodes. In either case if a new incoming connection @@ -220,6 +231,7 @@ sub new_channel $user->long($main::mylongitude); $user->qra($main::mylocator); } + $user->startt($main::systime); $conn->conns($call); $dxchan = Web->new($call, $conn, $user); $dxchan->enhanced(1); @@ -233,27 +245,73 @@ sub new_channel return; } + # is he locked out ? + 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; + } + } + # 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) { if ($user && $user->is_node) { already_conn($conn, $call, DXM::msg($lang, 'conother', $call, $main::mycall)); return; } - if ($bumpexisting) { - my $ip = $dxchan->hostname; - $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; + if ($allowmultiple && $user->is_user) { + # determine whether we are a candidate, have we flip-flopped frequently enough? + my @lastconns = @{$user->connlist} if $user->connlist; + 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; + for (; $lastid < $max_ssid && $count < $allowmultiple; ++$lastid) { + my $chan = DXChannel::get("$basecall-$lastid"); + if ($chan) { + ++$count; + next; + } + # we have a free call-ssid, save it + $newcall = "$basecall-$lastid"; + last L1; + } + } } + + # handle "normal" (non-multiple) connections in the existing way + if ($call eq $newcall) { + if ($bumpexisting) { + my $ip = $dxchan->hostname; + $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; + } + } + + # make sure that the conn has the (possibly) new callsign + $conn->conns($newcall); + $msg =~ s/$call/$newcall/; } - + + # (fairly) politely disconnect people that are connected to too many other places at once my $r = Route::get($call); if ($conn->{sort} && $conn->{sort} =~ /^I/ && $r && $user) { @@ -262,7 +320,7 @@ sub new_channel my $c = $user->maxconnect; my $v; $v = defined $c ? $c : $m; - if ($v && @n >= $v) { + if ($v && @n >= $v+$allowmultiple) { my $nodes = join ',', @n; LogDbg('DXCommand', "$call has too many connections ($v) at $nodes - disconnected"); already_conn($conn, $call, DXM::msg($lang, 'contomany', $call, $v, $nodes)); @@ -270,20 +328,6 @@ sub new_channel } } - # 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; - LogDbg('DXCommand', "$call on $host is locked out, disconnected"); - $conn->disconnect; - return; - } - } - if ($user) { $user->{lang} = $main::lang if !$user->{lang}; # to autoupdate old systems } else { @@ -291,16 +335,16 @@ sub new_channel } # create the channel + # NOTE we are SHARING the same $user if $allowmultiple is > 1 + + $user->startt($systime); # mark the start time of this connection if ($user->is_node) { $dxchan = DXProt->new($call, $conn, $user); } elsif ($user->is_user) { - $dxchan = DXCommandmode->new($call, $conn, $user); + $dxchan = DXCommandmode->new($newcall, $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'); } @@ -337,7 +381,6 @@ sub cease $SIG{'INT'} = 'IGNORE'; } - DXUser::sync; if (defined &Local::finish) { eval { @@ -366,7 +409,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(); @@ -450,6 +493,8 @@ sub setup_start import Encode; $can_encode = 1; } + $gitbranch = 'none'; + $gitversion = 'none'; eval { require Git; }; unless ($@) { import Git; @@ -460,10 +505,21 @@ sub setup_start my $desc = $repo->command_oneline(['describe', '--long'], STDERR => 0); 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"); $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; @@ -475,7 +531,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 @@ -490,7 +546,7 @@ sub setup_start # initialise User file system dbg("loading user file system ..."); - DXUser::init(1); + DXUser::init(4); # version 4 == json format # look for the sysop and the alias user and complain if they aren't there {