From: Dirk Koopman Date: Thu, 26 Oct 2017 01:21:58 +0000 (+0100) Subject: Merge branch 'mojo' of ssh://server/scm/spider into mojo X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=b77ffff21f9f6b8096de8abf032a904dfabba1f5;hp=8be46ac1786265a7ba6ee91b31141ecd017ecb49;p=spider.git Merge branch 'mojo' of ssh://server/scm/spider into mojo --- 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/LICENSE b/LICENSE index 5f221241..6a030628 100644 --- a/LICENSE +++ b/LICENSE @@ -1,131 +1,202 @@ + The Artistic License 2.0 + Copyright (c) 2000-2006, The Perl Foundation. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. +Preamble - The "Artistic License" +This license establishes the terms under which a given free software +Package may be copied, modified, distributed, and/or redistributed. +The intent is that the Copyright Holder maintains some artistic +control over the development of that Package while still keeping the +Package available as open source and free software. - Preamble +You are always permitted to make arrangements wholly outside of this +license directly with the Copyright Holder of a given Package. If the +terms of this license do not permit the full use that you propose to +make of the Package, you should contact the Copyright Holder and seek +a different licensing arrangement. -The intent of this document is to state the conditions under which a -Package may be copied, such that the Copyright Holder maintains some -semblance of artistic control over the development of the package, -while giving the users of the package the right to use and distribute -the Package in a more-or-less customary fashion, plus the right to make -reasonable modifications. +Definitions -Definitions: + "Copyright Holder" means the individual(s) or organization(s) + named in the copyright notice for the entire Package. - "Package" refers to the collection of files distributed by the - Copyright Holder, and derivatives of that collection of files - created through textual modification. - - "Standard Version" refers to such a Package if it has not been - modified, or has been modified in accordance with the wishes - of the Copyright Holder as specified below. - - "Copyright Holder" is whoever is named in the copyright or - copyrights for the package. - - "You" is you, if you're thinking about copying or distributing - this Package. + "Contributor" means any party that has contributed code or other + material to the Package, in accordance with the Copyright Holder's + procedures. - "Reasonable copying fee" is whatever you can justify on the - basis of media cost, duplication charges, time of people involved, - and so on. (You will not be required to justify it to the - Copyright Holder, but only to the computing community at large - as a market that must bear the fee.) + "You" and "your" means any person who would like to copy, + distribute, or modify the Package. - "Freely Available" means that no fee is charged for the item - itself, though there may be fees involved in handling the item. - It also means that recipients of the item may redistribute it - under the same conditions they received it. + "Package" means the collection of files distributed by the + Copyright Holder, and derivatives of that collection and/or of + those files. A given Package may consist of either the Standard + Version, or a Modified Version. -1. You may make and give away verbatim copies of the source form of the -Standard Version of this Package without restriction, provided that you -duplicate all of the original copyright notices and associated disclaimers. + "Distribute" means providing a copy of the Package or making it + accessible to anyone else, or in the case of a company or + organization, to others outside of your company or organization. -2. You may apply bug fixes, portability fixes and other modifications -derived from the Public Domain or from the Copyright Holder. A Package -modified in such a way shall still be considered the Standard Version. + "Distributor Fee" means any fee that you charge for Distributing + this Package or providing support for this Package to another + party. It does not mean licensing fees. -3. You may otherwise modify your copy of this Package in any way, provided -that you insert a prominent notice in each changed file stating how and -when you changed that file, and provided that you do at least ONE of the -following: + "Standard Version" refers to the Package if it has not been + modified, or has been modified only in ways explicitly requested + by the Copyright Holder. - a) place your modifications in the Public Domain or otherwise make them - Freely Available, such as by posting said modifications to Usenet or - an equivalent medium, or placing the modifications on a major archive - site such as uunet.uu.net, or by allowing the Copyright Holder to include - your modifications in the Standard Version of the Package. + "Modified Version" means the Package, if it has been changed, and + such changes were not explicitly requested by the Copyright + Holder. - b) use the modified Package only within your corporation or organization. + "Original License" means this Artistic License as Distributed with + the Standard Version of the Package, in its current version or as + it may be modified by The Perl Foundation in the future. - c) rename any non-standard executables so the names do not conflict - with standard executables, which must also be provided, and provide - a separate manual page for each non-standard executable that clearly - documents how it differs from the Standard Version. + "Source" form means the source code, documentation source, and + configuration files for the Package. - d) make other distribution arrangements with the Copyright Holder. + "Compiled" form means the compiled bytecode, object code, binary, + or any other form resulting from mechanical transformation or + translation of the Source form. -4. You may distribute the programs of this Package in object code or -executable form, provided that you do at least ONE of the following: - a) distribute a Standard Version of the executables and library files, - together with instructions (in the manual page or equivalent) on where - to get the Standard Version. +Permission for Use and Modification Without Distribution - b) accompany the distribution with the machine-readable source of - the Package with your modifications. +(1) You are permitted to use the Standard Version and create and use +Modified Versions for any purpose without restriction, provided that +you do not Distribute the Modified Version. - c) give non-standard executables non-standard names, and clearly - document the differences in manual pages (or equivalent), together - with instructions on where to get the Standard Version. - d) make other distribution arrangements with the Copyright Holder. +Permissions for Redistribution of the Standard Version -5. You may charge a reasonable copying fee for any distribution of this -Package. You may charge any fee you choose for support of this -Package. You may not charge a fee for this Package itself. However, -you may distribute this Package in aggregate with other (possibly -commercial) programs as part of a larger (possibly commercial) software -distribution provided that you do not advertise this Package as a -product of your own. You may embed this Package's interpreter within -an executable of yours (by linking); this shall be construed as a mere -form of aggregation, provided that the complete Standard Version of the -interpreter is so embedded. +(2) You may Distribute verbatim copies of the Source form of the +Standard Version of this Package in any medium without restriction, +either gratis or for a Distributor Fee, provided that you duplicate +all of the original copyright notices and associated disclaimers. At +your discretion, such verbatim copies may or may not include a +Compiled form of the Package. + +(3) You may apply any bug fixes, portability changes, and other +modifications made available from the Copyright Holder. The resulting +Package will still be considered the Standard Version, and as such +will be subject to the Original License. + + +Distribution of Modified Versions of the Package as Source + +(4) You may Distribute your Modified Version as Source (either gratis +or for a Distributor Fee, and with or without a Compiled form of the +Modified Version) provided that you clearly document how it differs +from the Standard Version, including, but not limited to, documenting +any non-standard features, executables, or modules, and provided that +you do at least ONE of the following: + + (a) make the Modified Version available to the Copyright Holder + of the Standard Version, under the Original License, so that the + Copyright Holder may include your modifications in the Standard + Version. + + (b) ensure that installation of your Modified Version does not + prevent the user installing or running the Standard Version. In + addition, the Modified Version must bear a name that is different + from the name of the Standard Version. + + (c) allow anyone who receives a copy of the Modified Version to + make the Source form of the Modified Version available to others + under + + (i) the Original License or + + (ii) a license that permits the licensee to freely copy, + modify and redistribute the Modified Version using the same + licensing terms that apply to the copy that the licensee + received, and requires that the Source form of the Modified + Version, and of any works derived from it, be made freely + available in that license fees are prohibited but Distributor + Fees are allowed. + + +Distribution of Compiled Forms of the Standard Version +or Modified Versions without the Source + +(5) You may Distribute Compiled forms of the Standard Version without +the Source, provided that you include complete instructions on how to +get the Source of the Standard Version. Such instructions must be +valid at the time of your distribution. If these instructions, at any +time while you are carrying out such distribution, become invalid, you +must provide new instructions on demand or cease further distribution. +If you provide valid instructions or cease distribution within thirty +days after you become aware that the instructions are invalid, then +you do not forfeit any of your rights under this license. + +(6) You may Distribute a Modified Version in Compiled form without +the Source, provided that you comply with Section 4 with respect to +the Source of the Modified Version. + + +Aggregating or Linking the Package + +(7) You may aggregate the Package (either the Standard Version or +Modified Version) with other packages and Distribute the resulting +aggregation provided that you do not charge a licensing fee for the +Package. Distributor Fees are permitted, and licensing fees for other +components in the aggregation are permitted. The terms of this license +apply to the use and Distribution of the Standard or Modified Versions +as included in the aggregation. + +(8) You are permitted to link Modified and Standard Versions with +other works, to embed the Package in a larger work of your own, or to +build stand-alone binary or bytecode versions of applications that +include the Package, and Distribute the result without restriction, +provided the result does not expose a direct interface to the Package. + + +Items That are Not Considered Part of a Modified Version + +(9) Works (including, but not limited to, modules and scripts) that +merely extend or make use of the Package, do not, by themselves, cause +the Package to be a Modified Version. In addition, such works are not +considered parts of the Package itself, and are not subject to the +terms of this license. + + +General Provisions + +(10) Any use, modification, and distribution of the Standard or +Modified Versions is governed by this Artistic License. By using, +modifying or distributing the Package, you accept this license. Do not +use, modify, or distribute the Package, if you do not accept this +license. + +(11) If your Modified Version has been derived from a Modified +Version made by someone other than you, you are nevertheless required +to ensure that your Modified Version complies with the requirements of +this license. + +(12) This license does not grant you the right to use any trademark, +service mark, tradename, or logo of the Copyright Holder. + +(13) This license includes the non-exclusive, worldwide, +free-of-charge patent license to make, have made, use, offer to sell, +sell, import and otherwise transfer the Package with respect to any +patent claims licensable by the Copyright Holder that are necessarily +infringed by the Package. If you institute patent litigation +(including a cross-claim or counterclaim) against any party alleging +that the Package constitutes direct or contributory patent +infringement, then this Artistic License to you shall terminate on the +date that such litigation is filed. + +(14) Disclaimer of Warranty: +THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS +IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED +WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR +NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL +LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL +BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL +DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF +ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -6. The scripts and library files supplied as input to or produced as -output from the programs of this Package do not automatically fall -under the copyright of this Package, but belong to whoever generated -them, and may be sold commercially, and may be aggregated with this -Package. If such scripts or library files are aggregated with this -Package via the so-called "undump" or "unexec" methods of producing a -binary executable image, then distribution of such an image shall -neither be construed as a distribution of this Package nor shall it -fall under the restrictions of Paragraphs 3 and 4, provided that you do -not represent such an executable image as a Standard Version of this -Package. - -7. C subroutines (or comparably compiled subroutines in other -languages) supplied by you and linked into this Package in order to -emulate subroutines and variables of the language defined by this -Package shall not be considered part of this Package, but are the -equivalent of input as in Paragraph 6, provided these subroutines do -not change the language in any way that would cause it to fail the -regression tests for the language. - -8. Aggregation of this Package with a commercial distribution is always -permitted provided that the use of this Package is embedded; that is, -when no overt attempt is made to make this Package's interfaces visible -to the end user of the commercial distribution. Such use shall not be -construed as a distribution of this Package. - -9. The name of the Copyright Holder may not be used to endorse or promote -products derived from this software without specific prior written permission. - -10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR -IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED -WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. - - The End diff --git a/dxweb/d_x_web.conf b/dxweb/d_x_web.conf new file mode 100644 index 00000000..5068a8e2 --- /dev/null +++ b/dxweb/d_x_web.conf @@ -0,0 +1,4 @@ +{ + perldoc => 1, + 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/dxweb/lib/DXWeb.pm b/dxweb/lib/DXWeb.pm new file mode 100644 index 00000000..68c5dcdb --- /dev/null +++ b/dxweb/lib/DXWeb.pm @@ -0,0 +1,21 @@ +package DXWeb; +use Mojo::Base 'Mojolicious'; + +# This method will run once at server start +sub startup { + my $self = shift; + + # Load configuration from hash returned by "my_app.conf" + my $config = $self->plugin('Config'); + + # Documentation browser under "/perldoc" + $self->plugin('PODRenderer') if $config->{perldoc}; + + # Router + my $r = $self->routes; + + # Normal route to controller + $r->get('/')->to('example#welcome'); +} + +1; diff --git a/dxweb/lib/DXWeb/Controller/Example.pm b/dxweb/lib/DXWeb/Controller/Example.pm new file mode 100644 index 00000000..e701b7bf --- /dev/null +++ b/dxweb/lib/DXWeb/Controller/Example.pm @@ -0,0 +1,12 @@ +package DXWeb::Controller::Example; +use Mojo::Base 'Mojolicious::Controller'; + +# This action will render a template +sub welcome { + my $self = shift; + + # Render template "example/welcome.html.ep" with message + $self->render(msg => 'Welcome to the Mojolicious real-time web framework!'); +} + +1; diff --git a/dxweb/public/index.html b/dxweb/public/index.html new file mode 100644 index 00000000..e74bb5f0 --- /dev/null +++ b/dxweb/public/index.html @@ -0,0 +1,11 @@ + + + + Welcome to the Mojolicious real-time web framework! + + +

