X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCommandmode.pm;h=0f80232ac8432636ef1d65a6f9a0bf609672e960;hb=b67b50de92dbf61ce939b42f7c74e30dc58eba41;hp=ab82d904e9ba1eb5d1279f6303eaac4ae8869548;hpb=8e45a3dac2e136dc0c9d6f1e78f8c048a8d7ba21;p=spider.git diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index ab82d904..0f80232a 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -29,15 +29,17 @@ use DXDb; use AnnTalk; use WCY; use Sun; +use Internet; use strict; -use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase); +use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase $maxerrors); %Cache = (); # cache of dynamically loaded routine's mod times %cmd_cache = (); # cache of short names $errstr = (); # error string from eval %aliases = (); # aliases for (parts of) commands $scriptbase = "$main::root/scripts"; # the place where all users start scripts go +$maxerrors = 20; # the maximum number of concurrent errors allowed before disconnection # # obtain a new connection this is derived from dxchannel @@ -65,7 +67,7 @@ sub start $self->send_file($main::motd) if (-e $main::motd); $self->state('prompt'); # a bit of room for further expansion, passwords etc $self->{priv} = $user->priv || 0; - $self->{lang} = $user->lang || 'en'; + $self->{lang} = $user->lang || $main::lang || 'en'; $self->{pagelth} = $user->pagelth || 20; $self->{priv} = 0 if $line =~ /^(ax|te)/; # set the connection priv to 0 - can be upgraded later $self->{consort} = $line; # save the connection type @@ -81,6 +83,12 @@ sub start $self->{logininfo} = $user->wantlogininfo; $self->{here} = 1; + # get the filters + $self->{spotsfilter} = Filter::read_in('spots', $call, 0) || Filter::read_in('spots', 'user_default', 0); + $self->{wwvfilter} = Filter::read_in('wwv', $call, 0) || Filter::read_in('wwv', 'user_default', 0); + $self->{wcyfilter} = Filter::read_in('wcy', $call, 0) || Filter::read_in('wcy', 'user_default', 0); + $self->{annfilter} = Filter::read_in('ann', $call, 0) || Filter::read_in('ann', 'user_default', 0) ; + # clean up qra locators my $qra = $user->qra; $qra = undef if ($qra && !DXBearing::is_qra($qra)); @@ -95,6 +103,11 @@ sub start my $cuser = DXNodeuser->new($self, $node, $call, 0, 1); $node->dxchan($self) if $call eq $main::myalias; # send all output for mycall to myalias + # routing version + my $pref = Route::Node::get($main::mycall) or die "$main::mycall not allocated in Route database"; + $pref->add_user($call, Route::here($self->{here})); + dbg('route', "B/C PC16 on $main::mycall for: $call"); + # issue a pc16 to everybody interested my $nchan = DXChannel->get($main::mycall); my @pc16 = DXProt::pc16($nchan, $cuser); @@ -111,7 +124,7 @@ sub start $self->send($self->msg('qll')) if !$user->qra || (!$user->lat && !$user->long); $self->send($self->msg('hnodee1')) if !$user->qth; $self->send($self->msg('m9')) if DXMsg::for_me($call); - $self->send($self->msg('pr', $call)); + $self->prompt; # decide on echo if (!$user->wantecho) { @@ -180,10 +193,7 @@ sub normal } elsif ($self->{state} eq 'talk') { if ($cmdline =~ m{^(?:/EX|/ABORT)}i) { for (@{$self->{talklist}}) { - my $ent = $_; - my ($to, $via) = $ent =~ /(\S+)>(\S+)/; - my $dxchan = DXChannel->get($via); - $dxchan->talk($self->{call}, $to, $via, $self->msg('talkend')) if $dxchan; + $self->send_talks($_, $self->msg('talkend')); } $self->state('prompt'); delete $self->{talklist}; @@ -194,21 +204,7 @@ sub normal } elsif ($self->{talklist} && @{$self->{talklist}}) { # send what has been said to whoever is in this person's talk list for (@{$self->{talklist}}) { - my $ent = $_; - my ($to, $via) = $ent =~ /(\S+)>(\S+)/; - my $dxchan = DXChannel->get($via); - if ($dxchan && DXCluster->get_exact($to)) { - $dxchan->talk($self->{call}, $to, $via, $cmdline); - } else { - $self->send($self->msg('disc2', $via ? $via : $to)); - my @l = grep { $_ ne $ent } @{$self->{talklist}}; - if (@l) { - $self->{talklist} = \@l; - } else { - delete $self->{talklist}; - $self->state('prompt'); - } - } + $self->send_talks($_, $cmdline); } $self->send($self->talk_prompt) if $self->{state} eq 'talk'; } else { @@ -223,12 +219,37 @@ sub normal $self->prompt() if $self->{state} =~ /^prompt/o; } +# send out the talk messages taking into account vias and connectivity +sub send_talks +{ + my ($self, $ent, $line) = @_; + + my ($to, $via) = $ent =~ /(\S+)>(\S+)/; + $to = $ent unless $to; + my $call = $via ? $via : $to; + my $clref = DXCluster->get_exact($call); + my $dxchan = $clref->dxchan if $clref; + if ($dxchan) { + $dxchan->talk($self->{call}, $to, $via, $line); + } else { + $self->send($self->msg('disc2', $via ? $via : $to)); + my @l = grep { $_ ne $ent } @{$self->{talklist}}; + if (@l) { + $self->{talklist} = \@l; + } else { + delete $self->{talklist}; + $self->state('prompt'); + } + } +} + sub talk_prompt { my $self = shift; my @call; for (@{$self->{talklist}}) { my ($to, $via) = /(\S+)>(\S+)/; + $to = $_ unless $to; push @call, $to; } return $self->msg('talkprompt', join(',', @call)); @@ -250,7 +271,7 @@ sub send_ans $line =~ s/\s+$//o; # why am having to do this? $self->send($line); } - $self->{pagedata} = \@_; + $self->{pagedata} = [ @_ ]; $self->state('page'); $self->send($self->msg('page', scalar @_)); } else { @@ -288,7 +309,7 @@ sub run_cmd # split the command line up into parts, the first part is the command my ($cmd, $args) = split /\s+/, $cmdline, 2; - $args = "" unless $args; + $args = "" unless defined $args; if ($cmd) { @@ -300,7 +321,7 @@ sub run_cmd my $acmd = CmdAlias::get_cmd($cmd); if ($acmd) { ($cmd, $args) = split /\s+/, "$acmd $args", 2; - $args = "" unless $args; + $args = "" unless defined $args; dbg('command', "aliased cmd: $cmd $args"); } @@ -336,12 +357,27 @@ sub run_cmd } } else { dbg('command', "cmd: $cmd not found"); - return ($self->msg('e1')); + if (++$self->{errors} > $maxerrors) { + $self->send($self->msg('e26')); + $self->disconnect; + return (); + } else { + return ($self->msg('e1')); + } } } } - shift @ans; + my $ok = shift @ans; + if ($ok) { + delete $self->{errors}; + } else { + if (++$self->{errors} > $maxerrors) { + $self->send($self->msg('e26')); + $self->disconnect; + return (); + } + } return (@ans); } @@ -369,29 +405,26 @@ sub process # # finish up a user context # -sub finish +sub disconnect { my $self = shift; - my $conn = shift; my $call = $self->call; - # I was the last node visited - $self->user->node($main::mycall); - - # log out text - if ($conn && -e "$main::data/logout") { - open(I, "$main::data/logout") or confess; - my @in = ; - close(I); - $self->send_now('D', @in); - sleep(1); + # reset the redirection of messages back to 'normal' if we are the sysop + if ($call eq $main::myalias) { + my $node = DXNode->get($main::mycall) or die "$main::mycall not allocated in DXNode database"; + $node->dxchan($DXProt::me); } - if ($call eq $main::myalias) { # unset the channel if it is us really - my $node = DXNode->get($main::mycall); - $node->{dxchan} = 0; + my $pref = Route::Node::get($main::mycall); + if ($pref) { + my @rout = $pref->del_user($main::mycall); + dbg('route', "B/C PC17 on $main::mycall for: $call"); } - + + # I was the last node visited + $self->user->node($main::mycall); + # issue a pc17 to everybody interested my $nchan = DXChannel->get($main::mycall); my $pc17 = $nchan->pc17($self); @@ -403,6 +436,8 @@ sub finish Log('DXCommand', "$call disconnected"); my $ref = DXCluster->get_exact($call); $ref->del() if $ref; + + $self->SUPER::disconnect; } # @@ -412,7 +447,7 @@ sub finish sub prompt { my $self = shift; - $self->send($self->msg($self->here ? 'pr' : 'pr2', $self->call)); + $self->send($self->msg($self->here ? 'pr' : 'pr2', $self->call, cldate($main::systime), ztime($main::systime))); } # broadcast a message to all users [except those mentioned after buffer] @@ -622,7 +657,7 @@ sub talk { my ($self, $from, $to, $via, $line) = @_; $line =~ s/\\5E/\^/g; - $self->send("$to de $from $line") if $self->{talk}; + $self->send("$to de $from: $line") if $self->{talk}; Log('talk', $to, $from, $main::mycall, $line); }