From: minima <minima>
Date: Sat, 8 Mar 2003 02:16:29 +0000 (+0000)
Subject: added chat stuff for fun
X-Git-Tag: PRE-1-52~37
X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=commitdiff_plain;h=defc60f3e7fab9bb99d1c9f7b8bccc4ec37628d5;p=spider.git

added chat stuff for fun
---

diff --git a/Changes b/Changes
index 214a84d0..61142d67 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,7 @@
+08Mar03=======================================================================
+1. Added chat, join, leave commands to allow general purpose conferencing
+on arbitrary subjects. [Translators: added e34,e35,join,leave]. There is
+currently no help. There is also sh/chat.
 28Feb03=======================================================================
 1. Charlie K1XX fixed the sh/iso, sh/reg and sh/node commands
 25Feb03=======================================================================
diff --git a/cmd/chat.pl b/cmd/chat.pl
new file mode 100644
index 00000000..4062358c
--- /dev/null
+++ b/cmd/chat.pl
@@ -0,0 +1,43 @@
+#
+# do a chat message
+#
+# this is my version of conferencing....
+#
+# Copyright (c) 2003 Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+my ($self, $line) = @_;
+my @f = split /\s+/, $line, 2;
+return (1, $self->msg('e5')) if $self->remotecmd;
+return (1, $self->msg('e34')) unless @f == 2;
+return (1, $self->msg('e28')) unless $self->registered;
+
+my $target = uc $f[0];
+
+return (1, $self->msg('e35', $target)) unless grep uc $_ eq $target, @{$self->user->group};
+
+my $from = $self->call;
+my $text = unpad $f[1];
+my $t = ztime(time);
+my $toflag = '*';
+
+# change ^ into : for transmission
+$line =~ s/\^/:/og;
+
+my @bad;
+if (@bad = BadWords::check($line)) {
+	$self->badcount(($self->badcount||0) + @bad);
+	Log('DXCommand', "$self->{call} swore: $line");
+	Log('chat', $target, $from, "[to $from only] $line");
+	return (1, "$target de $from <$t>: $line");
+}
+
+#PC12^IZ4DYU^GROUP^PSE QSL INFO TO A71AW TNX IN ADV 73's^ ^IK5PWJ-6^0^H21^~
+my $msgid = DXProt::nextchatmsgid();
+$text = "#$msgid $text";
+
+DXProt::send_chat($self, DXProt::pc12($from, $text, $target), $from, $target, $text, ' ', $main::mycall, '0');
+
+return (1, ());
diff --git a/cmd/join.pl b/cmd/join.pl
new file mode 100644
index 00000000..9b469266
--- /dev/null
+++ b/cmd/join.pl
@@ -0,0 +1,24 @@
+#
+# join a group
+#
+# Copyright (c) 2003 - Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+my ($self, $line) = @_;
+my @args = split /\s+/, uc $line;
+my $group;
+my @out;
+
+my @group = @{$self->user->group};
+
+foreach $group (@args) {
+  push @group, $group unless grep $_ eq $group, @group; 
+  push @out, $self->msg('join', $group);
+}
+
+$self->user->group(\@group);
+$self->user->put;
+
+return (1, @out);
diff --git a/cmd/leave.pl b/cmd/leave.pl
new file mode 100644
index 00000000..f02add51
--- /dev/null
+++ b/cmd/leave.pl
@@ -0,0 +1,24 @@
+#
+# leave a group
+#
+# Copyright (c) 2003 - Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+my ($self, $line) = @_;
+my @args = split /\s+/, uc $line;
+my $group;
+my @out;
+
+my @group = @{$self->user->group};
+
+foreach $group (@args) {
+  @group = grep $_ ne $group, @group; 
+  push @out, $self->msg('leave', $group);
+}
+
+$self->user->group(\@group);
+$self->user->put;
+
+return (1, @out);
diff --git a/cmd/show/chat.pl b/cmd/show/chat.pl
new file mode 100644
index 00000000..3105c36b
--- /dev/null
+++ b/cmd/show/chat.pl
@@ -0,0 +1,38 @@
+#
+# print out the general log file for chat only
+#
+# Copyright (c) 1998-2003 - Dirk Koopman G1TLH
+#
+# $Id$
+#
+my $self = shift;
+
+# this appears to be a reasonable thing for users to do (thank you JE1SGH)
+# return (1, $self->msg('e5')) if $self->priv < 9;
+
+my $cmdline = shift;
+my @f = split /\s+/, $cmdline;
+my $f;
+my @out;
+my ($from, $to, $who); 
+
+$from = 0;
+while ($f = shift @f) {                 # next field
+	#  print "f: $f list: ", join(',', @list), "\n";
+	if (!$from && !$to) {
+		($from, $to) = $f =~ /^(\d+)-(\d+)$/o;         # is it a from -> to count?
+		next if $from && $to > $from;
+	}
+	if (!$to) {
+		($to) = $f =~ /^(\d+)$/o if !$to;              # is it a to count?
+		next if $to;
+	}
+	next if $who;
+	($who) = $f =~ /^(\w+)/o;
+}
+
+$to = 20 unless $to;
+$from = 0 unless $from;
+
+@out = DXLog::print($from, $to, $main::systime, 'chat', $who);
+return (1, @out);
diff --git a/perl/AnnTalk.pm b/perl/AnnTalk.pm
index 30f8964c..0b564064 100644
--- a/perl/AnnTalk.pm
+++ b/perl/AnnTalk.pm
@@ -47,16 +47,17 @@ $main::branch += $BRANCH;
 # enter the spot for dup checking and return true if it is already a dup
 sub dup
 {
-	my ($call, $to, $text) = @_; 
+	my ($call, $to, $text, $t) = @_; 
 
+	$t ||= $main::systime + $dupage;
 	chomp $text;
 	unpad($text);
 	$text =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg;
 	$text = substr($text, 0, $duplth) if length $text > $duplth; 
 	$text = pack("C*", map {$_ & 127} unpack("C*", $text));
-	$text =~ s/[^a-zA-Z0-9]//g;
+	$text =~ s/[^\#a-zA-Z0-9]//g;
 	my $dupkey = "A$to|\L$text";
-	return DXDupe::check($dupkey, $main::systime + $dupage);
+	return DXDupe::check($dupkey, $t);
 }
 
 sub listdups
diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 1750fee1..65d5eb03 100644
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -802,6 +802,26 @@ sub announce
 	$self->local_send($target eq 'WX' ? 'W' : 'N', $buf);
 }
 
