Change DXUser->get* to DXUser::get*
[spider.git] / perl / DXCommandmode.pm
index 3eb9a1c6ce7ff153bebb30db4affbc9cf59dc227..854a635496e058a651896d04bc8f412a381f84ea 100644 (file)
@@ -4,7 +4,7 @@
 #
 # Copyright (c) 1998 Dirk Koopman G1TLH
 #
-# $Id$
+#
 # 
 
 package DXCommandmode;
@@ -39,7 +39,7 @@ use VE7CC;
 use DXXml;
 
 use strict;
-use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase $maxerrors %nothereslug
+use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase %nothereslug
        $maxbadcount $msgpolltime $default_pagelth $cmdimportdir);
 
 %Cache = ();                                   # cache of dynamically loaded routine's mod times
@@ -47,7 +47,6 @@ use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase $maxerrors %notheresl
 $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
 $msgpolltime = 3600;                   # the time between polls for new messages 
 $cmdimportdir = "$main::root/cmd_import"; # the base directory for importing command scripts 
@@ -65,13 +64,14 @@ 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));
+#      my @rout = $main::routeroot->add_user($call, Route::here(1));
+       DXProt::_add_thingy($main::routeroot, [$call, 0, 0, 1]);
 
        # ALWAYS output the user
        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);
+               $main::me->route_pc92a($main::mycall, undef, $main::routeroot, $ref) unless $DXProt::pc92_slug_changes;
        }
 
        return $self;
@@ -142,6 +142,13 @@ sub start
        }
        $motd = "${main::motd}_$self->{lang}" unless $motd && -e $motd;
        $motd = $main::motd unless $motd && -e $motd;
+       if ($self->conn->{csort} eq 'ax25') {
+               if ($motd) {
+                       $motd = "${motd}_ax25" if -e "${motd}_ax25";
+               } else {
+                       $motd = "${main::motd}_ax25" if -e "${main::motd}_ax25";
+               }
+       }
        $self->send_file($motd) if -e $motd;
 
        # sort out privilege reduction
@@ -302,10 +309,14 @@ sub normal
                $self->conn->{echo} = $self->conn->{decho};
                delete $self->conn->{decho};
                $self->state('prompt');
-       } elsif ($self->{state} eq 'talk') {
+       } elsif ($self->{state} eq 'talk' || $self->{state} eq 'chat') {
                if ($cmdline =~ m{^(?:/EX|/ABORT)}i) {
                        for (@{$self->{talklist}}) {
-                               $self->send_talks($_,  $self->msg('talkend'));
+                               if ($self->{state} eq 'talk') {
+                                       $self->send_talks($_,  $self->msg('talkend'));
+                               } else {
+                                       $self->local_send('C', $self->msg('chatend', $_));
+                               }
                        }
                        $self->state('prompt');
                        delete $self->{talklist};
@@ -322,12 +333,16 @@ sub normal
                                                LogDbg('DXCommand', "$self->{call} swore: $l with words:" . join(',', @bad) . ")");
                                        } else {
                                                for (@{$self->{talklist}}) {
-                                                       $self->send_talks($_, $l);
+                                                       if ($self->{state} eq 'talk') {
+                                                               $self->send_talks($_, $l);
+                                                       } else {
+                                                               send_chats($self, $_, $l)
+                                                       }
                                                }
                                        }
                                }
                        }
-                       $self->send($self->talk_prompt);
+                       $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;
@@ -336,10 +351,15 @@ sub normal
                                LogDbg('DXCommand', "$self->{call} swore: $cmdline with words:" . join(',', @bad) . ")");
                        } else {
                                for (@{$self->{talklist}}) {
-                                       $self->send_talks($_, $rawline);
+                                       if ($self->{state} eq 'talk') {
+                                               $self->send_talks($_, $rawline);
+                                       } else {
+                                               send_chats($self, $_, $rawline);
+                                       }
                                }
                        }
                        $self->send($self->talk_prompt) if $self->{state} eq 'talk';
+                       $self->send($self->chat_prompt) if $self->{state} eq 'chat';
                } else {
                        # for safety
                        $self->state('prompt');
@@ -398,16 +418,40 @@ sub send_talks
        }
 }
 
-sub talk_prompt
+sub send_chats
 {
        my $self = shift;
+       my $target = shift;
+       my $text = shift;
+
+       my $msgid = DXProt::nextchatmsgid();
+       $text = "#$msgid $text";
+       $main::me->normal(DXProt::pc93($target, $self->{call}, undef, $text));
+}
+
+sub special_prompt
+{
+       my $self = shift;
+       my $prompt = shift;
        my @call;
        for (@{$self->{talklist}}) {
                my ($to, $via) = /(\S+)>(\S+)/;
                $to = $_ unless $to;
                push @call, $to;
        }
-       return $self->msg('talkprompt', join(',', @call));
+       return $self->msg($prompt, join(',', @call));
+}
+
+sub talk_prompt
+{
+       my $self = shift;
+       return $self->special_prompt('talkprompt');
+}
+
+sub chat_prompt
+{
+       my $self = shift;
+       return $self->special_prompt('chatprompt');
 }
 
 #
@@ -439,6 +483,7 @@ sub send_ans
                }
        } 
 }
+
 # 
 # this is the thing that runs the command, it is done like this for the 
 # benefit of remote command execution
@@ -452,19 +497,22 @@ sub run_cmd
        my $cmdline = shift;
        my @ans;
        
-
        return () if length $cmdline == 0;
        
