From: minima Date: Wed, 12 Jan 2005 12:33:48 +0000 (+0000) Subject: 1. Add $main::bumpexisting variable which allows a new connection for a user X-Git-Tag: 1.53~196 X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=aad4e36d3753bf8dde671d14d73b1d9785b9ff41;p=spider.git 1. Add $main::bumpexisting variable which allows a new connection for a user call to disconnect an existing connection with the same call. The default for this variable is 'true' (1). This means that existing behaviour has changed. set/var $main::bumpexisting = 0 to return to original behaviour. 2. Remind a user every hour (as default) that they have new messages. set/var $DXCommandmode::msgpolltime = 3*3600 to set it to 3 hours. 3. Allow some substitutions in set/prompt (call, date, time and cluster call) and add dxspider just before the > as standard. 4. Add $main::allowdxby variable so that sysops can switch off the 'DX BY ' that causes only the first word of the comment to be recorded. --- diff --git a/Changes b/Changes index 952c2814..60e4b0a5 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,18 @@ +12Jan05======================================================================= +1. Add $main::bumpexisting variable which allows a new connection for a user +call to disconnect an existing connection with the same call. The default for +this variable is 'true' (1). This means that existing behaviour has changed. +set/var $main::bumpexisting = 0 to return to original behaviour. +2. Remind a user every hour (as default) that they have new messages. +set/var $DXCommandmode::msgpolltime = 3*3600 to set it to 3 hours. +3. Allow some substitutions in set/prompt (call, date, time and +cluster call) and add dxspider just before the > as standard. +4. Add $main::allowdxby variable so that sysops can switch off the +'DX BY ' that causes only the first word of the +comment to be recorded. 27Dec04======================================================================= 1. add improved VE data from Charlie K1XX. You should update usdb as well. 22Dec04======================================================================= diff --git a/cmd/Commands_en.hlp b/cmd/Commands_en.hlp index cf0f9816..eaa862ef 100644 --- a/cmd/Commands_en.hlp +++ b/cmd/Commands_en.hlp @@ -1703,14 +1703,25 @@ password for a user. === 0^SET/PROMPT ^Set your prompt to === 0^UNSET/PROMPT^Set your prompt back to default -This command will set your user prompt to exactly the string that you +This command will set your user prompt to the string that you say. The point of this command to enable a user to interface to programs that are looking for a specific prompt (or else you just want a different -fixed prompt). +prompt). SET/PROMPT clx > -UNSET/PROMPT will undo the SET/PROMPT command and set you prompt back to +There are some substitutions that can be added to the prompt: + + %C - callsign [which will have ( and ) around it if not here] + %D - date + %T - time + %M - cluster 'mycall' + +The standard prompt is defined as: + + SET/PROMPT %C de %M %D %T dxspider > + +UNSET/PROMPT will undo the SET/PROMPT command and set your prompt back to normal. === 5^SET/SPIDER [..]^Make the callsign an DXSpider node diff --git a/cmd/dx.pl b/cmd/dx.pl index ce0c304f..b0be3bd8 100644 --- a/cmd/dx.pl +++ b/cmd/dx.pl @@ -34,11 +34,11 @@ return (1, $self->msg('dx2')) unless @f >= 2; # can be in any order if ($f[0] =~ /^by$/i) { - return (1, $self->msg('e5')) unless $self->priv; + return (1, $self->msg('e5')) unless $main::allowdxby || $self->priv; $spotter = uc $f[1]; - $line =~ s/^\s*\Q$f[0]\s+\Q$f[1]\s+//; - $line = $f[2]; - @f = split /\s+/, $line; + $line =~ s/\s*$f[0]\s+$f[1]\s+//; +# $line = $f[2]; + @f = split /\s+/, $line, 3; return (1, $self->msg('dx2')) unless @f >= 2; } diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 1994846b..0f25a5dd 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -115,6 +115,7 @@ $count = 0; verified => '9,Verified?,yesno', newroute => '1,New Style Routing,yesno', ve7cc => '0,VE7CC program special,yesno', + lastmsgpoll => '0,Last Msg Poll,atime', ); use vars qw($VERSION $BRANCH); diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index e4949857..10045442 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -37,7 +37,7 @@ use DB_File; use VE7CC; use strict; -use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase $maxerrors %nothereslug $maxbadcount); +use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase $maxerrors %nothereslug $maxbadcount $msgpolltime); %Cache = (); # cache of dynamically loaded routine's mod times %cmd_cache = (); # cache of short names @@ -46,6 +46,7 @@ $errstr = (); # error string from eval $scriptbase = "$main::root/scripts"; # the place where all users start scripts go $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 use vars qw($VERSION $BRANCH); @@ -182,6 +183,7 @@ sub start $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); + $self->lastmsgpoll($main::systime); $self->prompt; } @@ -492,6 +494,12 @@ sub process foreach $dxchan (@dxchan) { next if $dxchan->sort ne 'U'; + + # send a outstanding message prompt if required + if ($t >= $dxchan->lastmsgpoll + $msgpolltime) { + $dxchan->send($dxchan->msg('m9')) if DXMsg::for_me($dxchan->call); + $dxchan->lastmsgpoll($t); + } # send a prompt if no activity out on this channel if ($t >= $dxchan->t + $main::user_interval) { @@ -549,11 +557,18 @@ sub disconnect sub prompt { my $self = shift; - if ($self->{prompt}) { - $self->send($self->{prompt}); - } else { - $self->send($self->msg($self->here ? 'pr' : 'pr2', $self->call, cldate($main::systime), ztime($main::systime))); - } + my $call = $self->call; + my $date = cldate($main::systime); + my $time = ztime($main::systime); + my $prompt = $self->{prompt} || $self->msg('pr'); + + $call = "($call)" unless $self->here; + $prompt =~ s/\%C/$call/g; + $prompt =~ s/\%D/$date/g; + $prompt =~ s/\%T/$time/g; + $prompt =~ s/\%M/$main::mycall/g; + + $self->send($prompt); } # broadcast a message to all users [except those mentioned after buffer] diff --git a/perl/Messages b/perl/Messages index e7356ba2..a79debbc 100644 --- a/perl/Messages +++ b/perl/Messages @@ -32,6 +32,7 @@ package DXM; conscript => 'no connect script called \"$_[0]\" found in $main::root/connect', confail => 'connection to $_[0] failed ($_[1])', constart => 'connection to $_[0] started', + conbump => 'Reconnected as $_[0] at $_[1], this instance is disconnected', deluser => 'User $_[0] has been deleted', db1 => 'This database is hosted at $_[0]', db2 => 'Sorry, but key: $_[0] was not found in $_[1]', @@ -227,9 +228,7 @@ package DXM; pinge1 => 'Cannot ping yourself!', pingint => 'Ping interval on $_[0] set to $_[1] secs', 'pos' => 'From Callsign: $_[0] Lat: $_[1] Long: $_[2]', - pr => '$_[0] de $main::mycall $_[1] $_[2] >', - pr2 => '($_[0]) de $main::mycall $_[1] $_[2] >', - prs => 'Prompt now set to \"$_[0]\"', + pr => '%C de %M %D %T dxspider >', pru => 'Prompt now set back to default', priv => 'Privilege level changed on $_[0]', prx => '$main::mycall >', diff --git a/perl/cluster.pl b/perl/cluster.pl index a2664b77..20726684 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -115,7 +115,8 @@ package main; use strict; use vars qw(@inqueue $systime $version $starttime $lockfn @outstanding_connects $zombies $root @listeners $lang $myalias @debug $userfn $clusteraddr - $clusterport $mycall $decease $is_win $routeroot $me $reqreg + $clusterport $mycall $decease $is_win $routeroot $me $reqreg $bumpexisting + $allowdxby ); @inqueue = (); # the main input queue, an array of hashes @@ -125,6 +126,9 @@ $starttime = 0; # the starting time of the cluster #@outstanding_connects = (); # list of outstanding connects @listeners = (); # list of listeners $reqreg = 0; # 1 = registration required, 2 = deregister people +$bumpexisting = 1; # 1 = allow new connection to disconnect old, 0 - don't allow it +$allowdxby = 0; # 1 = allow "dx by ", 0 - don't allow it + use vars qw($VERSION $BRANCH $build $branch); $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); @@ -170,9 +174,20 @@ sub new_channel my $user = DXUser->get_current($call); my $dxchan = DXChannel->get($call); if ($dxchan) { - my $mess = DXM::msg($lang, ($user && $user->is_node) ? 'concluster' : 'conother', $call, $main::mycall); - already_conn($conn, $call, $mess); - return; + if ($user && $user->is_node) { + already_conn($conn, $call, DXM::msg($lang, 'concluster', $call, $main::mycall)); + return; + } + if ($bumpexisting) { + my $ip = $conn->{peerhost} || 'unknown'; + $dxchan->send_now('D', DXM::msg($lang, 'conbump', $call, $ip)); + Log('DXCommand', "$call bumped off by $ip, disconnected"); + dbg("$call bumped off by $ip, disconnected"); + $dxchan->disconnect; + } else { + already_conn($conn, $call, DXM::msg($lang, 'conother', $call, $main::mycall)); + return; + } } # is he locked out ? diff --git a/techdoc/protocol.pod b/techdoc/protocol.pod index 1e1f2436..d6b4a7ee 100644 --- a/techdoc/protocol.pod +++ b/techdoc/protocol.pod @@ -129,7 +129,7 @@ L to which this L is connected. =head2 Endpoint -An L is a connection to a L that uses the protocol. From a routing point of +An L is a connection to a L that uses the protocol. From a routing point of view, it is indistiguishable from a L. The L is responsible for creating and decoding well formed protocol messages. An L does not route beyond the immediate L(s) to which it is connected. It may also be a L connected to a L which provides some