-sub rec
-{
- my ($conn, $msg, $err) = @_;
- my $dxchan = DXChannel->get_by_cnum($conn); # get the dxconnnect object for this message
-
- if (defined $err && $err) {
- disconnect($dxchan) if defined $dxchan;
- return;
- }
-
- # set up the basic channel info - this needs a bit more thought - there is duplication here
- if (!defined $dxchan) {
- my ($sort, $call, $line) = $msg =~ /^(\w)(\S+)\|(.*)$/;
-
- # is there one already connected?
- if (DXChannel->get($call)) {
- my $mess = DXM::msg('conother', $call);
- dbg('chan', "-> D $call $mess\n");
- $conn->send_now("D$call|$mess");
- sleep(1);
- dbg('chan', "-> Z $call bye\n");
- $conn->send_now("Z$call|bye"); # this will cause 'client' to disconnect
- return;
- }
-
- # is there one already connected elsewhere in the cluster?
- if (DXCluster->get($call)) {
- my $mess = DXM::msg('concluster', $call);
- dbg('chan', "-> D $call $mess\n");
- $conn->send_now("D$call|$mess");
- sleep(1);
- dbg('chan', "-> Z $call bye\n");
- $conn->send_now("Z$call|bye"); # this will cause 'client' to disconnect
- return;
- }
-
- my $user = DXUser->get($call);
- if (!defined $user) {
- $user = DXUser->new($call);
- }
-
- # create the channel
- $dxchan = DXCommandmode->new($call, $conn, $user) if ($user->sort eq 'U');
- $dxchan = DXProt->new($call, $conn, $user) if ($user->sort eq 'A');
- die "Invalid sort of user on $call = $sort" if !$dxchan;
- }
-
- # queue the message and the channel object for later processing
- if (defined $msg) {
- my $self = bless {}, "inqueue";
- $self->{dxchan} = $dxchan;
- $self->{data} = $msg;
- push @inqueue, $self;
- }
+sub new_channel
+{
+ my ($conn, $msg) = @_;
+ my ($sort, $call, $line) = DXChannel::decode_input(0, $msg);
+ return unless defined $sort;
+
+ 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;
+ }
+ $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);
+ }
+ $user->startt($main::systime);
+ $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 $lock;
+ $user = DXUser::get_current($call);
+ $conn->conns($call);
+ my $basecall = $call;
+ $basecall =~ s/-\d+$//; # remember this for later multiple user processing, it's used for other stuff than checking lockout status
+ if ($user) {
+ # make sure we act on any locked status that the actual incoming call has.
+ $lock = $user->lockout;
+ } elsif ($basecall ne $call) {
+ # if there isn't a SSID on the $call, then try the base
+ $user = DXUser::get_current($basecall);
+ $lock = $user->lockout if $user;
+ }
+
+ # now deal with the lock
+ if ($lock) {
+ my $host = $conn->peerhost;
+ LogDbg('', "$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?
+
+ $dxchan = DXChannel::get($call);
+ my $newcall = $call;
+ if ($dxchan) {
+ if ($user && $user->is_node) {
+ already_conn($conn, $call, DXM::msg($lang, 'conother', $call, $main::mycall));
+ return;
+ }
+ if ($allowmultiple && $user->is_user) {
+ # determine whether we are a candidate, have we flip-flopped frequently enough?
+ my @lastconns = @{$user->connlist} if $user->connlist;
+ my $allow = 0;
+ if (@lastconns >= $DXUser::maxconnlist) {
+ $allow = $lastconns[-1]->[0] - $lastconns[0]->[0] < $min_reconnection_rate;
+ }
+ # search for a spare ssid
+ L1: for (my $count = $call =~ /-\d+$/?0:1; $allow && $count < $allowmultiple; ) { # remember we have one call already
+ my $lastid = 1;
+ for (; $lastid < $max_ssid && $count < $allowmultiple; ++$lastid) {
+ my $chan = DXChannel::get("$basecall-$lastid");
+ if ($chan) {
+ ++$count;
+ next;
+ }
+ # we have a free call-ssid, save it
+ $newcall = "$basecall-$lastid";
+ last L1;
+ }
+ }
+ }
+
+ # handle "normal" (non-multiple) connections in the existing way
+ if ($call eq $newcall) {
+ if ($bumpexisting) {
+ my $ip = $dxchan->hostname;
+ $dxchan->send_now('D', DXM::msg($lang, 'conbump', $call, $ip));
+ LogDbg('', "$call bumped off by $ip, disconnected");
+ $dxchan->disconnect;
+ } else {
+ already_conn($conn, $call, DXM::msg($lang, 'conother', $call, $main::mycall));
+ return;
+ }
+ }
+
+ # make sure that the conn has the (possibly) new callsign
+ $conn->conns($newcall);
+ $msg =~ s/$call/$newcall/;
+ }
+
+
+ # (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+$allowmultiple) {
+ my $nodes = join ',', @n;
+ LogDbg('', "$call has too many connections ($v) at $nodes - disconnected");
+ already_conn($conn, $call, DXM::msg($lang, 'contomany', $call, $v, $nodes));
+ return;
+ }
+ }
+
+ if ($user) {
+ $user->{lang} = $main::lang if !$user->{lang}; # to autoupdate old systems
+ } else {
+ $user = DXUser->new($call);
+ }
+
+ # create the channel
+ # NOTE we are SHARING the same $user if $allowmultiple is > 1
+
+ $user->startt($systime); # mark the start time of this connection
+ if ($user->is_node) {
+ $dxchan = DXProt->new($call, $conn, $user);
+ } elsif ($user->is_rbn) {
+ $dxchan = RBN->new($newcall, $conn, $user);
+ } elsif ($user->is_user) {
+ $dxchan = DXCommandmode->new($newcall, $conn, $user);
+ } else {
+ die "Invalid sort of user on $call = $sort";
+ }
+ }
+
+
+ # set callbacks
+ $conn->set_error(sub {my $err = shift; LogDbg('', "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);