-       
        # split the command line up into parts, the first part is the command
        my ($cmd, $args) = split /\s+/, $cmdline, 2;
        $args = "" unless defined $args;
                
        if ($cmd) {
+
+               # check cmd
+               if ($cmd =~ m|^/| || $cmd =~ m|[^-?\w/]|) {
+                       LogDbg('DXCommand', "cmd: invalid characters in '$cmd'");
+                       return $self->_error_out('e1');
+               }
+
                # strip out // on command only
                $cmd =~ s|//|/|g;
-               $cmd =~ s|^/||g;                # no leading / either
-               $cmd =~ s|[^-?\w/]||g;          # and no funny characters either
                                        
                my ($path, $fcmd);
                        
@@ -475,7 +523,7 @@ sub run_cmd
                if ($acmd) {
                        ($cmd, $args) = split /\s+/, "$acmd $args", 2;
                        $args = "" unless defined $args;
-                       dbg("aliased cmd: $cmd $args") if isdbg('command');
+                       dbg("cmd: aliased $cmd $args") if isdbg('command');
                }
                        
                # first expand out the entry to a command
@@ -483,26 +531,23 @@ sub run_cmd
                ($path, $fcmd) = search($main::cmd, $cmd, "pl") unless $path && $fcmd;
 
                if ($path && $cmd) {
-                       dbg("path: $cmd cmd: $fcmd") if isdbg('command');
+                       dbg("cmd: path $cmd cmd: $fcmd") if isdbg('command');
                        
                        my $package = find_cmd_name($path, $fcmd);
                        return ($@) if $@;
                                
-                       if ($package) {
+                       if ($package && DXCommandmode->can($package)) {
                                no strict 'refs';
-                               dbg("package: $package") if isdbg('command');
+                               dbg("cmd: package $package") if isdbg('command');
                                eval { @ans = &$package($self, $args) };
                                return (DXDebug::shortmess($@)) if $@;
+                       } else {
+                               dbg("cmd: $package not present") if isdbg('command');
+                               return $self->_error_out('e1');
                        }
                } else {
                        dbg("cmd: $cmd not found") if isdbg('command');
-                       if (++$self->{errors} > $maxerrors) {
-                               $self->send($self->msg('e26'));
-                               $self->disconnect;
-                               return ();
-                       } else {
-                               return ($self->msg('e1'));
-                       }
+                       return $self->_error_out('e1');
                }
        }
        
@@ -510,7 +555,7 @@ sub run_cmd
        if ($ok) {
                delete $self->{errors};
        } else {
-               if (++$self->{errors} > $maxerrors) {
+               if (++$self->{errors} > $DXChannel::maxerrors) {
                        $self->send($self->msg('e26'));
                        $self->disconnect;
                        return ();
@@ -569,12 +614,14 @@ sub disconnect
        my $uref = Route::User::get($call);
        my @rout;
        if ($uref) {
-               @rout = $main::routeroot->del_user($uref);
+#              @rout = $main::routeroot->del_user($uref);
+               @rout = DXProt::_del_thingy($main::routeroot, [$call, 0]);
+
                dbg("B/C PC17 on $main::mycall for: $call") if isdbg('route');
 
                # 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);
+               $main::me->route_pc92d($main::mycall, undef, $main::routeroot, $uref) unless $DXProt::pc92_slug_changes;
        } else {
                confess "trying to disconnect a non existant user $call";
        }
@@ -784,14 +831,15 @@ sub find_cmd_name {
                no strict 'refs';
 
                if (exists $Cache{$package}) {
-                       dbg("Redefining $package") if isdbg('command');
+                       dbg("find_cmd_name: Redefining $package") if isdbg('command');
                        undef *$package;
                } else {
-                       dbg("Defining $package") if isdbg('command');
+                       dbg("find_cmd_name: Defining $package") if isdbg('command');
                }
+
                eval $eval;
-               
-               $Cache{$package} = {mtime => $mtime };
+
+               $Cache{$package} = {mtime => $mtime } unless $@;
            
        }
 
@@ -813,7 +861,7 @@ sub send
 sub local_send
 {
        my ($self, $let, $buf) = @_;
-       if ($self->{state} eq 'prompt' || $self->{state} eq 'talk') {
+       if ($self->{state} eq 'prompt' || $self->{state} eq 'talk' || $self->{state} eq 'chat') {
                if ($self->{enhanced}) {
                        $self->send_later($let, $buf);
                } else {
@@ -923,7 +971,7 @@ sub format_dx_spot
        my $comment = substr (($_[3] || ''), 0, $clth);
        $comment .= ' ' x ($clth - length($comment));
        if ($self->{user}->wantgrid) {
-               my $ref = DXUser->get_current($_[4]);
+               my $ref = DXUser::get_current($_[4]);
                if ($ref) {
                        $loc = $ref->qra || '';
                        $loc = ' ' . substr($loc, 0, 4) if $loc;
@@ -967,7 +1015,7 @@ sub dx_spot
        } elsif ($self->{gtk}) {
                my ($dxloc, $byloc);
 
-               my $ref = DXUser->get_current($_[4]);
+               my $ref = DXUser::get_current($_[4]);
                if ($ref) {
                        $byloc = $ref->qra;
                        $byloc = substr($byloc, 0, 4) if $byloc;
@@ -975,7 +1023,7 @@ sub dx_spot
 
                my $spot = $_[1];
                $spot =~ s|/\w{1,4}$||;
-               $ref = DXUser->get_current($spot);
+               $ref = DXUser::get_current($spot);
                if ($ref) {
                        $dxloc = $ref->qra;
                        $dxloc = substr($dxloc, 0, 4) if $dxloc;
@@ -1143,7 +1191,7 @@ sub import_cmd
                            if ($dxchan) {
                                        @out = $s->run($dxchan, 1);
                                } else {
-                                       my $u = DXUser->get($call);
+                                       my $u = DXUser::get($call);
                                        if ($u) {
                                                $dxchan = $main::me;
                                                my $old = $dxchan->{call};