use correcr call for buddies on logout
[spider.git] / perl / DXCommandmode.pm
index 332e3badc98919d3893b6f40cd0d54703d93eb4b..0e01208723a524fada6d2610e7f1cfb628115b91 100644 (file)
@@ -35,9 +35,11 @@ use Net::Telnet;
 use QSL;
 use DB_File;
 use VE7CC;
+use DXXml;
 
 use strict;
-use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase $maxerrors %nothereslug $maxbadcount $msgpolltime);
+use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase $maxerrors %nothereslug
+       $maxbadcount $msgpolltime $default_pagelth $cmdimportdir);
 
 %Cache = ();                                   # cache of dynamically loaded routine's mod times
 %cmd_cache = ();                               # cache of short names
@@ -47,7 +49,9 @@ $scriptbase = "$main::root/scripts"; # the place where all users start scripts g
 $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 
+                                          # this does not exist as default, you need to create it manually
+                                         #
 
 use vars qw($VERSION $BRANCH);
 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
@@ -90,14 +94,16 @@ sub start
        my $host = $self->{conn}->{peerhost};
        $host ||= "AGW Port #$self->{conn}->{agwport}" if exists $self->{conn}->{agwport};
        $host ||= "unknown";
-       Log('DXCommand', "$call connected from $host");
+       LogDbg('DXCommand', "$call connected from $host");
 
        $self->{name} = $name ? $name : $call;
        $self->send($self->msg('l2',$self->{name}));
        $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;
+       my $pagelth = $user->pagelth;
+       $pagelth = $default_pagelth unless defined $pagelth;
+       $self->{pagelth} = $pagelth;
        ($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
@@ -144,10 +150,21 @@ sub start
        $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);
-       $self->{wcyfilter} = Filter::read_in('wcy', $call, 0) || Filter::read_in('wcy', 'user_default', 0);
-       $self->{annfilter} = Filter::read_in('ann', $call, 0) || Filter::read_in('ann', 'user_default', 0) ;
+       my $nossid = $call;
+       $nossid =~ s/-\d+$//;
+       
+       $self->{spotsfilter} = Filter::read_in('spots', $call, 0) 
+               || Filter::read_in('spots', $nossid, 0)
+                       || Filter::read_in('spots', 'user_default', 0);
+       $self->{wwvfilter} = Filter::read_in('wwv', $call, 0) 
+               || Filter::read_in('wwv', $nossid, 0) 
+                       || Filter::read_in('wwv', 'user_default', 0);
+       $self->{wcyfilter} = Filter::read_in('wcy', $call, 0) 
+               || Filter::read_in('wcy', $nossid, 0) 
+                       || Filter::read_in('wcy', 'user_default', 0);
+       $self->{annfilter} = Filter::read_in('ann', $call, 0) 
+               || Filter::read_in('ann', $nossid, 0) 
+                       || Filter::read_in('ann', 'user_default', 0) ;
 
        # clean up qra locators
        my $qra = $user->qra;
@@ -167,6 +184,7 @@ sub start
        }
        
        $self->tell_login('loginu');
+       $self->tell_buddies('loginb');
        
        # do we need to send a forward/opernam?
        my $lastoper = $user->lastoper || 0;
