X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCommandmode.pm;h=ac0fb62470a942cf5c8d95830d7ff77b02507385;hb=c4f04ae165fdc765f3baa26fa2b28b52cf967674;hp=ea9282afdcc03489a2b86262f4a1eb9a67c67472;hpb=cc579a96816b0bae5b37dc132942fc1075449cf3;p=spider.git

diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index ea9282af..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+)/ );
@@ -237,10 +239,18 @@ sub normal
 			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;
 }
@@ -558,6 +568,7 @@ sub clear_cmd_cache
 	
 	for (keys %Cache) {
 		undef *{$_};
+		dbg("Undefining cmd $_") if isdbg('command');
 	}
 	%cmd_cache = ();
 	%Cache = ();
@@ -625,8 +636,12 @@ sub find_cmd_name {
 		# get rid of any existing sub and try to compile the new one
 		no strict 'refs';
 
-		dbg("[Re]defining $package") if isdbg('command');
-		undef *$package;
+		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 };