X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fcluster.pl;h=ef565eb7ddebae52ad0dac1246500f1b87b4d52a;hb=d2b28488d70d97c2e467cd7c57077024b7241b45;hp=092a01e058beac4a9959d0f6b10f9547ec0abe53;hpb=98b37ab45d0325f4c2b45fca664457ab90fc1e20;p=spider.git diff --git a/perl/cluster.pl b/perl/cluster.pl index 092a01e0..ef565eb7 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -15,7 +15,20 @@ package main; require 5.10.1; use warnings; -use vars qw($root $is_win $systime $lockfn); +use vars qw($root $is_win $systime $lockfn @inqueue $starttime $lockfn @outstanding_connects + $zombies @listeners $lang $myalias @debug $userfn $clusteraddr + $clusterport $mycall $decease $routeroot $me $reqreg $bumpexisting + $allowdxby $dbh $dsn $dbuser $dbpass $do_xml $systime_days $systime_daystart + $can_encode $maxconnect_user $maxconnect_node $idle_interval $log_flush_interval + $broadcast_debug + ); + +$lang = 'en'; # default language +$clusteraddr = '127.0.0.1'; # cluster tcp host address - used for things like console.pl +$clusterport = 27754; # cluster tcp port +$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 { @@ -140,13 +153,6 @@ use Web; use Local; -use vars qw(@inqueue $starttime $lockfn @outstanding_connects - $zombies @listeners $lang $myalias @debug $userfn $clusteraddr - $clusterport $mycall $decease $routeroot $me $reqreg $bumpexisting - $allowdxby $dbh $dsn $dbuser $dbpass $do_xml $systime_days $systime_daystart - $can_encode $maxconnect_user $maxconnect_node $idle_interval $log_flush_interval - $broadcast_debug - ); @inqueue = (); # the main input queue, an array of hashes $systime = 0; # the time now (in seconds) @@ -188,85 +194,119 @@ sub new_channel 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_current($call); - my $dxchan = DXChannel::get($call); - if ($dxchan) { - if ($user && $user->is_node) { - already_conn($conn, $call, DXM::msg($lang, 'conother', $call, $main::mycall)); + my ($dxchan, $user); + + if (is_webcall($call) && $conn->isa('IntMsg')) { + my $newcall = find_next_webcall(); + unless ($newcall) { + already_conn($conn, $call, "Maximum no of web connected connects ($Web::maxssid) exceeded"); 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; + $call = $newcall; + $user = DXUser::get_current($call); + unless ($user) { + $user = DXUser->new($call); + $user->sort('W'); + $user->wantbeep(0); + $user->name('web'); + $user->qth('on the web'); + $user->homenode($main::mycall); + $user->lat($main::mylatitude); + $user->long($main::mylongitude); + $user->qra($main::mylocator); } - } - - # (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) { - my @n = $r->parents; - my $m = $r->isa('Route::Node') ? $maxconnect_node : $maxconnect_user; - my $c = $user->maxconnect; - my $v; - $v = defined $c ? $c : $m; - if ($v && @n >= $v) { - 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)); + $conn->conns($call); + $dxchan = Web->new($call, $conn, $user); + $dxchan->enhanced(1); + $dxchan->ve7cc(1); + $msg =~ s/^A#WEB|/A$call|/; + $conn->send_now("C$call"); + } else { + # "Normal" connections + unless (is_callsign($call)) { + already_conn($conn, $call, DXM::msg($lang, "illcall", $call)); 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; + # 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); + if ($dxchan) { + if ($user && $user->is_node) { + already_conn($conn, $call, DXM::msg($lang, 'conother', $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; + } + } + + # (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) { + my @n = $r->parents; + my $m = $r->isa('Route::Node') ? $maxconnect_node : $maxconnect_user; + my $c = $user->maxconnect; + my $v; + $v = defined $c ? $c : $m; + if ($v && @n >= $v) { + 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)); + 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) { - $user->{lang} = $main::lang if !$user->{lang}; # to autoupdate old systems - } else { - $user = DXUser->new($call); - } + if ($user) { + $user->{lang} = $main::lang if !$user->{lang}; # to autoupdate old systems + } else { + $user = DXUser->new($call); + } - # create the channel - if ($user->is_node) { - $dxchan = DXProt->new($call, $conn, $user); - } elsif ($user->is_user) { - $dxchan = DXCommandmode->new($call, $conn, $user); -# } elsif ($user->is_bbs) { # there is no support so -# $dxchan = BBS->new($call, $conn, $user); # don't allow it!!! - } else { - die "Invalid sort of user on $call = $sort"; + # create the channel + if ($user->is_node) { + $dxchan = DXProt->new($call, $conn, $user); + } elsif ($user->is_user) { + $dxchan = DXCommandmode->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'); } - - # check that the conn has a callsign - $conn->conns($call) if $conn->isa('IntMsg'); + # set callbacks $conn->set_error(sub {my $err = shift; LogDbg('DXCommand', "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') { + $dxchan->enhanced(1); + $dxchan->sort('W'); + } $dxchan->rec($msg); } @@ -682,6 +722,15 @@ sub per_day } +sub start_node +{ + dbg("Before Web::start_node"); + + Mojo::IOLoop->start unless Mojo::IOLoop->is_running; + + dbg("After Web::start_node"); +} + setup_start(); my $main_loop = Mojo::IOLoop->recurring($idle_interval => \&idle_loop); @@ -694,8 +743,9 @@ my $per10min = Mojo::IOLoop->recurring(600 => \&per_10_minute); my $perhour = Mojo::IOLoop->recurring(3600 => \&per_hour); my $perday = Mojo::IOLoop->recurring(86400 => \&per_day); -Web::start_node(); +start_node(); cease(0); + exit(0);