+# send a chat
+sub chat
+{
+	my $self = shift;
+	my $line = shift;
+	my $isolate = shift;
+	my $to = shift;
+	my $target = shift;
+	my $text = shift;
+	my ($filter, $hops);
+
+	return unless grep uc $_ eq $target, @{$self->{user}->{group}};
+	
+	$text =~ s/^\#\d+ //;
+	my $buf = "$target de $_[0]: $text";
+	$buf =~ s/\%5E/^/g;
+	$buf .= "\a\a" if $self->{beep};
+	$self->local_send('C', $buf);
+}
+
 # send a dx spot
 sub dx_spot
 {
diff --git a/perl/DXLogPrint.pm b/perl/DXLogPrint.pm
index a01f5ded..752e72ac 100644
--- a/perl/DXLogPrint.pm
+++ b/perl/DXLogPrint.pm
@@ -46,7 +46,7 @@ sub print
 	if ($pattern) {
 		$hint = "m{\\Q$pattern\\E}i";
 	} else {
-		$hint = "!m{ann|rcmd|talk}";
+		$hint = "!m{ann|rcmd|talk|chat}";
 	}
 	if ($who) {
 		$hint .= ' && ' if $hint;
@@ -115,8 +115,9 @@ sub print_item
 	} elsif ($r->[1] eq 'talk') {
 		$r->[5] ||= "";
 		$s = "$r->[3] -> $r->[2] ($r->[4]) $r->[5]";
-	} elsif ($r->[1] eq 'ann') {
+	} elsif ($r->[1] eq 'ann' || $r->[1] eq 'chat') {
 		$r->[4] ||= "";
+		$r->[4] =~ s/^\#\d+ //;
 		$s = "$r->[3] -> $r->[2] $r->[4]";
 	} else {
 		$r->[2] ||= "";
diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index 7769729b..5ddafa5e 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -44,7 +44,7 @@ $main::branch += $BRANCH;
 
 use vars qw($pc11_max_age $pc23_max_age $last_pc50 $eph_restime $eph_info_restime $eph_pc34_restime
 			$last_hour $last10 %eph  %pings %rcmds $ann_to_talk
-			$pingint $obscount %pc19list
+			$pingint $obscount %pc19list $chatdupeage
 			%nodehops $baddx $badspotter $badnode $censorpc $rspfcheck
 			$allowzero $decode_dk0wcy $send_opernam @checklist);
 
@@ -70,12 +70,13 @@ $eph_info_restime = 60*60;
 $eph_pc34_restime = 30;
 $pingint = 5*60;
 $obscount = 2;
+$chatdupeage = 20 * 60 * 60;
 
 @checklist = 
 (
  [ qw(c c m bp bc c) ],			# pc10
  [ qw(f m d t m c c h) ],		# pc11
- [ qw(c bc m bp bm p h) ],		# pc12
+ [ qw(c m m bp bm p h) ],		# pc12
  [ qw(c h) ],					# 
  [ qw(c h) ],					# 
  [ qw(c m h) ],					# 
@@ -604,6 +605,8 @@ sub handle_12
 		return;
 	}
 
+	my $dxchan;
+	
 	if ($_[2] eq '*' || $_[2] eq $main::mycall) {
 
 
@@ -614,7 +617,7 @@ sub handle_12
 			if ($call) {
 				my $ref = Route::get($call);
 				if ($ref) {
-					my $dxchan = $ref->dxchan;
+					$dxchan = $ref->dxchan;
 					$dxchan->talk($_[1], $call, undef, $_[3], $_[5]) if $dxchan != $self;
 					return;
 				}
@@ -623,6 +626,8 @@ sub handle_12
 	
 		# send it
 		$self->send_announce($line, @_[1..6]);
+	} elsif ((($dxchan = DXChannel->get($_[2])) && $dxchan->is_user) || !is_callsign($_[0])){
+		$self->send_chat($line, @_[1..6]);
 	} else {
 		$self->route($_[2], $line);
 	}
@@ -1769,6 +1774,72 @@ sub send_announce
 	}
 }
 
+my $msgid = 0;
+
+sub nextchatmsgid
+{
+	$msgid++;
+	$msgid = 1 if $msgid > 999;
+	return $msgid;
+}
+
+# send a chat line
+sub send_chat
+{
+	my $self = shift;
+	my $line = shift;
+	my @dxchan = DXChannel->get_all();
+	my $dxchan;
+	my $target = $_[1];
+	my $text = unpad($_[2]);
+				
+	# obtain country codes etc 
+	my ($ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq) = (0..0);
+	my ($ann_state, $org_state) = ("", "");
+	my @dxcc = Prefix::extract($_[0]);
+	if (@dxcc > 0) {
+		$ann_dxcc = $dxcc[1]->dxcc;
+		$ann_itu = $dxcc[1]->itu;
+		$ann_cq = $dxcc[1]->cq;						
+		$ann_state = $dxcc[1]->state;
+	}
+	@dxcc = Prefix::extract($_[4]);
+	if (@dxcc > 0) {
+		$org_dxcc = $dxcc[1]->dxcc;
+		$org_itu = $dxcc[1]->itu;
+		$org_cq = $dxcc[1]->cq;						
+		$org_state = $dxcc[1]->state;
+	}
+
+	if ($self->{inannfilter}) {
+		my ($filter, $hops) = 
+			$self->{inannfilter}->it(@_, $self->{call}, 
+									 $ann_dxcc, $ann_itu, $ann_cq,
+									 $org_dxcc, $org_itu, $org_cq, $ann_state, $org_state);
+		unless ($filter) {
+			dbg("PCPROT: Rejected by input announce filter") if isdbg('chanerr');
+			return;
+		}
+	}
+
+	if (AnnTalk::dup($_[0], $_[1], $_[2], $chatdupeage)) {
+		dbg("PCPROT: Duplicate Announce ignored") if isdbg('chanerr');
+		return;
+	}
+
+
+	Log('chat', $target, $_[0], $text);
+
+	# send it if it isn't the except list and isn't isolated and still has a hop count
+	# taking into account filtering and so on
+	foreach $dxchan (@dxchan) {
+		next if $dxchan == $main::me;
+		next if $dxchan == $self && $self->is_node;
+		next if $target eq 'LOCAL' && $dxchan->is_node;
+		$dxchan->chat($line, $self->{isolate}, ' ', $target, $text, @_, $self->{call}, $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq);
+	}
+}
+
 sub announce
 {
 	my $self = shift;
@@ -1786,6 +1857,11 @@ sub announce
 	send_prot_line($self, $filter, $hops, $isolate, $line) unless $_[1] eq $main::mycall;
 }
 
+sub chat
+{
+	goto &announce;
+}
+
 
 sub send_local_config
 {
diff --git a/perl/DXUser.pm b/perl/DXUser.pm
index 5e44a11f..e62123bf 100644
--- a/perl/DXUser.pm
+++ b/perl/DXUser.pm
@@ -61,7 +61,7 @@ $v3 = 0;
 		  annok => '9,Accept Announces?,yesno', # accept his announces?
 		  lang => '0,Language',
 		  hmsgno => '0,Highest Msgno',
-		  group => '0,Access Group,parray',	# used to create a group of users/nodes for some purpose or other
+		  group => '0,Chat Group,parray',	# used to create a group of users/nodes for some purpose or other
 		  isolate => '9,Isolate network,yesno',
 		  wantbeep => '0,Req Beep,yesno',
 		  wantann => '0,Req Announce,yesno',
diff --git a/perl/Messages b/perl/Messages
index 250340bf..df00b3f6 100644
--- a/perl/Messages
+++ b/perl/Messages
@@ -91,6 +91,8 @@ package DXM;
 				e31 => '$_[0] is not a user', 
 				e32 => 'Need a passphrase',
 				e33 => '$_[0] is not a number of days or a valid date',
+				e34 => 'Need a GROUP and some text',
+				e35 => 'You are not a member of $_[0], join $_[0]',
 
 				echoon => 'Echoing enabled',
 				echooff => 'Echoing disabled',
@@ -132,11 +134,13 @@ package DXM;
 				isoari => 'there is an input route filter for $_[0]; clear/route input $_[0] first',
 				isoaro => 'there is an output route filter for $_[0]; clear/route $_[0] first',
 				isow => '$_[0] is isolated; unset/isolate $_[0] first',
+				join => 'joining group $_[0]',
 				l1 => 'Sorry $_[0], you are already logged on on another channel',
 				l2 => 'Hello $_[0], this is $main::mycall in $main::myqth\nrunning DXSpider V$main::version build $main::build',
 				lang => 'Language is now English',
 				lange1 => 'set/language <lang> where <lang> is one of ($_[0])',
 				lange2 => 'failed to set language on $_[0]', 
+				leave => 'leaving group $_[0]',
 				lh1 => '$main::data/hop_table.pl doesn\'t exist',
 				loce1 => 'Please enter your location,, set/location <latitude longitude>',
 				loce2 => 'Don\'t recognise \"$_[0]\" as a Lat/Long (eg 52 20 N 0 16 E)',
diff --git a/perl/Spot.pm b/perl/Spot.pm
index f59ef4f4..dc63dbff 100644
--- a/perl/Spot.pm
+++ b/perl/Spot.pm
@@ -26,7 +26,7 @@ $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0))
 $main::build += $VERSION;
 $main::branch += $BRANCH;
 
