From defc60f3e7fab9bb99d1c9f7b8bccc4ec37628d5 Mon Sep 17 00:00:00 2001 From: minima Date: Sat, 8 Mar 2003 02:16:29 +0000 Subject: [PATCH] added chat stuff for fun --- Changes | 4 ++ cmd/chat.pl | 43 +++++++++++++++++++++ cmd/join.pl | 24 ++++++++++++ cmd/leave.pl | 24 ++++++++++++ cmd/show/chat.pl | 38 +++++++++++++++++++ perl/AnnTalk.pm | 7 ++-- perl/DXCommandmode.pm | 20 ++++++++++ perl/DXLogPrint.pm | 5 ++- perl/DXProt.pm | 82 +++++++++++++++++++++++++++++++++++++++-- perl/DXUser.pm | 2 +- perl/Messages | 4 ++ perl/Spot.pm | 2 +- perl/create_localqsl.pl | 10 ++--- 13 files changed, 248 insertions(+), 17 deletions(-) create mode 100644 cmd/chat.pl create mode 100644 cmd/join.pl create mode 100644 cmd/leave.pl create mode 100644 cmd/show/chat.pl 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 where 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 ', 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); } -- 2.43.0