From 417f55d271551683dfe1a49fb754024ba4731363 Mon Sep 17 00:00:00 2001
From: minima <minima>
Date: Mon, 1 Oct 2001 19:16:09 +0000
Subject: [PATCH] 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.

---
 Changes               |  3 +++
 cmd/unset/badword.pl  |  2 +-
 perl/DXCommandmode.pm | 10 ++++++--
 perl/DXMsg.pm         | 28 ++++++++++++++++++++++-
 perl/Editable.pm      | 53 ++++++++++++++++++++++++++++++++++++++++++-
 5 files changed, 91 insertions(+), 5 deletions(-)

diff --git a/Changes b/Changes
index 52793d3c..be153215 100644
--- 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 76f0cf10..519604f1 100644
--- 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 ea9282af..3972e8b5 100644
--- 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 45de0f9f..bb8cbb68 100644
--- 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 b0b4e262..3dd7cff9 100644
--- 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;
-- 
2.43.0