put dx.pl into an explicit handle sub
[spider.git] / perl / cluster.pl
index ca73a8249e81017c3705c34689f156294d7afff8..87811af8457f11004dc972e114e56d728443d8b2 100755 (executable)
@@ -15,6 +15,21 @@ package main;
 require 5.10.1;
 use warnings;
 
+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 {
        umask 002;
@@ -38,8 +53,11 @@ BEGIN {
        die "$root/local/DXVars.pm doesn't exist, please RTFM" unless -e "$root/local/DXVars.pm";
 
        # create some directories
-       mkdir "$root/local_cmd", 02777 unless -d "$root/local_cmd";
-       mkdir "$root/local_data", 02777 unless -d "$root/local_data";
+       mkdir "$root/local_cmd", 02774 unless -d "$root/local_cmd";
+
+       # locally stored data lives here
+       my $local_data = "$root/local_data";
+       mkdir $local_data, 02774 unless -d $local_data;
 
        # try to create and lock a lockfile (this isn't atomic but
        # should do for now
@@ -63,13 +81,19 @@ BEGIN {
 
        $is_win = ($^O =~ /^MS/ || $^O =~ /^OS-2/) ? 1 : 0; # is it Windows?
        $systime = time;
+       
 }
 
 use DXVars;
 use SysVar;
 
+use strict;
+
+use Mojolicious 7.26;
+
 use Mojo::IOLoop;
 
+use DXDebug;
 use Msg;
 use IntMsg;
 use Internet;
@@ -77,7 +101,6 @@ use Listeners;
 use ExtMsg;
 use AGWConnect;
 use AGWMsg;
-use DXDebug;
 use DXLog;
 use DXLogPrint;
 use DXUtil;
@@ -132,16 +155,6 @@ use Web;
 
 use Local;
 
-package main;
-
-use strict;
-use vars qw(@inqueue $systime $starttime $lockfn @outstanding_connects
-                       $zombies $root @listeners $lang $myalias @debug $userfn $clusteraddr
-                       $clusterport $mycall $decease $is_win $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)
@@ -183,85 +196,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 = $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;
+                       }
+               }
+               
+               # (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;
+                               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);
 }
 
@@ -677,6 +724,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);
@@ -689,8 +745,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);