From 417f55d271551683dfe1a49fb754024ba4731363 Mon Sep 17 00:00:00 2001 From: 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