Add badword handling for messages. Users will get rude messages back if

they try to send naughty words in msgs. Incoming messages with badwords will
be dropped on receipt and their contents logged.

diff --git a/Changes b/Changes
index 52793d3c1cb221f498820824337a9582aa17504d..be153215eff6c72fc52a51086190b9e483b54cd8 100644 (file)
--- a/Changes
+++ b/Changes
@@ -8,6 +8,9 @@ type things as well (this only works for a few wellknown english ones).
 5. Go back to the old way of caching commands (but without the silly warnings
 because I know better what I am doing now). This allows symbolic debugging
 of commands again without coredumps. Hurrah!
+6. Add badword handling for messages. Users will get rude messages back if
+they try to send naughty words in msgs. Incoming messages with badwords will
+be dropped on receipt and their contents logged.
 30Sep01=======================================================================
 1. made some small bug fixes in rspf checking and also messages. 
 23Sep01=======================================================================

diff --git a/cmd/unset/badword.pl b/cmd/unset/badword.pl
index 76f0cf1013436fff3d12217326ae5fa059ba8c0f..519604f112822aa9a67b50825d62d43021019204 100644 (file)
--- a/cmd/unset/badword.pl
+++ b/cmd/unset/badword.pl
@@ -6,5 +6,5 @@
 # $Id$
 #
 my ($self, $line) = @_;
-return $BadWord::badwords->unset(8, $self->msg('e6'), $self, $line);
+return $BadWords::badword->unset(8, $self->msg('e6'), $self, $line);
 

diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index ea9282afdcc03489a2b86262f4a1eb9a67c67472..3972e8b5b6509ebab966b8aa5303cab3e3cb6e69 100644 (file)
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -237,6 +237,7 @@ 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));
        } 
@@ -558,6 +559,7 @@ sub clear_cmd_cache
        
        for (keys %Cache) {
                undef *{$_};
+               dbg("Undefining cmd $_") if isdbg('command');
        }
        %cmd_cache = ();
        %Cache = ();
@@ -625,8 +627,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 };

diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm
index 45de0f9fa3d6a5682c52d0ee412e2805aa4df076..bb8cbb68331692ce272df62b938c94c54e27f6bd 100644 (file)
--- a/perl/DXMsg.pm
+++ b/perl/DXMsg.pm
@@ -298,6 +298,23 @@ sub process
                                                        return;
                                                }
 
+                                               # check the message for bad words 
+                                               my @words;
+                                               for (@{$ref->{lines}}) {
+                                                       push @words, BadWords::check($_);
+                                               }
+                                               push @words, BadWords::check($ref->{subject});
+                                               if (@words) {
+                                                       dbg("message with badwords '@words' $ref->{from} -> $ref->{to} '$ref->{subject}' origin: $ref->{origin}") if isdbg('msg');
+                                                       Log('msg',"message with badwords '@words' $ref->{from} -> $ref->{to} origin: $ref->{origin}");
+                                                       Log('msg',"subject: $ref->{subject}");
+                                                       for (@{$ref->{lines}}) {
+                                                               Log('msg', "line: $_");
+                                                       }
+                                                       $ref->stop_msg($self->call);
+                                                       return;
+                                               }
+                                                       
                                                $ref->{msgno} = next_transno("Msgno");
                                                push @{$ref->{gotit}}, $f[2]; # mark this up as being received
                                                $ref->store($ref->{lines});
@@ -868,6 +885,10 @@ sub do_send_stuff
                #  $DB::single = 1;
                confess "local var gone missing" if !ref $self->{loc};
                my $loc = $self->{loc};
+               if (my @ans = BadWords::check($line)) {
+                       Log('msg', $self->call . " used badwords: @ans to @{$loc->{to}} in msg");
+                       return ($self->msg('e17', @ans), $self->msg('m1'));
+               }
                $loc->{subject} = $line;
                $loc->{lines} = [];
                $self->state('sendbody');
@@ -920,12 +941,17 @@ sub do_send_stuff
                        $self->func(undef);
                        $self->state('prompt');
                } else {
+                       if (my @ans = BadWords::check($line)) {
+                               Log('msg', $self->call . " used badwords: @ans to @{$loc->{to}} subject: '$loc->{subject}' in msg");
+                               Log('msg', "line: $line");
+                               return ($self->msg('e17', @ans));
+                       }
                        
                        # i.e. it ain't and end or abort, therefore store the line
                        push @{$loc->{lines}}, length($line) > 0 ? $line : " ";
                }
        }
-       return (1, @out);
+       return @out;
 }
 
 # return the standard directory line for this ref 

diff --git a/perl/Editable.pm b/perl/Editable.pm
index b0b4e2627cbcf6d08f4789e1ce6b263635af8073..3dd7cff97b5eccdf418e402a737f692cb73c633a 100644 (file)
--- a/perl/Editable.pm
+++ b/perl/Editable.pm
@@ -13,18 +13,69 @@
 
 package Editable;
 
+use strict;
+
 use vars qw($VERSION $BRANCH);
 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0;
 $main::build += $VERSION;
 $main::branch += $BRANCH;
 
+use DXChannel;
+use DXDebug;
+use BadWords;
+
 sub new
 {
        my $pkg = shift;
        my $class = ref $pkg || $pkg;
        
-       return {}, $class; 
+       return {@_}, $class; 
+}
+
+sub copy
+{
+       my $self = shift;
+       return $self->new(%$self);
+}
+
+sub addline
+{
+       my $self = shift;
+       my $dxchan = shift;
+       my $line = shift;
+       
+       if (my @ans = BadWord::check($line)) {
+               return ($dxchan->msg('e17', @ans));
+       }
+       push @{$self->{lines}}, $line;
+       return ();
+}
+
+sub modline
+{
+       my $self = shift;
+       my $dxchan = shift;
+       my $no = shift;
+       my $line = shift;
+
+       if (my @ans = BadWord::check($line)) {
+               return ($dxchan->msg('e17', @ans));
+       }
+    ${$self->{lines}}[$no], $line;
+       return ();
+}
+
+sub lines
+{
+       my $self = shift;
+       return exists $self->{lines} ? (@{$self->{lines}}) : ();
+}
+
+sub nolines
+{
+       my $self = shift;
+       return exists $self->{lines} ? scalar @{$self->{lines}} : 0;
 }
 
 1;