X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCommandmode.pm;h=ac0fb62470a942cf5c8d95830d7ff77b02507385;hb=c4f04ae165fdc765f3baa26fa2b28b52cf967674;hp=9f3c669e26922e39a7118170887048e27ff51f30;hpb=a8d4234c702d3cf6049a9e53bd07cfc924eaee25;p=spider.git diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 9f3c669e..ac0fb624 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -34,7 +34,7 @@ use Script; use strict; -use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase $maxerrors %nothereslug); +use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase $maxerrors %nothereslug $maxbadcount); %Cache = (); # cache of dynamically loaded routine's mod times %cmd_cache = (); # cache of short names @@ -42,6 +42,8 @@ $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 +$maxbadcount = 3; # no of bad words allowed before disconnection + use vars qw($VERSION $BRANCH); $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); @@ -61,7 +63,7 @@ sub new 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; + DXProt::route_pc16($main::me, $main::routeroot, @rout) if @rout; return $self; } @@ -132,7 +134,7 @@ sub start my $lastoper = $user->lastoper || 0; my $homenode = $user->homenode || ""; if ($homenode eq $main::mycall && $lastoper + $DXUser::lastoperinterval < $main::systime) { - run_cmd($DXProt::me, "forward/opernam $call"); + run_cmd($main::me, "forward/opernam $call"); $user->lastoper($main::systime); } @@ -228,10 +230,27 @@ sub normal # for safety $self->state('prompt'); } + } elsif (my $func = $self->{func}) { + no strict 'refs'; + my @ans; + if (ref $self->{edit}) { + eval { @ans = $self->{edit}->$func($self, $cmdline)}; + } else { + eval { @ans = &{$self->{func}}($self, $cmdline) }; + } + $self->send_ans("Syserr: on stored func $self->{func}", $@) if $@; + $self->send_ans(@ans); } else { $self->send_ans(run_cmd($self, $cmdline)); } - + + # check for excessive swearing + if ($self->{badcount} && $self->{badcount} >= $maxbadcount) { + Log('DXCommand', "$self->{call} logged out for excessive swearing"); + $self->disconnect; + return; + } + # send a prompt only if we are in a prompt state $self->prompt() if $self->{state} =~ /^prompt/o; } @@ -314,77 +333,54 @@ sub run_cmd my $cmdline = shift; my @ans; - if ($self->{func}) { - my $c = qq{ \@ans = $self->{func}(\$self, \$cmdline) }; - dbg("stored func cmd = $c\n") if isdbg('eval'); - eval $c; - if ($@) { - return ("Syserr: Eval err $errstr on stored func $self->{func}", $@); - } - } else { - return () if length $cmdline == 0; + return () if length $cmdline == 0; - # strip out // - $cmdline =~ s|//|/|og; + # strip out // + $cmdline =~ s|//|/|og; - # split the command line up into parts, the first part is the command - my ($cmd, $args) = split /\s+/, $cmdline, 2; - $args = "" unless defined $args; + # split the command line up into parts, the first part is the command + my ($cmd, $args) = split /\s+/, $cmdline, 2; + $args = "" unless defined $args; - if ($cmd) { + if ($cmd) { - my ($path, $fcmd); + my ($path, $fcmd); - dbg("cmd: $cmd") if isdbg('command'); + 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("aliased cmd: $cmd $args") 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("aliased cmd: $cmd $args") if isdbg('command'); + } - # first expand out the entry to a command - ($path, $fcmd) = search($main::localcmd, $cmd, "pl"); - ($path, $fcmd) = search($main::cmd, $cmd, "pl") if !$path || !$fcmd; + # first expand out the entry to a command + ($path, $fcmd) = search($main::localcmd, $cmd, "pl"); + ($path, $fcmd) = search($main::cmd, $cmd, "pl") if !$path || !$fcmd; - if ($path && $cmd) { - dbg("path: $cmd cmd: $fcmd") if isdbg('command'); + if ($path && $cmd) { + dbg("path: $cmd cmd: $fcmd") if isdbg('command'); - my $package = find_cmd_name($path, $fcmd); - @ans = (0) if !$package ; + my $package = find_cmd_name($path, $fcmd); + return ($@) if $@; - if ($package) { - dbg("package: $package") if isdbg('command'); - my $c; - unless (exists $Cache{$package}->{'sub'}) { - $c = eval $Cache{$package}->{'eval'}; - if ($@) { - return DXDebug::shortmess($@); - } - $Cache{$package}->{'sub'} = $c; - } - $c = $Cache{$package}->{'sub'}; - eval { - @ans = &{$c}($self, $args); - }; - - if ($@) { - #cluck($@); - return (DXDebug::shortmess($@)); - }; - } + if ($package) { + no strict 'refs'; + dbg("package: $package") if isdbg('command'); + eval { @ans = &$package($self, $args) }; + return (DXDebug::shortmess($@)) if $@; + } + } else { + dbg("cmd: $cmd not found") if isdbg('command'); + if (++$self->{errors} > $maxerrors) { + $self->send($self->msg('e26')); + $self->disconnect; + return (); } else { - 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')); - } + return ($self->msg('e1')); } } } @@ -451,7 +447,7 @@ sub disconnect } # issue a pc17 to everybody interested - DXProt::route_pc17($DXProt::me, $main::routeroot, @rout) if @rout; + DXProt::route_pc17($main::me, $main::routeroot, @rout) if @rout; # I was the last node visited $self->user->node($main::mycall); @@ -555,7 +551,7 @@ sub search $l = join '.', @lparts; # chop $dirfn; # remove trailing / $dirfn = "" unless $dirfn; - $cmd_cache{"$short_cmd"} = join(',', ($path, "$dirfn$l")); # cache it + $cmd_cache{$short_cmd} = join(',', ($path, "$dirfn$l")); # cache it dbg("got path: $path cmd: $dirfn$l\n") if isdbg('command'); return ($path, "$dirfn$l"); } @@ -568,7 +564,14 @@ sub search # clear the command name cache sub clear_cmd_cache { + no strict 'refs'; + + for (keys %Cache) { + undef *{$_}; + dbg("Undefining cmd $_") if isdbg('command'); + } %cmd_cache = (); + %Cache = (); } # @@ -584,39 +587,10 @@ sub clear_cmd_cache sub valid_package_name { my($string) = @_; - $string =~ s/([^A-Za-z0-9\/])/sprintf("_%2x",unpack("C",$1))/eg; - - #second pass only for words starting with a digit - $string =~ s|/(\d)|sprintf("/_%2x",unpack("C",$1))|eg; + $string =~ s|([^A-Za-z0-9_/])|sprintf("_%2x",unpack("C",$1))|eg; - #Dress it up as a real package name - $string =~ s/\//_/og; - return $string; -} - -# find a cmd reference -# this is really for use in user written stubs -# -# use the result as a symbolic reference:- -# -# no strict 'refs'; -# @out = &$r($self, $line); -# -sub find_cmd_ref -{ - my $cmd = shift; - my $r; - - if ($cmd) { - - # first expand out the entry to a command - my ($path, $fcmd) = search($main::localcmd, $cmd, "pl"); - ($path, $fcmd) = search($main::cmd, $cmd, "pl") if !$path || !$fcmd; - - # make sure it is loaded - $r = find_cmd_name($path, $fcmd); - } - return $r; + $string =~ s|/|_|g; + return "cmd_$string"; } # @@ -649,7 +623,7 @@ sub find_cmd_name { }; #wrap the code into a subroutine inside our unique package - my $eval = qq( sub { $sub } ); + my $eval = qq( sub $package { $sub } ); if (isdbg('eval')) { my @list = split /\n/, $eval; @@ -659,7 +633,19 @@ sub find_cmd_name { } } - $Cache{$package} = {mtime => $mtime, 'eval' => $eval }; + # get rid of any existing sub and try to compile the new one + no strict 'refs'; + + if (exists $Cache{$package}) { + dbg("Redefining $package") if isdbg('command'); + undef *$package; + } else { + dbg("Defining $package") if isdbg('command'); + } + eval $eval; + + $Cache{$package} = {mtime => $mtime }; + } return $package;