+
+# send a message to call on conn and disconnect
+sub already_conn
+{
+ my ($conn, $call, $mess) = @_;
+
+ $conn->disable_read(1);
+ dbg("-> D $call $mess\n") if isdbg('chan');
+ $conn->send_now("D$call|$mess");
+ sleep(2);
+ $conn->disconnect;
+}
+
+sub error_handler
+{
+ my $dxchan = shift;
+ $dxchan->{conn}->set_error(undef) if exists $dxchan->{conn};
+ $dxchan->disconnect(1);
+}
+
+# handle incoming messages
+sub new_channel
+{
+ my ($conn, $msg) = @_;
+ 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, 'concluster', $call, $main::mycall));
+ return;
+ }
+ if ($bumpexisting && $call ne $main::mycall) {
+ my $ip = $conn->{peerhost} || 'unknown';
+ $dxchan->send_now('D', DXM::msg($lang, 'conbump', $call, $ip));
+ Log('DXCommand', "$call bumped off by $ip, disconnected");
+ dbg("$call bumped off by $ip, disconnected");
+ $dxchan->disconnect;
+ } else {
+ already_conn($conn, $call, DXM::msg($lang, 'conother', $call, $main::mycall));
+ 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";
+ Log('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);
+ }
+
+ # 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) {
+ $dxchan = BBS->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');
+
+ # set callbacks
+ $conn->set_error(sub {error_handler($dxchan)});
+ $conn->set_rproc(sub {my ($conn,$msg) = @_; $dxchan->rec($msg);});
+ $dxchan->rec($msg);
+}
+
+
+sub login
+{
+ return \&new_channel;
+}
+
+# cease running this program, close down all the connections nicely
+sub cease
+{
+ my $dxchan;
+
+ unless ($is_win) {
+ $SIG{'TERM'} = 'IGNORE';
+ $SIG{'INT'} = 'IGNORE';
+ }
+
+ DXUser::sync;
+
+ eval {
+ Local::finish(); # end local processing
+ };
+ dbg("Local::finish error $@") if $@;
+
+ # disconnect nodes
+ foreach $dxchan (grep {$_->is_node || $_->is_aranea} DXChannel::get_all()) {
+ $dxchan->disconnect(2) unless $dxchan == $main::me;
+ }
+ Msg->event_loop(100, 0.01);
+
+ # disconnect users
+ foreach $dxchan (DXChannel::get_all_users) {
+ $dxchan->disconnect;
+ }
+
+ # disconnect AGW
+ AGWMsg::finish();
+
+ # disconnect UDP customers
+ UDPMsg::finish();
+
+ # end everything else
+ Msg->event_loop(100, 0.01);
+ DXUser::finish();
+ DXDupe::finish();
+
+ # close all databases
+ DXDb::closeall;
+
+ # close all listeners
+ foreach my $l (@listeners) {
+ $l->close_server;
+ }
+
+ dbg("DXSpider version $version, build $build ended") if isdbg('chan');
+ Log('cluster', "DXSpider V$version, build $build ended");
+ dbgclose();
+ Logclose();
+ unlink $lockfn;
+# $SIG{__WARN__} = $SIG{__DIE__} = sub {my $a = shift; cluck($a); };
+ exit(0);
+}
+
+# the reaper of children
+sub reap
+{
+ my $cpid;
+ while (($cpid = waitpid(-1, WNOHANG)) > 0) {
+ dbg("cpid: $cpid") if isdbg('reap');
+# Msg->pid_gone($cpid);
+ $zombies-- if $zombies > 0;
+ }
+ dbg("cpid: $cpid") if isdbg('reap');
+}
+
+# this is where the input queue is dealt with and things are dispatched off to other parts of
+# the cluster
+
+sub uptime
+{
+ my $t = $systime - $starttime;
+ my $days = int $t / 86400;
+ $t -= $days * 86400;
+ my $hours = int $t / 3600;
+ $t -= $hours * 3600;
+ my $mins = int $t / 60;
+ return sprintf "%d %02d:%02d", $days, $hours, $mins;
+}
+
+sub AGWrestart
+{
+ AGWMsg::init(\&new_channel);
+}