Welcome to the Mojolicious real-time web framework!

+ This is the static document "public/index.html", + click here to get back to the start. + + diff --git a/dxweb/script/dxweb b/dxweb/script/dxweb new file mode 100755 index 00000000..4200773d --- /dev/null +++ b/dxweb/script/dxweb @@ -0,0 +1,11 @@ +#!/usr/bin/env perl + +use strict; +use warnings; + +use FindBin; +BEGIN { unshift @INC, "$FindBin::Bin/../lib" } +use Mojolicious::Commands; + +# Start command line interface for application +Mojolicious::Commands->start_app('DXWeb'); diff --git a/dxweb/t/basic.t b/dxweb/t/basic.t new file mode 100644 index 00000000..f6b2a686 --- /dev/null +++ b/dxweb/t/basic.t @@ -0,0 +1,9 @@ +use Mojo::Base -strict; + +use Test::More; +use Test::Mojo; + +my $t = Test::Mojo->new('DXWeb'); +$t->get_ok('/')->status_is(200)->content_like(qr/Mojolicious/i); + +done_testing(); diff --git a/dxweb/templates/example/welcome.html.ep b/dxweb/templates/example/welcome.html.ep new file mode 100644 index 00000000..1efd0982 --- /dev/null +++ b/dxweb/templates/example/welcome.html.ep @@ -0,0 +1,13 @@ +% layout 'default'; +% title 'Welcome'; +

<%= $msg %>

+

+ This page was generated from the template "templates/example/welcome.html.ep" + and the layout "templates/layouts/default.html.ep", + <%= link_to 'click here' => url_for %> to reload the page or + <%= link_to 'here' => '/index.html' %> to move forward to a static page. + % if (config 'perldoc') { + To learn more, you can also browse through the documentation + <%= link_to 'here' => '/perldoc' %>. + % } +

diff --git a/dxweb/templates/layouts/default.html.ep b/dxweb/templates/layouts/default.html.ep new file mode 100644 index 00000000..599c5568 --- /dev/null +++ b/dxweb/templates/layouts/default.html.ep @@ -0,0 +1,5 @@ + + + <%= title %> + <%= content %> + 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);