X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCommandmode.pm;h=c7ce8c3c7f6699e8313740a7d95afd4766ba6eaa;hb=19980464653659320e9b143f3da34b38bb908cb9;hp=3c45aee968f0c1c0ebc8c1c560f8f0e184d51d5a;hpb=29cfbdc85ae44c73dd0a036ab3f19d6040505fba;p=spider.git diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 3c45aee9..c7ce8c3c 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -32,13 +32,14 @@ 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 @@ -47,6 +48,13 @@ $scriptbase = "$main::root/scripts"; # the place where all users start scripts g sub new { my $self = DXChannel::alloc(@_); + + # routing, this must go out here to prevent race condx + my $pkg = shift; + my $call = shift; + my @rout = $main::routeroot->add_user($call, Route::here(1)); + DXProt::route_pc16($DXProt::me, $main::routeroot, @rout) if @rout; + return $self; } @@ -97,21 +105,12 @@ sub start $user->qra(DXBearing::lltoqra($lat, $long)) if (defined $lat && defined $long); } - # add yourself to the database - my $node = DXNode->get($main::mycall) or die "$main::mycall not allocated in DXNode database"; - my $cuser = DXNodeuser->new($self, $node, $call, 0, 1); - $node->dxchan($self) if $call eq $main::myalias; # send all output for mycall to myalias + $DXProt::me->conn($self->conn) if $call eq $main::myalias; # send all output for mycall to myalias - # issue a pc16 to everybody interested - my $nchan = DXChannel->get($main::mycall); - my @pc16 = DXProt::pc16($nchan, $cuser); - for (@pc16) { - DXProt::broadcast_all_ak1a($_); - } Log('DXCommand', "$call connected"); # send prompts and things - my $info = DXCluster::cluster(); + my $info = Route::cluster(); $self->send("Cluster:$info"); $self->send($self->msg('namee1')) if !$user->name; $self->send($self->msg('qthe1')) if !$user->qth; @@ -221,7 +220,7 @@ sub send_talks my ($to, $via) = $ent =~ /(\S+)>(\S+)/; $to = $ent unless $to; my $call = $via ? $via : $to; - my $clref = DXCluster->get_exact($call); + my $clref = Route::get($call); my $dxchan = $clref->dxchan if $clref; if ($dxchan) { $dxchan->talk($self->{call}, $to, $via, $line); @@ -289,7 +288,7 @@ sub run_cmd if ($self->{func}) { my $c = qq{ \@ans = $self->{func}(\$self, \$cmdline) }; - dbg('eval', "stored func cmd = $c\n"); + dbg("stored func cmd = $c\n") if isdbg('eval'); eval $c; if ($@) { return ("Syserr: Eval err $errstr on stored func $self->{func}", $@); @@ -309,14 +308,14 @@ sub run_cmd my ($path, $fcmd); - dbg('command', "cmd: $cmd"); + dbg("cmd: $cmd") if isdbg('command'); # alias it if possible my $acmd = CmdAlias::get_cmd($cmd); if ($acmd) { ($cmd, $args) = split /\s+/, "$acmd $args", 2; $args = "" unless defined $args; - dbg('command', "aliased cmd: $cmd $args"); + dbg("aliased cmd: $cmd $args") if isdbg('command'); } # first expand out the entry to a command @@ -324,13 +323,13 @@ sub run_cmd ($path, $fcmd) = search($main::cmd, $cmd, "pl") if !$path || !$fcmd; if ($path && $cmd) { - dbg('command', "path: $cmd cmd: $fcmd"); + dbg("path: $cmd cmd: $fcmd") if isdbg('command'); my $package = find_cmd_name($path, $fcmd); @ans = (0) if !$package ; if ($package) { - dbg('command', "package: $package"); + dbg("package: $package") if isdbg('command'); my $c; unless (exists $Cache{$package}->{'sub'}) { $c = eval $Cache{$package}->{'eval'}; @@ -350,13 +349,28 @@ sub run_cmd }; } } else { - dbg('command', "cmd: $cmd not found"); - return ($self->msg('e1')); + dbg("cmd: $cmd not found") if isdbg('command'); + 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); } @@ -384,46 +398,31 @@ sub process # # finish up a user context # -sub finish +sub disconnect { my $self = shift; - my $conn = shift; my $call = $self->call; # 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); + $DXProt::me->conn(undef); } - # 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); - } + my @rout = $main::routeroot->del_user($call); + dbg("B/C PC17 on $main::mycall for: $call") if isdbg('route'); -# if ($call eq $main::myalias) { # unset the channel if it is us really -# my $node = DXNode->get($main::mycall); -# $node->{dxchan} = 0; -# } - # issue a pc17 to everybody interested - my $nchan = DXChannel->get($main::mycall); - my $pc17 = $nchan->pc17($self); - DXProt::broadcast_all_ak1a($pc17); + DXProt::route_pc17($DXProt::me, $main::routeroot, @rout) if @rout; + # I was the last node visited + $self->user->node($main::mycall); + # send info to all logged in thingies $self->tell_login('logoutu'); Log('DXCommand', "$call disconnected"); - my $ref = DXCluster->get_exact($call); - $ref->del() if $ref; + + $self->SUPER::disconnect; } # @@ -485,7 +484,7 @@ sub search # commands are lower case $short_cmd = lc $short_cmd; - dbg('command', "command: $path $short_cmd\n"); + dbg("command: $path $short_cmd\n") if isdbg('command'); # do some checking for funny characters return () if $short_cmd =~ /\/$/; @@ -493,7 +492,7 @@ sub search # return immediately if we have it ($apath, $acmd) = split ',', $cmd_cache{$short_cmd} if $cmd_cache{$short_cmd}; if ($apath && $acmd) { - dbg('command', "cached $short_cmd = ($apath, $acmd)\n"); + dbg("cached $short_cmd = ($apath, $acmd)\n") if isdbg('command'); return ($apath, $acmd); } @@ -515,7 +514,7 @@ sub search next if $l =~ /^\./; if ($i < $#parts) { # we are dealing with directories if ((-d "$curdir/$l") && $p eq substr($l, 0, length $p)) { - dbg('command', "got dir: $curdir/$l\n"); + dbg("got dir: $curdir/$l\n") if isdbg('command'); $dirfn .= "$l/"; $curdir .= "/$l"; last; @@ -529,7 +528,7 @@ sub search # chop $dirfn; # remove trailing / $dirfn = "" unless $dirfn; $cmd_cache{"$short_cmd"} = join(',', ($path, "$dirfn$l")); # cache it - dbg('command', "got path: $path cmd: $dirfn$l\n"); + dbg("got path: $path cmd: $dirfn$l\n") if isdbg('command'); return ($path, "$dirfn$l"); } } @@ -628,7 +627,7 @@ sub find_cmd_name { my @list = split /\n/, $eval; my $line; for (@list) { - dbg('eval', $_, "\n"); + dbg($_ . "\n") if isdbg('eval'); } } @@ -645,6 +644,15 @@ sub talk $line =~ s/\\5E/\^/g; $self->send("$to de $from: $line") if $self->{talk}; Log('talk', $to, $from, $main::mycall, $line); + # send a 'not here' message if required + unless ($self->{here} && $from ne $to) { + my ($ref, $dxchan); + if (($ref = Route::get($from)) && ($dxchan = $ref->dxchan)) { + my $name = $self->user->name || $to; + my $s = $self->user->nothere || $dxchan->msg('nothere', $name); + $dxchan->talk($to, $from, undef, $s); + } + } } # send an announce