]> www.dxcluster.org Git - spider.git/commitdiff
Start (serious) web interface work
authorDirk Koopman <djk@tobit.co.uk>
Thu, 26 Oct 2017 01:20:53 +0000 (02:20 +0100)
committerDirk Koopman <djk@tobit.co.uk>
Thu, 26 Oct 2017 01:20:53 +0000 (02:20 +0100)
Install and test basic connections from an associated web interface

Changes
dxweb/d_x_web.conf
dxweb/dxweb [new symlink]
perl/AnnTalk.pm
perl/DXChannel.pm
perl/DXCommandmode.pm
perl/DXUser.pm
perl/Web.pm
perl/cluster.pl

diff --git a/Changes b/Changes
index 1563721c937b60775ca49bc2e371922300bc68f2..49fda7c18f580eb813501bfbcd9dabfa8bc903e8 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,6 @@
+26Aug17=======================================================================
+1. Start (serious) work on web interface. Make the necessary changes to allow
+   a local webserver to connect and get its own style of messages.
 11Aug17=======================================================================
 1. Add default systemd service file file
 10Aug17=======================================================================
index 43ae17444590394683c18258ba7250992c05f948..5068a8e2f8bc4000c47e298b3bff995845c1d5c2 100644 (file)
@@ -1,4 +1,4 @@
 {
   perldoc => 1,
-  secrets => ['ac82f00b5490aa599f88feafe6b3af4014aefb5a']
+  secrets => ['24b654c7cfab0585e42c3a8308755fb29757d70a']
 }
