From: Dirk Koopman Date: Thu, 26 Oct 2017 01:20:53 +0000 (+0100) Subject: Start (serious) web interface work X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?p=spider.git;a=commitdiff_plain;h=c6a62ff483f8887b4157e111a405fef971ade8d9 Start (serious) web interface work Install and test basic connections from an associated web interface --- diff --git a/Changes b/Changes index 1563721c..49fda7c1 100644 --- 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======================================================================= diff --git a/dxweb/d_x_web.conf b/dxweb/d_x_web.conf index 43ae1744..5068a8e2 100644 --- a/dxweb/d_x_web.conf +++ b/dxweb/d_x_web.conf @@ -1,4 +1,4 @@ { perldoc => 1, - secrets => ['ac82f00b5490aa599f88feafe6b3af4014aefb5a'] + secrets => ['24b654c7cfab0585e42c3a8308755fb29757d70a'] } diff --git a/dxweb/dxweb b/dxweb/dxweb new file mode 120000 index 00000000..15745990 --- /dev/null +++ b/dxweb/dxweb @@ -0,0 +1 @@ +script/dxweb \ No newline at end of file diff --git a/perl/AnnTalk.pm b/perl/AnnTalk.pm index 6d477264..ee7ea515 100644 --- a/perl/AnnTalk.pm +++ b/perl/AnnTalk.pm @@ -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; diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 91900e4b..e4b513f6 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -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"; diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 85df95b1..46e4e03a 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -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 diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 60fc1afd..60d49eaf 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -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 diff --git a/perl/Web.pm b/perl/Web.pm index fbba02f6..eec12c68 100644 --- a/perl/Web.pm +++ b/perl/Web.pm @@ -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; diff --git a/perl/cluster.pl b/perl/cluster.pl index 6495027b..4205241a 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -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);