many changes (see Changes)
[spider.git] / perl / DXCommandmode.pm
index fda298b13e54ddf8e8fe3c333e47b2cc6550ce5c..510adac255f8a7caa397d1f88daf866f2057569d 100644 (file)
@@ -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;