-use vars qw($fp $statp $maxspots $defaultspots $maxdays $dirprefix $duplth $dupage $filterdef $totalspots $hfspots $vhfspots);
+use vars qw($fp $statp $maxspots $defaultspots $maxdays $dirprefix $duplth $dupage $filterdef $totalspots $hfspots $vhfspots );
 
 $fp = undef;
 $statp = undef;
diff --git a/perl/create_localqsl.pl b/perl/create_localqsl.pl
index 66634f25..e3f447f0 100755
--- a/perl/create_localqsl.pl
+++ b/perl/create_localqsl.pl
@@ -97,15 +97,11 @@ sub update
 	
 	# decode the lines
 	foreach my $l (@lines) {
-		my ($date, $time, $oby, $ocom) = $l =~ /^(\s?\S+)\s+(\s?\S+)\s+by\s+(\S+):\s+(.*)$/;
+		my ($date, $time, $oby, $ocom) = $l =~ /^(\s?\S+)\s+(\s?\S+)\s+de\s+(\S+):\s+(.*)$/;
 		if ($date) {
 			my $ot = cltounix($date, $time);
 			push @in, [$ot, $oby, $ocom];
-		} else {
-			print "Cannot decode $call: $l\n";
-			$DB::single = 1;
 		}
-		
 	}
 	
 	# is this newer than the earliest one?
@@ -113,8 +109,8 @@ sub update
 		@in = grep {$_->[1] ne $by} @in;
 	}
 	$comment =~ s/://g;
-	unshift @in, [$t, $by, $comment] if grep is_callsign($_), split(/\s+/, $comment);
+	unshift @in, [$t, $by, $comment] if grep /^bur/i || is_callsign(uc $_), split(/\b/, $comment);
 	pop @in, if @in > 10;
-	return join "\n", (map {(cldatetime($_->[0]) . " by $_->[1]: $_->[2]")} @in);
+	return join "\n", (map {(cldatetime($_->[0]) . " de $_->[1]: $_->[2]")} @in);
 }