X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCommandmode.pm;h=510adac255f8a7caa397d1f88daf866f2057569d;hb=5756741d9682667ae5b0442c4e6f609bd481b6eb;hp=fda298b13e54ddf8e8fe3c333e47b2cc6550ce5c;hpb=a895f396222d99b306bbabe53dcb184131f7af2d;p=spider.git diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index fda298b1..510adac2 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -45,10 +45,12 @@ use Time::HiRes qw(gettimeofday tv_interval); use Mojo::IOLoop; use DXSubprocess; use Mojo::UserAgent; +use DXCIDR; use strict; use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase %nothereslug - $maxbadcount $msgpolltime $default_pagelth $cmdimportdir $users $maxusers); + $maxbadcount $msgpolltime $default_pagelth $cmdimportdir $users $maxusers +); %Cache = (); # cache of dynamically loaded routine's mod times %cmd_cache = (); # cache of short names @@ -73,14 +75,15 @@ sub new # routing, this must go out here to prevent race condx my $pkg = shift; my $call = shift; -# my @rout = $main::routeroot->add_user($call, Route::here(1)); - DXProt::_add_thingy($main::routeroot, [$call, 0, 0, 1, undef, undef, $self->hostname], ); + # my @rout = $main::routeroot->add_user($call, Route::here(1)); + my $ipaddr = alias_localhost($self->hostname); + DXProt::_add_thingy($main::routeroot, [$call, 0, 0, 1, undef, undef, $ipaddr], ); - # ALWAYS output the user + # ALWAYS output the user (except if the updates not enabled) my $ref = Route::User::get($call); if ($ref) { $main::me->route_pc16($main::mycall, undef, $main::routeroot, $ref); - $main::me->route_pc92a($main::mycall, undef, $main::routeroot, $ref) unless $DXProt::pc92_slug_changes; + $main::me->route_pc92a($main::mycall, undef, $main::routeroot, $ref) unless $DXProt::pc92_slug_changes || ! $DXProt::pc92_ad_enable; } return $self; @@ -105,6 +108,7 @@ sub start $self->{name} = $name ? $name : $call; $self->send($self->msg('l2',$self->{name})); + $self->send("Capabilities: ve7cc rbn"); $self->state('prompt'); # a bit of room for further expansion, passwords etc $self->{priv} = $user->priv || 0; $self->{lang} = $user->lang || $main::lang || 'en'; @@ -141,12 +145,14 @@ sub start $self->{here} = 1; $self->{prompt} = $user->prompt if $user->prompt; $self->{lastmsgpoll} = 0; - + $self->{rbnseeme} = $user->rbnseeme; + RBN::add_seeme($call) if $self->{rbnseeme}; + # sort out new dx spot stuff $user->wantdxcq(0) unless defined $user->{wantdxcq}; $user->wantdxitu(0) unless defined $user->{wantdxitu}; $user->wantusstate(0) unless defined $user->{wantusstate}; - + # sort out registration if ($main::reqreg == 2) { $self->{registered} = !$user->registered; @@ -157,13 +163,13 @@ sub start # establish slug queue, if required $self->{sluggedpcs} = []; $self->{isslugged} = $DXProt::pc92_slug_changes + $DXProt::last_pc92_slug + 5 if $DXProt::pc92_slug_changes; - $self->{isslugged} = 0 if $self->{priv} || $user->registered || $user->homenode eq $main::mycall; + $self->{isslugged} = 0 if $self->{priv} || $user->registered || ($user->homenode && $user->homenode eq $main::mycall); # send the relevant MOTD $self->send_motd; # sort out privilege reduction - $self->{priv} = 0 unless $self->{hostname} eq '127.0.0.1' || $self->{hostname} eq '::1' || $self->conn->{usedpasswd}; + $self->{priv} = 0 unless $self->{hostname} eq '127.0.0.1' || $self->conn->peerhost eq '127.0.0.1' || $self->{hostname} eq '::1' || $self->conn->{usedpasswd}; # get the filters my $nossid = $call; @@ -204,6 +210,11 @@ sub start $self->tell_login('loginu'); $self->tell_buddies('loginb'); + + # is this a bad ip address? + if (is_ipaddr($self->{hostname})) { + $self->{badip} = DXCIDR::find($self->{hostname}); + } # do we need to send a forward/opernam? my $lastoper = $user->lastoper || 0; @@ -250,6 +261,7 @@ sub normal my $self = shift; my $cmdline = shift; my @ans; + my @bad; # save this for them's that need it my $rawline = $cmdline; @@ -258,7 +270,7 @@ sub normal $cmdline =~ s/^\s*(.*)\s*$/$1/; if ($self->{state} eq 'page') { - my $i = $self->{pagelth}; + my $i = $self->{pagelth}-5; my $ref = $self->{pagedata}; my $tot = @$ref; @@ -269,7 +281,7 @@ sub normal } # send a tranche of data - while ($i-- > 0 && @$ref) { + for (; $i > 0 && @$ref; --$i) { my $line = shift @$ref; $line =~ s/\s+$//o; # why am having to do this? $self->send($line); @@ -336,15 +348,14 @@ sub normal } elsif ($cmdline =~ m|^/+\w+|) { $cmdline =~ s|^/||; my $sendit = $cmdline =~ s|^/+||; - my @in = $self->run_cmd($cmdline); - $self->send_ans(@in); - if ($sendit && $self->{talklist} && @{$self->{talklist}}) { - foreach my $l (@in) { - my @bad; - if (@bad = BadWords::check($l)) { - $self->badcount(($self->badcount||0) + @bad); - LogDbg('DXCommand', "$self->{call} swore: $l with words:" . join(',', @bad) . ")"); - } else { + if (@bad = BadWords::check($cmdline)) { + $self->badcount(($self->badcount||0) + @bad); + LogDbg('DXCommand', "$self->{call} swore: '$cmdline' with badwords: '" . join(',', @bad) . "'"); + } else { + my @in = $self->run_cmd($cmdline); + $self->send_ans(@in); + if ($sendit && $self->{talklist} && @{$self->{talklist}}) { + foreach my $l (@in) { for (@{$self->{talklist}}) { if ($self->{state} eq 'talk') { $self->send_talks($_, $l); @@ -358,10 +369,9 @@ sub normal $self->send($self->{state} eq 'talk' ? $self->talk_prompt : $self->chat_prompt); } elsif ($self->{talklist} && @{$self->{talklist}}) { # send what has been said to whoever is in this person's talk list - my @bad; if (@bad = BadWords::check($cmdline)) { $self->badcount(($self->badcount||0) + @bad); - LogDbg('DXCommand', "$self->{call} swore: $cmdline with words:" . join(',', @bad) . ")"); + LogDbg('DXCommand', "$self->{call} swore: '$cmdline' with badwords: '" . join(',', @bad) . "'"); } else { for (@{$self->{talklist}}) { if ($self->{state} eq 'talk') { @@ -393,11 +403,16 @@ sub normal } $self->send_ans(@ans); } else { - $self->send_ans(run_cmd($self, $cmdline)); +# if (@bad = BadWords::check($cmdline)) { +# $self->badcount(($self->badcount||0) + @bad); +# LogDbg('DXCommand', "$self->{call} swore: '$cmdline' with badwords: '" . join(',', @bad) . "'"); +# } else { + $self->send_ans(run_cmd($self, $cmdline)); +# } } # check for excessive swearing - if ($self->{badcount} && $self->{badcount} >= $maxbadcount) { + if ($maxbadcount && $self->{badcount} && $self->{badcount} >= $maxbadcount) { LogDbg('DXCommand', "$self->{call} logged out for excessive swearing"); $self->disconnect; return; @@ -439,7 +454,8 @@ sub send_chats my $msgid = DXProt::nextchatmsgid(); $text = "#$msgid $text"; - $main::me->normal(DXProt::pc93($target, $self->{call}, undef, $text)); + my $ipaddr = alias_localhost($self->hostname || '127.0.0.1'); + $main::me->normal(DXProt::pc93($target, $self->{call}, undef, $text, undef, $ipaddr)); } sub special_prompt @@ -642,6 +658,7 @@ sub disconnect return if $self->{disconnecting}++; delete $self->{senddbg}; + RBN::del_seeme($call); my $uref = Route::User::get($call); my @rout; @@ -653,7 +670,7 @@ sub disconnect # issue a pc17 to everybody interested $main::me->route_pc17($main::mycall, undef, $main::routeroot, $uref); - $main::me->route_pc92d($main::mycall, undef, $main::routeroot, $uref) unless $DXProt::pc92_slug_changes; + $main::me->route_pc92d($main::mycall, undef, $main::routeroot, $uref) unless $DXProt::pc92_slug_changes || ! $DXProt::pc92_ad_enable; } else { confess "trying to disconnect a non existant user $call"; } @@ -1051,7 +1068,21 @@ sub format_dx_spot } } - return sprintf "DX de %-8.8s%10.1f %-12.12s %-s $t$slot2", "$_[4]:", $_[0], $_[1], $comment; + my $o = sprintf("%-9s", $_[4] . ':'); + my $qrg = sprintf "%8.1f", $_[0]; + if (length $qrg >= 9) { + while (length($o)+length($qrg) > 17 && $o =~ / $/) { + chop $o; + } + } + my $spot = sprintf "%-12s", $_[1]; + my $front = "DX de $o $qrg $spot"; + while (length($front) > 38 && $front =~ / $/) { + chop $front; + } + + + return sprintf "$front %-s $t$slot2", $comment; } @@ -1315,7 +1346,6 @@ sub send_motd $self->send_file($motd) if -e $motd; } - # Punt off a long running command into a separate process # # This is called from commands to run some potentially long running @@ -1408,7 +1438,22 @@ sub spawn_cmd sub user_count { - return ($users, $maxusers); + return ($users, $maxusers); +} + +# alias localhost if required. This is designed to repress all localhost and other +# internal interfaces to a fixed (outside) IPv4 or IPV6 address +sub alias_localhost +{ + my $hostname = shift; + if ($hostname =~ /./) { + return $hostname unless $main::localhost_alias_ipv4; + return (grep $hostname eq $_, @main::localhost_names) ? $main::localhost_alias_ipv4 : $hostname; + } elsif ($hostname =~ /:/) { + return $hostname unless $main::localhost_alias_ipv6; + return (grep $hostname eq $_, @main::localhost_names) ? $main::localhost_alias_ipv6 : $hostname; + } + return $hostname; } 1;