diff --git a/dxweb/dxweb b/dxweb/dxweb
new file mode 120000 (symlink)
index 0000000..1574599
--- /dev/null
@@ -0,0 +1 @@
+script/dxweb
\ No newline at end of file
index 6d47726420f9cab730555853303429bd93367c44..ee7ea51570164916e925f08f34eb24c79dae46ee 100644 (file)
@@ -66,6 +66,7 @@ sub is_talk_candidate
 {
        my ($from, $text) = @_;
        my $call;
+
        ($call) = $text =~ /^\s*(?:[Xx]|[Tt][Oo]?:?)\s+([\w-]+)/;
        ($call) = $text =~ /^\s*>\s*([\w-]+)\b/ unless $call;
        ($call) = $text =~ /^\s*([\w-]+):?\b/ unless $call;
index 91900e4b3c8a360118e25075993ba8387cd20a18..e4b513f6a4d0efb0b84b4e74755865dd2d1f1710 100644 (file)
@@ -300,68 +300,68 @@ sub del
 sub is_bbs
 {
        my $self = shift;
-       return $self->{'sort'} eq 'B';
+       return $self->{sort} eq 'B';
 }
 
 sub is_node
 {
        my $self = shift;
-       return $self->{'sort'} =~ /[ACRSXW]/;
+       return $self->{sort} =~ /^[ACRSX]$/;
 }
 # is it an ak1a node ?
 sub is_ak1a
 {
        my $self = shift;
-       return $self->{'sort'} eq 'A';
+       return $self->{sort} eq 'A';
 }
 
 # is it a user?
 sub is_user
 {
        my $self = shift;
-       return $self->{'sort'} eq 'U';
+       return $self->{sort} =~ /^[UW]$/;
 }
 
 # is it a clx node
 sub is_clx
 {
        my $self = shift;
-       return $self->{'sort'} eq 'C';
+       return $self->{sort} eq 'C';
 }
 
-# it is Aranea
-sub is_aranea
+# it is a Web connected user
+sub is_web
 {
        my $self = shift;
-       return $self->{'sort'} eq 'W';
+       return $self->{sort} eq 'W';
 }
 
 # is it a spider node
 sub is_spider
 {
        my $self = shift;
-       return $self->{'sort'} eq 'S';
+       return $self->{sort} eq 'S';
 }
 
 # is it a DXNet node
 sub is_dxnet
 {
        my $self = shift;
-       return $self->{'sort'} eq 'X';
+       return $self->{sort} eq 'X';
 }
 
 # is it a ar-cluster node
 sub is_arcluster
 {
        my $self = shift;
-       return $self->{'sort'} eq 'R';
+       return $self->{sort} eq 'R';
 }
 
 # for perl 5.004's benefit
 sub sort
 {
        my $self = shift;
-       return @_ ? $self->{'sort'} = shift : $self->{'sort'} ;
+       return @_ ? $self->{sort} = shift : $self->{sort} ;
 }
 
 # find out whether we are prepared to believe this callsign on this interface
@@ -587,7 +587,7 @@ sub decode_input
 {
        my $dxchan = shift;
        my $data = shift;
-       my ($sort, $call, $line) = $data =~ /^([A-Z])([A-Z0-9\/\-]{3,25})\|(.*)$/;
+       my ($sort, $call, $line) = $data =~ /^([A-Z])(#?[A-Z0-9\/\-]{3,25})\|(.*)$/;
 
        my $chcall = (ref $dxchan) ? $dxchan->call : "UN.KNOWN";
        
index 85df95b16cfc3602e377c284643951ee3cc45c20..46e4e03a12dfcd1ba1ff84a31593352aca08303f 100644 (file)
@@ -569,7 +569,7 @@ sub process
        my $dxchan;
        
        foreach $dxchan (@dxchan) {
-               next unless $dxchan->{sort} eq 'U';  
+               next unless $dxchan->is_user;  
        
                # send a outstanding message prompt if required
                if ($t >= $dxchan->lastmsgpoll + $msgpolltime) {
@@ -663,7 +663,7 @@ sub broadcast
        my $s = shift;                          # the line to be rebroadcast
        
     foreach my $dxchan (DXChannel::get_all()) {
-               next unless $dxchan->{sort} eq 'U'; # only interested in user channels  
+               next unless $dxchan->is_user; # only interested in user channels  
                next if grep $dxchan == $_, @_;
                $dxchan->send($s);                      # send it
        }
@@ -672,7 +672,7 @@ sub broadcast
 # gimme all the users
 sub get_all
 {
-       return grep {$_->{sort} eq 'U'} DXChannel::get_all();
+       return grep {$_->is_user} DXChannel::get_all();
 }
 
 # run a script for this user
index 60fc1afda1d69c2572710e9252445e4149f75d5f..60d49eafe72e3d7b7f613f068f75cc132f273324 100644 (file)
@@ -513,7 +513,7 @@ print "There are $count user records and $err errors\n";
                        my $ref = decode($val);
                        if ($ref) {
                                my $t = $ref->{lastin} || 0;
-                               if ($ref->{sort} eq 'U' && !$ref->{priv} && $main::systime > $t + $tooold) {
+                               if ($ref->is_user && !$ref->{priv} && $main::systime > $t + $tooold) {
                                        unless ($ref->{lat} && $ref->{long} || $ref->{qth} || $ref->{qra}) {
                                                eval {$dbm->del($key)};
                                                dbg(carp("Export Error2: $key\t$val\n$@")) if $@;
@@ -752,7 +752,7 @@ sub wantlogininfo
 sub is_node
 {
        my $self = shift;
-       return $self->{sort} =~ /[ACRSX]/;
+       return $self->{sort} =~ /^[ACRSX]$/;
 }
 
 sub is_local_node
@@ -764,7 +764,13 @@ sub is_local_node
 sub is_user
 {
        my $self = shift;
-       return $self->{sort} eq 'U';
+       return $self->{sort} =~ /^[UW]$/;
+}
+
+sub is_web
+{
+       my $self = shift;
+       return $self->{sort} eq 'W';
 }
 
 sub is_bbs
index fbba02f652d27ebebf118c55e9da89aa4d647f0b..eec12c688449f2d4c92809d795114612c36d1c9c 100644 (file)
@@ -1,5 +1,5 @@
 #
-# DXSpider - The Web Interface
+# DXSpider - The Web Interface Helper Routines
 #
 # Copyright (c) 2015 Dirk Koopman G1TLH
 #
@@ -8,18 +8,49 @@ use strict;
 
 package Web;
 
-use Mojolicious::Lite;
-use Mojo::IOLoop;
 use DXDebug;
+use DXChannel;
+use DXLog;
 
-sub start_node
+require Exporter;
+our @ISA = qw(DXCommandmode Exporter);
+our @EXPORT = qw(is_webcall find_next_webcall);
+
+our $maxssid = 64;                             # the maximum number of bare @WEB connections we will allow - this is really to stop runaway connections from the dxweb app
+
+sub is_webcall
 {
-       dbg("Before Web::start_node");
+       return $_[0] =~ /^\#WEB/;
+}
 
-       Mojo::IOLoop->start unless Mojo::IOLoop->is_running;
+sub find_next_webcall
+{
+       foreach my $i (1 .. $maxssid) {
+               next if DXChannel::get("\#WEB-$i");
+               return "\#WEB-$i";
+       }
+       return undef;
+}
 
-       dbg("After Web::start_node");
+sub new 
+{
+       my $self = DXChannel::alloc(@_);
+       
+       return $self;
 }
 
+sub disconnect
+{
+       my $self = shift;
+       my $call = $self->call;
+       
+       return if $self->{disconnecting}++;
+
+       delete $self->{senddbg};
+       
+       LogDbg('DXCommand', "Web $call disconnected");
 
+       # this done to avoid any routing or remembering of unwanted stuff
+       DXChannel::disconnect($self);
+}
 1;
index 6495027be2a3a97f5276685434c908be7005ccde..4205241aa591538a97e0e62442f0e7867c6e6ee1 100755 (executable)
@@ -194,80 +194,114 @@ 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::call);
+                       $user->lat($main::mylatitude);
+                       $user->long($main::mylongitude);
+                       $user->qra($main::mylocator);
+                       $user->put;
                }
-       }
-
-       # (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));
+               $dxchan = Web->new($call, $conn, $user);
+               $dxchan->sort('W');
+               $dxchan->enhanced(1);
+               $dxchan->ve7cc(1);
+               $conn->conns($call);
+               $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);
+                       #       } 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";
+               }
+               
+               # 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);});
@@ -688,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);
@@ -700,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);