X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCommandmode.pm;h=58b4296934c5a5ae0c6d44d81a5394ea01d9401c;hb=b672afe940f843351af2bc4a87b4c4239f3a5140;hp=ea9282afdcc03489a2b86262f4a1eb9a67c67472;hpb=cc579a96816b0bae5b37dc132942fc1075449cf3;p=spider.git diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index ea9282af..58b42969 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+)/ ); @@ -83,13 +85,11 @@ sub start $self->{name} = $name ? $name : $call; $self->send($self->msg('l2',$self->{name})); - $self->send_file($main::motd) if (-e $main::motd); $self->state('prompt'); # a bit of room for further expansion, passwords etc $self->{priv} = $user->priv || 0; $self->{lang} = $user->lang || $main::lang || 'en'; $self->{pagelth} = $user->pagelth || 20; - $self->{priv} = 0 if $line =~ /^(ax|te)/; # set the connection priv to 0 - can be upgraded later - ($self->{width}) = $line =~ /width=(\d+)/; + ($self->{width}) = $line =~ /width=(\d+)/; $line =~ s/\s*width=\d+\s*//; $self->{width} = 80 unless $self->{width} && $self->{width} > 80; $self->{consort} = $line; # save the connection type @@ -105,6 +105,24 @@ sub start $self->{ann_talk} = $user->wantann_talk; $self->{here} = 1; + # sort out registration + if ($main::reqreg == 1) { + $self->{registered} = $user->registered; + } elsif ($main::reqreg == 2) { + $self->{registered} = !$user->registered; + } else { + $self->{registered} = 1; + } + + + # decide which motd to send + my $motd = "${main::motd}_nor" unless $self->{registered}; + $motd = $main::motd unless $motd && -e $motd; + $self->send_file($motd) if -e $motd; + + # sort out privilege reduction + $self->{priv} = 0 if $line =~ /^(ax|te)/ && !$self->conn->{usedpasswd}; + # get the filters $self->{spotsfilter} = Filter::read_in('spots', $call, 0) || Filter::read_in('spots', 'user_default', 0); $self->{wwvfilter} = Filter::read_in('wwv', $call, 0) || Filter::read_in('wwv', 'user_default', 0); @@ -121,9 +139,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'); @@ -193,8 +213,8 @@ sub normal } } elsif ($self->{state} eq 'sysop') { my $passwd = $self->{user}->passwd; - my @pw = split / */, $passwd; if ($passwd) { + my @pw = grep {$_ !~ /\s/} split //, $passwd; my @l = @{$self->{passwd}}; my $str = "$pw[$l[0]].*$pw[$l[1]].*$pw[$l[2]].*$pw[$l[3]].*$pw[$l[4]]"; if ($cmdline =~ /$str/) { @@ -205,7 +225,31 @@ sub normal } else { $self->send($self->msg('sorry')); } - delete $self->{passwd}; + $self->state('prompt'); + } elsif ($self->{state} eq 'passwd') { + my $passwd = $self->{user}->passwd; + if ($passwd && $cmdline eq $passwd) { + $self->send($self->msg('pw1')); + $self->state('passwd1'); + } else { + $self->conn->{echo} = $self->conn->{decho}; + delete $self->conn->{decho}; + $self->send($self->msg('sorry')); + $self->state('prompt'); + } + } elsif ($self->{state} eq 'passwd1') { + $self->{passwd} = $cmdline; + $self->send($self->msg('pw2')); + $self->state('passwd2'); + } elsif ($self->{state} eq 'passwd2') { + if ($cmdline eq $self->{passwd}) { + $self->{user}->passwd($cmdline); + $self->send($self->msg('pw3')); + } else { + $self->send($self->msg('pw4')); + } + $self->conn->{echo} = $self->conn->{decho}; + delete $self->conn->{decho}; $self->state('prompt'); } elsif ($self->{state} eq 'talk') { if ($cmdline =~ m{^(?:/EX|/ABORT)}i) { @@ -220,8 +264,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 { @@ -236,11 +286,23 @@ sub normal } else { eval { @ans = &{$self->{func}}($self, $cmdline) }; } - $self->send_ans("Syserr: on stored func $self->{func}", $@) if $@; + if ($@) { + $self->send_ans("Syserr: on stored func $self->{func}", $@); + $self->state('prompt'); + undef $@; + } + $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 +620,7 @@ sub clear_cmd_cache for (keys %Cache) { undef *{$_}; + dbg("Undefining cmd $_") if isdbg('command'); } %cmd_cache = (); %Cache = (); @@ -625,8 +688,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 }; @@ -656,7 +723,7 @@ sub talk my ($self, $from, $to, $via, $line) = @_; $line =~ s/\\5E/\^/g; $self->local_send('T', "$to de $from: $line") if $self->{talk}; - Log('talk', $to, $from, $main::mycall, $line); + Log('talk', $to, $from, $via?$via:$main::mycall, $line); # send a 'not here' message if required unless ($self->{here} && $from ne $to) { my $key = "$to$from";