X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCommandmode.pm;h=7500d17de8bce5ed5ad51e00218350ce50463cfe;hb=0148e301a41d89c154254a457f7d79334eea9442;hp=79ba03b0b8f63ac3f189534677f9d4d55cb7c5e2;hpb=d3004b59ca0171c0afe6d9898c84830c809721af;p=spider.git

diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 79ba03b0..7500d17d 100644
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -9,10 +9,11 @@
 
 package DXCommandmode;
 
-use POSIX;
+#use POSIX;
 
 @ISA = qw(DXChannel);
 
+use POSIX qw(:math_h);
 use DXUtil;
 use DXChannel;
 use DXUser;
@@ -35,10 +36,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 $default_pagelth);
+	$maxbadcount $msgpolltime $default_pagelth $cmdimportdir);
 
 %Cache = ();					# cache of dynamically loaded routine's mod times
 %cmd_cache = ();				# cache of short names
@@ -48,7 +50,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+)/ );
@@ -91,7 +95,7 @@ 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}));
@@ -147,10 +151,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;
@@ -170,6 +185,7 @@ sub start
 	}
 	
 	$self->tell_login('loginu');
+	$self->tell_buddies('loginb');
 	
 	# do we need to send a forward/opernam?
 	my $lastoper = $user->lastoper || 0;
@@ -187,12 +203,23 @@ sub start
 	my $info = Route::cluster();
 	$self->send("Cluster:$info");
 
-	# send prompts and things
+	# send prompts for qth, name and things
 	$self->send($self->msg('namee1')) if !$user->name;
 	$self->send($self->msg('qthe1')) if !$user->qth;
 	$self->send($self->msg('qll')) if !$user->qra || (!$user->lat && !$user->long);
 	$self->send($self->msg('hnodee1')) if !$user->qth;
 	$self->send($self->msg('m9')) if DXMsg::for_me($call);
+
+	# send out any buddy messages for other people that are online
+	foreach my $call (@{$user->buddies}) {
+		my $ref = Route::User::get($call);
+		if ($ref) {
+			foreach my $node (@{$ref->parent}) {
+				$self->send($self->msg($node eq $main::mycall ? 'loginb' : 'loginbn', $call, $node));
+			} 
+		}
+	}
+
 	$self->lastmsgpoll($main::systime);
 	$self->prompt;
 }
@@ -295,7 +322,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);
@@ -309,7 +336,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);
@@ -341,7 +368,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;
 	}
@@ -430,7 +457,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;
@@ -525,6 +553,8 @@ sub process
 			delete $nothereslug{$k};
 		}
 	}
+
+	import_cmd();
 }
 
 #
@@ -556,8 +586,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;
 }
@@ -1011,5 +1042,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__