From 679037f49e292b15a73dce96699c15b9e3049711 Mon Sep 17 00:00:00 2001 From: minima Date: Mon, 6 Mar 2006 09:09:36 +0000 Subject: [PATCH] add set/buddy. add set/local_node. fix warning for empty version in PC19. --- Changes | 6 ++++++ cmd/Aliases | 2 +- cmd/Commands_en.hlp | 24 ++++++++++++++++++++++++ cmd/join.pl | 2 +- cmd/set/buddy.pl | 25 +++++++++++++++++++++++++ cmd/set/local_node.pl | 27 +++++++++++++++++++++++++++ cmd/show/buddy.pl | 23 +++++++++++++++++++++++ cmd/show/configuration.pl | 14 ++++---------- cmd/show/users.pl | 7 ++----- cmd/unset/buddy.pl | 26 ++++++++++++++++++++++++++ cmd/unset/local_node.pl | 28 ++++++++++++++++++++++++++++ perl/Console.pm | 2 +- perl/DXChannel.pm | 28 +++++++++++++++++++++++++--- perl/DXCommandmode.pm | 2 ++ perl/DXProt.pm | 10 +++++++++- perl/DXUser.pm | 16 +++++++++++++++- perl/Messages | 6 ++++++ 17 files changed, 225 insertions(+), 23 deletions(-) create mode 100644 cmd/set/buddy.pl create mode 100644 cmd/set/local_node.pl create mode 100644 cmd/show/buddy.pl create mode 100644 cmd/unset/buddy.pl create mode 100644 cmd/unset/local_node.pl diff --git a/Changes b/Changes index 3f03bac1..4a738599 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,9 @@ +06Mar06======================================================================= +1. Fix warning on empty PC19s. +2. Add new command set/local_node to allow people to see logins/outs on other +related nodes. +3. Add new command set/buddy to allow people to see when their favorite +chum(s) logins/out. 14Feb06======================================================================= 1. Turn R and SFI around in mrtg.pl. 13Feb06======================================================================= diff --git a/cmd/Aliases b/cmd/Aliases index 462fcc53..25b87e40 100644 --- a/cmd/Aliases +++ b/cmd/Aliases @@ -114,7 +114,7 @@ package CmdAlias; '^set/user', 'unset/node', 'unset/node', '^set$', 'apropos set', 'apropos', '^sho?w?/u$', 'show/user', 'show/user', - '^sho?w?/bu', 'show/files bulletins', 'show/files', + '^sho?w?/bul', 'show/files bulletins', 'show/files', '^sho?w?/co?n?\w*/a', 'show/configuration all', 'show/configuration', '^sho?w?/co?n?\w*/n', 'show/configuration nodes', 'show/configuration', '^sho?w?/c$', 'show/configuration', 'show/configuration', diff --git a/cmd/Commands_en.hlp b/cmd/Commands_en.hlp index 342630a4..b1fdb80e 100644 --- a/cmd/Commands_en.hlp +++ b/cmd/Commands_en.hlp @@ -1454,6 +1454,12 @@ will allow text with this word again. === 5^SET/BBS [..]^Make the callsign a BBS +=== 0^SET/BUDDY [..]^Add this call to my buddy list +=== 0^UNSET/BUDDY [..]^Remove this call from my buddy list +A notification message +is sent to you automatically if anybody on your buddy list logs in or +out of any node in this cluster. + === 5^SET/CLX [..]^Make the callsign an CLX node === 9^SET/DEBUG ^Add a debug level to the debug set @@ -1577,6 +1583,21 @@ You can select the language that you want the cluster to use. Currently the languages available are en (English), de (German), es (Spanish), Czech (cz), French (fr), Portuguese (pt), Italian (it) and nl (Dutch). +=== 5^SET/LOCAL_NODE^Add node to the local_node group +=== 5^UNSET/LOCAL_NODE^Remove node from the local_node group +The 'local_node' group is a group of nodes that you want a user +to perceive as effectively one big node. At the moment, this extends +only to announcing whenever a user is logging in or out of one of +the nodes in the group (if those users have SET/LOGININFO). + +The local node group is as setup on this node. If you want the other +nodes to also include this node and all the other nodes specified, then +you must get those nodes to also run this command (or rcmd them to do +so). + +In principle, therefore, each node determines its own local node group +and these can overlap with other nodes' views. + === 0^SET/LOCATION ^Set your latitude and longitude === 9^SET/SYS_LOCATION ^Set your cluster latitude and longitude In order to get accurate headings and such like you must tell the system @@ -1833,6 +1854,9 @@ for more information. Display all the bad words in the system, see SET/BADWORD for more information. +=== 0^SHOW/BUDDY^Show your list of buddies +See SET/BUDDY for more information about buddies. + === 0^SHOW/CHAT [] []^Show any chat or conferencing This command allows you to see any chat or conferencing that has occurred whilst you were away. SHOW/CHAT on its own will show data for diff --git a/cmd/join.pl b/cmd/join.pl index 9b469266..69f220bf 100644 --- a/cmd/join.pl +++ b/cmd/join.pl @@ -1,5 +1,5 @@ # -# join a group +# join a group (note this applies only to users) # # Copyright (c) 2003 - Dirk Koopman G1TLH # diff --git a/cmd/set/buddy.pl b/cmd/set/buddy.pl new file mode 100644 index 00000000..2d99ef55 --- /dev/null +++ b/cmd/set/buddy.pl @@ -0,0 +1,25 @@ +# +# add a buddy +# +# Copyright (c) 2006 - Dirk Koopman G1TLH +# +# $Id$ +# + +my ($self, $line) = @_; +my @args = split /\s+/, uc $line; +my $group; +my @out; + +my $buddies = $self->user->buddies || []; + +foreach my $call (@args) { + push(@out, $self->msg('e22', $call)), next unless is_callsign($call); + next if $call eq $self->call; + push @$buddies, $call unless grep $_ eq $call, @$buddies; + push @out, $self->msg('buddya', $call); +} + +$self->user->put; + +return (1, @out); diff --git a/cmd/set/local_node.pl b/cmd/set/local_node.pl new file mode 100644 index 00000000..0e973280 --- /dev/null +++ b/cmd/set/local_node.pl @@ -0,0 +1,27 @@ +# +# add these nodes to the 'local_node' group +# +# Copyright (c) 2006 - Dirk Koopman G1TLH +# +# $Id$ +# + +my ($self, $line) = @_; +my @args = split /\s+/, uc $line; +my @out; + +return (1, $self->msg('e5')) unless $self->priv >= 5; + +foreach my $call (@args) { + my $user = DXUser->get_current($call); + push(@out, $self->msg('e3', 'set/localnode', $call)), next unless $user; + push(@out, $self->msg('e13', $call)), next unless $user->is_node; + my $group = $user->group || []; + push @$group, 'local_node' unless grep $_ eq 'local_node', @$group; + my $dxchan = DXChannel::get($call); + $dxchan->group($group) if $dxchan; + push @out, $self->msg('lgset', $call); + $user->put; +} + +return (1, @out); diff --git a/cmd/show/buddy.pl b/cmd/show/buddy.pl new file mode 100644 index 00000000..0f5b7a6c --- /dev/null +++ b/cmd/show/buddy.pl @@ -0,0 +1,23 @@ +# +# show your buddies +# +# Copyright (c) 2006 - Dirk Koopman G1TLH +# +# $Id$ +# + +my ($self) = @_; +my $buddies = $self->user->buddies || []; +my @out; +my @l; + +foreach my $call (@$buddies) { + if (@l >= 5) { + push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l; + @l = (); + } + push @l, $call; +} +push @l, "" while @l < 5; +push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l; +return (1, @out); diff --git a/cmd/show/configuration.pl b/cmd/show/configuration.pl index 3386a171..fe8acf96 100644 --- a/cmd/show/configuration.pl +++ b/cmd/show/configuration.pl @@ -27,21 +27,18 @@ if ($list[0] && $list[0] =~ /^NOD/) { $call = "($call)" unless $dxchan->here; push @l, $call; - my $i = 0; foreach my $ref (@val) { - if ($i >= 5) { + if (@l >= 5) { push @out, sprintf "%-12s %-12s %-12s %-12s %-12s %-12s", @l; @l = (); push @l, ""; - $i = 0; } my $s = $ref->call; $s ||= '???'; $s = sprintf "(%s)", $s unless $ref->here; push @l, $s; - $i++; } - push @l, "" while ($i++ < 5); + push @l, "" while @l < 5; push @out, sprintf "%-12s %-12s %-12s %-12s %-12s %-12s", @l; } } else { @@ -65,16 +62,14 @@ if ($list[0] && $list[0] =~ /^NOD/) { push @l, $call; @val = sort $node->users; - my $i = 0; if (@val == 0 && $node->usercount) { push @l, sprintf "(%d users)", $node->usercount; } foreach $call (@val) { - if ($i >= 5) { + if (@l >= 5) { push @out, sprintf "%-12s %-12s %-12s %-12s %-12s %-12s", @l; @l = (); push @l, ""; - $i = 0; } my $uref = Route::User::get($call); my $s = $call; @@ -84,9 +79,8 @@ if ($list[0] && $list[0] =~ /^NOD/) { $s = "$call?"; } push @l, $s; - $i++; } - push @l, "" while ($i++ < 5); + push @l, "" while @l < 5; push @out, sprintf "%-12s %-12s %-12s %-12s %-12s %-12s", @l; } } diff --git a/cmd/show/users.pl b/cmd/show/users.pl index a3fb3cc2..c9df4d69 100644 --- a/cmd/show/users.pl +++ b/cmd/show/users.pl @@ -30,14 +30,12 @@ if (@list) { my $node = $main::routeroot; push @out, join(' ', $self->msg('userconn'), $main::mycall); my $call; - my $i = 0; my @l; my @val = sort $node->users; foreach $call (@val) { - if ($i >= 5) { + if (@l >= 5) { push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l; @l = (); - $i = 0; } my $uref = Route::User::get($call); my $s = $call; @@ -47,9 +45,8 @@ if (@list) { $s = "$call?"; } push @l, $s; - $i++; } - push @l, "" while $i++ < 5; + push @l, "" while @l < 5; push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l; } diff --git a/cmd/unset/buddy.pl b/cmd/unset/buddy.pl new file mode 100644 index 00000000..bfea54d7 --- /dev/null +++ b/cmd/unset/buddy.pl @@ -0,0 +1,26 @@ +# +# remove a buddy from the list +# +# Copyright (c) 2006 - Dirk Koopman G1TLH +# +# $Id$ +# + +my ($self, $line) = @_; +my @args = split /\s+/, uc $line; +my $buddies; +my @out; + +my @buddies = @{$self->user->buddies}; + +foreach my $call (@args) { + push(@out, $self->msg('e22', $call)), next unless is_callsign($call); + next if $call eq $self->call; + @buddies = grep $_ ne $call, @buddies; + push @out, $self->msg('buddyu', $call); +} + +$self->user->buddies(\@buddies); +$self->user->put; + +return (1, @out); diff --git a/cmd/unset/local_node.pl b/cmd/unset/local_node.pl new file mode 100644 index 00000000..dd08b525 --- /dev/null +++ b/cmd/unset/local_node.pl @@ -0,0 +1,28 @@ +# +# remove these nodes from the 'local_node' group +# +# Copyright (c) 2006 - Dirk Koopman G1TLH +# +# $Id$ +# + +my ($self, $line) = @_; +my @args = split /\s+/, uc $line; +my @out; + +return (1, $self->msg('e5')) unless $self->priv >= 5; + +foreach my $call (@args) { + my $user = DXUser->get_current($call); + push(@out, $self->msg('e3', 'set/localnode', $call)), next unless $user; + push(@out, $self->msg('e13', $call)), next unless $user->is_node; + my $group = $user->group || []; + my @new = grep {$_ ne 'local_node'} @$group; + $user->group(\@new); + my $dxchan = DXChannel::get($call); + $dxchan->group(\@new) if $dxchan; + push @out, $self->msg('lgunset', $call); + $user->put; +} + +return (1, @out); diff --git a/perl/Console.pm b/perl/Console.pm index 9812a024..22b463c6 100644 --- a/perl/Console.pm +++ b/perl/Console.pm @@ -46,7 +46,7 @@ if ($ENV{'TERM'} =~ /(xterm|ansi)/) { [ '^[-A-Z0-9]+ de [-A-Z0-9]+ \d\d-\w\w\w-\d\d\d\d \d\d\d\dZ', COLOR_PAIR(0) ], [ '^[-A-Z0-9]+ de [-A-Z0-9]+ ', COLOR_PAIR(6) ], [ '^WX', COLOR_PAIR(3) ], - [ '^(User|Node)\b', COLOR_PAIR(8) ], + [ '^(User|Node|Buddy)\b', COLOR_PAIR(8) ], [ '^New mail', A_BOLD|COLOR_PAIR(5) ], ); diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index b0208f10..9812037f 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -153,7 +153,8 @@ sub alloc if (defined $user) { $self->{user} = $user; $self->{lang} = $user->lang; - $user->new_group() if !$user->group; + $user->new_group unless $user->group; + $user->new_buddies unless $user->buddies; $self->{group} = $user->group; $self->{sort} = $user->sort; } @@ -493,7 +494,28 @@ sub closeall # sub tell_login { - my ($self, $m) = @_; + my ($self, $m, $call) = @_; + + $call ||= $self->{call}; + + # send info to all logged in thingies + my @dxchan = get_all_users(); + my $dxchan; + foreach $dxchan (@dxchan) { + next if $dxchan == $self; + next if $dxchan->{call} eq $main::mycall; + $dxchan->send($dxchan->msg($m, $call)) if $dxchan->{logininfo}; + } +} + +# +# Tell all the users if a buddy is logged or out +# +sub tell_buddies +{ + my ($self, $m, $call) = @_; + + $call ||= $self->{call}; # send info to all logged in thingies my @dxchan = get_all_users(); @@ -501,7 +523,7 @@ sub tell_login foreach $dxchan (@dxchan) { next if $dxchan == $self; next if $dxchan->{call} eq $main::mycall; - $dxchan->send($dxchan->msg($m, $self->{call})) if $dxchan->{logininfo}; + $dxchan->send($dxchan->msg($m, $call)) if grep $_ eq $call, @{$dxchan->user->buddies} ; } } diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index ecd65716..3a94fb6a 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -173,6 +173,7 @@ sub start } $self->tell_login('loginu'); + $self->tell_buddies('loginb'); # do we need to send a forward/opernam? my $lastoper = $user->lastoper || 0; @@ -562,6 +563,7 @@ sub disconnect # send info to all logged in thingies $self->tell_login('logoutu'); + $self->tell_login('logoutb'); LogDbg('DXCommand', "$call disconnected"); diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 5c6ca1fb..76b9d25d 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -845,9 +845,12 @@ sub handle_16 push @rout, $parent->add_user($call, $flags); } + # send info to all logged in thingies + $self->tell_login('loginu', $call) if DXUser->get_current($ncall)->is_local_node; + $self->tell_buddies('loginb', $call); # add this station to the user database, if required - $call =~ s/-\d+$//o; # remove ssid for users +# $call =~ s/-\d+$//o; # remove ssid for users my $user = DXUser->get_current($call); $user = DXUser->new($call) if !$user; $user->homenode($parent->call) if !$user->homenode; @@ -916,6 +919,10 @@ sub handle_17 $parent = Route->new($ncall); # throw away } + # send info to all logged in thingies + $self->tell_login('logoutu', $ucall) if DXUser->get_current($ncall)->is_local_node; + $self->tell_buddies('logoutb', $ucall); + if (eph_dup($line)) { dbg("PCPROT: dup PC17 detected") if isdbg('chanerr'); return; @@ -1014,6 +1021,7 @@ sub handle_19 # check for sane parameters # $ver = 5000 if $ver eq '0000'; + next unless $ver && $ver =~ /^\d+$/; next if $ver < 5000; # only works with version 5 software next if length $call < 3; # min 3 letter callsigns next if $call eq $main::mycall; diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 6ca9b91e..413d56a6 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -61,7 +61,8 @@ $v3 = 0; annok => '9,Accept Announces?,yesno', # accept his announces? lang => '0,Language', hmsgno => '0,Highest Msgno', - group => '0,Chat Group,parray', # used to create a group of users/nodes for some purpose or other + group => '0,Group,parray', # used to create a group of users/nodes for some purpose or other + buddies => '0,Buddies,parray', isolate => '9,Isolate network,yesno', wantbeep => '0,Req Beep,yesno', wantann => '0,Req Announce,yesno', @@ -585,6 +586,13 @@ sub new_group $self->{group} = [ 'local' ]; } +# set up empty buddies (only happens for them's that connect direct) +sub new_buddies +{ + my $self = shift; + $self->{buddies} = [ ]; +} + # # return a prompt for a field # @@ -725,6 +733,12 @@ sub is_node return $self->{sort} =~ /[ACRSX]/; } +sub is_local_node +{ + my $self = shift; + return grep $_ eq 'local_node', @{$self->{group}}; +} + sub is_user { my $self = shift; diff --git a/perl/Messages b/perl/Messages index a61c41df..d66e66c1 100644 --- a/perl/Messages +++ b/perl/Messages @@ -26,6 +26,8 @@ package DXM; beepon => 'Beeps are now on', believes => 'Believe node $_[0] via $_[1]', believeu => 'Don\'t believe node $_[0] via $_[1]', + buddya => '$_[0] has been added to your buddies', + buddyu => '$_[0] has been removed from your buddies', call1 => 'Callsign lookup via $_[0]:', conother => 'Sorry $_[0] you are connected to me on another port', concluster => 'Sorry $_[0] you are already connected elsewhere on the cluster (on $_[1])', @@ -152,6 +154,8 @@ package DXM; lange2 => 'failed to set language on $_[0]', lastconn => 'Last connect', leave => 'leaving group $_[0]', + lgset => 'Added $_[0] to the local node group', + lgunset => 'Removed $_[0] from the local node group', lh1 => '$main::data/hop_table.pl doesn\'t exist', local1 => 'Local', loce1 => 'Please enter your location,, set/location ', @@ -163,6 +167,8 @@ package DXM; lockoutc => '$_[0] Created and Locked out', lockoutun => '$_[0] Unlocked', lockoutuse => 'usage: sh/lockout |ALL', + loginb => 'Buddy $_[0] has logged in', + logoutb => 'Buddy $_[0] has logged out', loginu => 'User $_[0] has logged in', logoutu => 'User $_[0] has logged out', loginn => 'Node $_[0] has logged in', -- 2.43.0