@@ -292,7 +310,7 @@ sub normal
                                        my @bad;
                                        if (@bad = BadWords::check($l)) {
                                                $self->badcount(($self->badcount||0) + @bad);
-                                               Log('DXCommand', "$self->{call} swore: $l");
+                                               LogDbg('DXCommand', "$self->{call} swore: $l with words:" . join(',', @bad) . ")");
                                        } else {
                                                for (@{$self->{talklist}}) {
                                                        $self->send_talks($_, $l);
@@ -306,7 +324,7 @@ sub normal
                        my @bad;
                        if (@bad = BadWords::check($cmdline)) {
                                $self->badcount(($self->badcount||0) + @bad);
-                               Log('DXCommand', "$self->{call} swore: $cmdline");
+                               LogDbg('DXCommand', "$self->{call} swore: $cmdline with words:" . join(',', @bad) . ")");
                        } else {
                                for (@{$self->{talklist}}) {
                                        $self->send_talks($_, $rawline);
@@ -338,7 +356,7 @@ sub normal
 
        # check for excessive swearing
        if ($self->{badcount} && $self->{badcount} >= $maxbadcount) {
-               Log('DXCommand', "$self->{call} logged out for excessive swearing");
+               LogDbg('DXCommand', "$self->{call} logged out for excessive swearing");
                $self->disconnect;
                return;
        }
@@ -427,7 +445,8 @@ sub run_cmd
        
 
        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;
@@ -435,6 +454,8 @@ sub run_cmd
        if ($cmd) {
                # 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);
                        
@@ -450,7 +471,7 @@ sub run_cmd
                        
                # first expand out the entry to a command
                ($path, $fcmd) = search($main::localcmd, $cmd, "pl");
-               ($path, $fcmd) = search($main::cmd, $cmd, "pl") if !$path || !$fcmd;
+               ($path, $fcmd) = search($main::cmd, $cmd, "pl") unless $path && $fcmd;
 
                if ($path && $cmd) {
                        dbg("path: $cmd cmd: $fcmd") if isdbg('command');
@@ -520,6 +541,8 @@ sub process
                        delete $nothereslug{$k};
                }
        }
+
+       import_cmd();
 }
 
 #
@@ -551,8 +574,9 @@ sub disconnect
                
        # send info to all logged in thingies
        $self->tell_login('logoutu');
+       $self->tell_buddies('logoutb');
 
-       Log('DXCommand', "$call disconnected");
+       LogDbg('DXCommand', "$call disconnected");
 
        $self->SUPER::disconnect;
 }
@@ -918,7 +942,7 @@ sub wwv
        return unless $self->{wwv};
        
        if ($self->{wwvfilter}) {
-               ($filter, $hops) = $self->{wwvfilter}->it(@_ );
+               ($filter, $hops) = $self->{wwvfilter}->it(@_[7..$#_] );
                return unless $filter;
        }
 
@@ -1006,5 +1030,72 @@ sub store_startup_script
        return @out;
 }
 
+# Import any commands contained in any files in import_cmd directory
+#
+# If the filename has a recogisable callsign as some delimited part
+# of it, then this is the user the command will be run as. 
+#
+sub import_cmd
+{
+       # are there any to do in this directory?
+       return unless -d $cmdimportdir;
+       unless (opendir(DIR, $cmdimportdir)) {
+               LogDbg('err', "can\'t open $cmdimportdir $!");
+               return;
+       } 
+
+       my @names = readdir(DIR);
+       closedir(DIR);
+       my $name;
+       foreach $name (@names) {
+               next if $name =~ /^\./;
+
+               my $s = Script->new($name, $cmdimportdir);
+               if ($s) {
+                       LogDbg('DXCommand', "Run import cmd file $name");
+                       my @cat = split /[^A-Za-z0-9]+/, $name;
+                       my ($call) = grep {is_callsign(uc $_)} @cat;
+                       $call ||= $main::mycall;
+                       $call = uc $call;
+                       my @out;
+                       
+                       
+                       $s->inscript(0);        # switch off script checks
+                       
+                       if ($call eq $main::mycall) {
+                               @out = $s->run($main::me, 1);
+                       } else {
+                               my $dxchan = DXChannel::get($call);
+                           if ($dxchan) {
+                                       @out = $s->run($dxchan, 1);
+                               } else {
+                                       my $u = DXUser->get($call);
+                                       if ($u) {
+                                               $dxchan = $main::me;
+                                               my $old = $dxchan->{call};
+                                               my $priv = $dxchan->{priv};
+                                               my $user = $dxchan->{user};
+                                               $dxchan->{call} = $call;
+                                               $dxchan->{priv} = $u->priv;
+                                               $dxchan->{user} = $u;
+                                               @out = $s->run($dxchan, 1);
+                                               $dxchan->{call} = $call;
+                                               $dxchan->{priv} = $priv;
+                                               $dxchan->{user} = $user;
+                                       } else {
+                                               LogDbg('err', "Trying to run import cmd for non-existant user $call");
+                                       }
+                               }
+                       }
+                       $s->erase;
+                       for (@out) {
+                               LogDbg('DXCommand', "Import cmd $name/$call: $_");
+                       }
+               } else {
+                       LogDbg('err', "Failed to open $cmdimportdir/$name $!");
+                       unlink "$cmdimportdir/$name";
+               }
+       }
+}
 1;
 __END__