put in a prototype echo handler in Msg/ExtMsg

[spider.git] / perl / DXCommandmode.pm

diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index ea9282afdcc03489a2b86262f4a1eb9a67c67472..97ac48623e192cd47b78488996edeb2823a9d3c3 100644 (file)
--- 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+)/ );
@@ -121,9 +123,11 @@ sub start
        }
 
        # decide on echo
-       if (!$user->wantecho) {
+       my $echo = $user->wantecho;
+       unless ($echo) {
                $self->send_now('E', "0");
                $self->send($self->msg('echow'));
+               $self->conn->echo($echo) if $self->conn->can('echo');
        }
        
        $self->tell_login('loginu');
@@ -220,8 +224,14 @@ sub normal
                        $self->send($self->talk_prompt);
                } elsif ($self->{talklist} && @{$self->{talklist}}) {
                        # send what has been said to whoever is in this person's talk list
-                       for (@{$self->{talklist}}) {
-                               $self->send_talks($_, $cmdline);
+                       my @bad;
+                       if (@bad = BadWords::check($cmdline)) {
+                               $self->badcount(($self->badcount||0) + @bad);
+                               Log('DXCommand', "$self->{call} swore: $cmdline");
+                       } else {
+                               for (@{$self->{talklist}}) {
+                                       $self->send_talks($_, $cmdline);
+                               }
                        }
                        $self->send($self->talk_prompt) if $self->{state} eq 'talk';
                } else {
@@ -237,10 +247,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 +576,7 @@ sub clear_cmd_cache
        
        for (keys %Cache) {
                undef *{$_};
+               dbg("Undefining cmd $_") if isdbg('command');
        }
        %cmd_cache = ();
        %Cache = ();
@@ -625,8 +644,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 };