+20Dec98========================================================================
+1. Removed all the warnings I get with perl -w (at least for just starting the
+cluster and running a few commands).
+2. Added per node hop control.
+3. Added some docs on how to use it and isolation
+4. Made talk command more intelligent in that if the user isn't seen and the
+user's last node is visible it tries the talk anyway.
19Dec98========================================================================
1. Fixed problems with sh/rcmd (talk/ann/log) with a callsign as argument and
also made what G0RDI wanted work as well!
'?' => [
'^\?', 'help', 'help',
],
- a => [
+ 'a' => [
'^ann.*/full', 'announce full', 'announce',
'^ann.*/sysop', 'announce sysop', 'announce',
'^ann.*/(.*)$', 'announce $1', 'announce',
],
- b => [
+ 'b' => [
],
- c => [
+ 'c' => [
],
- d => [
+ 'd' => [
'^del', 'kill', 'kill',
'^del.*/fu', 'kill full', 'kill',
'^di\w*/a\w*', 'directory all', 'directory',
'^di\w*/(\d+)-(\d+)', 'directory $1-$2', 'directory',
'^di\w*/(\d+)', 'directory $1', 'directory',
],
- e => [
+ 'e' => [
],
- f => [
+ 'f' => [
],
- g => [
+ 'g' => [
],
- h => [
+ 'h' => [
],
- i => [
+ 'i' => [
],
- j => [
+ 'j' => [
],
- k => [
+ 'k' => [
],
- l => [
+ 'l' => [
'^l$', 'directory', 'directory',
'^ll$', 'directory', 'directory',
'^ll/(\d+)', 'directory $1', 'directory',
],
- m => [
+ 'm' => [
],
- n => [
+ 'n' => [
],
- o => [
+ 'o' => [
],
- p => [
+ 'p' => [
],
- q => [
+ 'q' => [
'^q', 'bye', 'bye',
],
- r => [
+ 'r' => [
'^r$', 'read', 'read',
'^rcmd/(\S+)', 'rcmd $1', 'rcmd',
],
- s => [
+ 's' => [
'^set/nobe', 'unset/beep', 'unset/beep',
'^set/nohe', 'unset/here', 'unset/here',
'^sh.*/c/n', 'show/configuration nodes', 'show/configuration',
'^sh.*/wwv/(\d+)-(\d+)', 'show/wwv $1-$2', 'show/wwv',
'^sh.*/wwv/(\d+)', 'show/wwv $1', 'show/wwv',
],
- t => [
+ 't' => [
],
- u => [
+ 'u' => [
],
- v => [
+ 'v' => [
],
- w => [
+ 'w' => [
'^wx/full', 'wx full', 'wx',
'^wx/sysop', 'wx sysop', 'wx',
],
- x => [
+ 'x' => [
],
- y => [
+ 'y' => [
],
- z => [
+ 'z' => [
],
)
--- /dev/null
+#
+# load the node hop count table after changing it
+#
+my $self = shift;
+return (0, $self->msg('e5')) if $self->priv < 9;
+my @out = DXProt::load_hops($self);
+@out = ($self->msg('ok')) if !@out;
+return (1, @out);
#
my ($self, $line) = @_;
-my @argv = split /\s+/, $line; # generate an argv
+my @argv = split /\s+/, $line; # generate an argv
my $to = uc $argv[0];
my $via;
my $from = $self->call();
+my @out;
# have we a callsign and some text?
return (1, $self->msg('e8')) if @argv < 2;
if ($argv[1] eq '>') {
- $via = uc $argv[2];
- $line =~ s/^$argv[0]\s+>\s+$argv[2]\s*//;
+ $via = uc $argv[2];
+ $line =~ s/^$argv[0]\s+>\s+$argv[2]\s*//;
} else {
- $line =~ s/^$argv[0]\s*//;
+ $line =~ s/^$argv[0]\s*//;
}
my $call = $via ? $via : $to;
my $ref = DXCluster->get($call);
+
+# if we haven't got an explicit via and we can't see them, try their node
+unless ($ref || $via) {
+ my $user = DXUser->get($call);
+ $ref = DXCluster->get_exact($user->node);
+ if ($ref) {
+ $via = $user->node;
+ push @out, "trying via $via..";
+ }
+}
return (1, "$call not visible on the cluster") if !$ref;
-my $dxchan = DXCommandmode->get($to); # is it for us?
+my $dxchan = DXCommandmode->get($to); # is it for us?
if ($dxchan && $dxchan->is_user) {
- $dxchan->send("$to de $from $line");
- Log('talk', $to, $from, $main::mycall, $line);
+ $dxchan->send("$to de $from $line");
+ Log('talk', $to, $from, $main::mycall, $line);
} else {
- $line =~ s/\^//og; # remove any ^ characters
- my $prot = DXProt::pc10($from, $to, $via, $line);
- DXProt::route($via?$via:$to, $prot);
- Log('talk', $to, $from, $via?$via:$main::mycall, $line);
+ $line =~ s/\^//og; # remove any ^ characters
+ my $prot = DXProt::pc10($from, $to, $via, $line);
+ DXProt::route($via?$via:$to, $prot);
+ Log('talk', $to, $from, $via?$via:$main::mycall, $line);
}
-return (1, ());
+return (1, @out);
<p>
<!-- Created: Sun Dec 13 20:25:14 GMT 1998 -->
<!-- hhmts start -->
-Last modified: Thu Dec 17 00:06:40 GMT 1998
+Last modified: Sun Dec 20 17:04:05 GMT 1998
<!-- hhmts end -->
<p>At the moment, anybody can connect inwards at any time from outside, either by ax25 or by
telnet (assuming you have followed the instructions in <a href="install.html">installation</a>
etc
</pre>
- <p>The connect scripts consist of lines which start with the following keywords or symbols:-
+ <p>The connect scripts consist of lines which start with the
+ following keywords or symbols:-
+
<ul>
- <p><li><b>#</b> All lines starting with a <b>#</b> are ignored, as are wholly blank lines.
- <p><li><b>timeout</b> followed by a number is the number of seconds to wait for a command
- to complete. If there is no <b>timeout</b> specified in the script then the default is 60 seconds.
- <P><li><b>abort</b> is a regular expression containing one or more strings to look for to abort a
- connection. This is a perl regular expression and is executed ignoring case.
- <p><li><b>connect</b> followed by <b>ax25</b> or <b>telnet</b> and some type dependent information. In
- the case of a <b>telnet</b> connection, there can be up to two parameters, the first is the ip
- address or hostname of the computer you wish to connect to and the second is the port number you
- want to use (this can be left out if it is a normal telnet session).
- <p>In the case of an <b>ax25</b> session then this would normally be a call to <tt>ax25_call</tt>
- or <tt>netrom_call</tt> as in the example above. It is your responsibility to get your node
- and other ax25 parameters to work before going down this route!
- <p><li><b>'</b> or <b>"</b> are the delimiting characters for a <tt>chat</tt> type script. They normally
- come in pairs, either can be empty. Each line reads input from the connection until it sees the string
- (or perl regular expression) contained in the left hand string. If the left hand string is empty then
- it doesn't read or wait for anything. The comparison is done ignoring case.
- <p>When the left hand string has found what it is looking (if it is) then the right hand string is
- sent to the connection.
+
+ <p><li><b>#</b> All lines starting with a <b>#</b> are
+ ignored, as are wholly blank lines.
+
+ <p><li><b>timeout</b> followed by a number is the number of
+ seconds to wait for a command to complete. If there is no
+ <b>timeout</b> specified in the script then the default is 60
+ seconds.
+
+ <P><li><b>abort</b> is a regular expression containing one or
+ more strings to look for to abort a connection. This is a perl
+ regular expression and is executed ignoring case.
+
+ <p><li><b>connect</b> followed by <b>ax25</b> or <b>telnet</b>
+ and some type dependent information. In the case of a
+ <b>telnet</b> connection, there can be up to two parameters,
+ the first is the ip address or hostname of the computer you
+ wish to connect to and the second is the port number you want
+ to use (this can be left out if it is a normal telnet
+ session).
+
+ <p>In the case of an <b>ax25</b> session then this would
+ normally be a call to <tt>ax25_call</tt> or
+ <tt>netrom_call</tt> as in the example above. It is your
+ responsibility to get your node and other ax25 parameters to
+ work before going down this route!
+
+ <p><li><b>'</b> is the delimiting character for a word or
+ phrase of an expect/send line in a <tt>chat</tt> type
+ script. The words/phrases normally come in pairs, either can
+ be empty. Each line reads input from the connection until it
+ sees the string (or perl regular expression) contained in the
+ left hand string. If the left hand string is empty then it
+ doesn't read or wait for anything. The comparison is done
+ ignoring case.
+
+ <p>When the left hand string has found what it is looking (if
+ it is) then the right hand string is sent to the connection.
+
<p>This process is repeated for every line of <tt>chat</tt> script.
- <p><li><b>client</b> starts the connection, put the arguments you would want here if you were
- starting the client program manually. You only need this if the script has a different name to
- the callsign you are trying to connect to (i.e. you have a script called <tt>other</tt> which actually
- connects to <tt>GB7DJK-1</tt> [instead of a script called <tt>gb7djk-1</tt>]).
+
+ <p><li><b>client</b> starts the connection, put the arguments
+ you would want here if you were starting the client program
+ manually. You only need this if the script has a different
+ name to the callsign you are trying to connect to (i.e. you
+ have a script called <tt>other</tt> which actually connects to
+ <tt>GB7DJK-1</tt> [instead of a script called
+ <tt>gb7djk-1</tt>]).
+
</ul>
<!-- Standard Footer!! -->
--- /dev/null
+<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
+<html>
+ <head>
+ <title>Hops, Network Isolation and other matters...</title>
+ <meta name="Keywords" content="DX Cluster, DXSpider, Spider, Packet Cluster, DXCluster, Pavillion Software, AK1A, AX25, AX.25, WWV, Packet Radio, Amateur Radio, Propagation, DX, DXing, G1TLH, GB7TLH, Dirk Koopman, Mailing list, Linux, RedHat, PERL">
+ <meta name="Description" content="Software and systems for realtime digital communications between amateur radio stations for the provision of information on propagation conditions and stations operating">
+ <meta name="Author" content="Dirk Koopman G1TLH">
+ </head>
+
+ <body TEXT="#000000" LINK="#0000ff" VLINK="#800080" BGCOLOR="#FFFFFF">
+ <FONT COLOR="#606060">
+ <hr>
+ <h2>Hops, Network Isolation and other matters...</h2>
+ <hr>
+ </font>
+
+
+ <address><a href="mailto:djk@tobit.co.uk">Dirk Koopman G1TLH</a></address>
+ <p>
+ <!-- Created: Sun Dec 13 20:25:14 GMT 1998 -->
+ <!-- hhmts start -->
+Last modified: Sun Dec 20 18:15:15 GMT 1998
+<!-- hhmts end -->
+
+ <h4>Introduction</h4>
+
+ Starting with version 1.13 there is simple hop control available on a per
+ node basis. Also it is possible to isolate a network completely so that you
+ get all the benefits of being on that network, but can't pass on information
+ from it to
+ to any other networks you may be connected to (or vice versa).
+
+ <h4>Basic Hop Control</h4>
+
+ The number of hops that are set for all PC protocol messages (that require them)
+ are specified in <tt>/spider/perl/DXProtVars.pm</tt>.
+
+ <p>In versions prior to 1.13 you would move this file to
+ <tt>/spider/local/</tt> and modify the perl variables:
+ <tt>$def_hopcount</tt> and <tt>%hopcount</tt> to some reasonable
+ values.
+
+ <p>From version 1.13 onwards a new mechanism has been introduced
+ which uses a file called <tt>/spider/data/hop_count.pl</tt>. The
+ prefered way of doing basic hop control is now to create this file
+ and modify it as you wish. Eventually this file will contain all
+ the hop control and related information. An example of the
+ <tt>hop_count.pl</tt> file can be found in the
+ <tt>/spider/examples</tt> directory.
+
+ <p>You can change this file at any time, including when the
+ cluster is running. If you do this then the changes only take
+ effect after you have run the <tt>load/hops</tt> command on a
+ client console with full sysop privileges.
+
+ <h4>Per Node Hop Control</h4>
+
+ From version 1.13 it is possible to control the number of hops to each
+ node. This is done by adding information to the <tt>%nodehops</tt> perl
+ variable in the <tt>hop_count.pl</tt> file (as described above). This
+ variable is a perl "hash of hashes", which means that you create an
+ entry for every callsign you wish to control and then one line for
+ every PC protocol message that you wish to alter.
+
+ <p>You can also have a entry called <tt>default</tt> for every callsign
+ so you can set the hops as a whole for all PC messages to just that
+ callsign. This is overridden by any specific hop counts you may have.
+
+ <h4>Example <tt>hop_count.pl</tt> File</h4>
+
+ An example for you:-
+
+ <p><pre>
+#
+# hop table construction
+#
+
+package DXProt;
+
+# default hopcount to use
+$def_hopcount = 15;
+
+# some variable hop counts based on message type
+%hopcount =
+(
+ 11 => 10,
+ 16 => 10,
+ 17 => 10,
+ 19 => 10,
+ 21 => 10,
+);
+
+#
+# the per node hop control thingy
+#
+
+%nodehops =
+(
+ GB7DJK-1 =>
+ {
+ 11 => 5,
+ 16 => 23,
+ 17 => 23,
+ default => 50,
+ },
+
+ GB7TLH =>
+ {
+ 19 => 45,
+ 21 => 45,
+ 16 => 45,
+ 17 => 45,
+ default => 15,
+ },
+);
+ </pre>
+
+ <p>The figures chosen are not necessarily what I use. What I would say is that
+ until you are certain that you know what you are doing (and that the software
+ is working at least as well as advertised) you should keep the default hop
+ counts down to the sort of levels shown above.
+
+ <h4>Isolated Networks</h4>
+
+ It is possible to isolate networks from each other on a "gateway" node using
+ the <tt>set/isolate <node call></tt> command.
+
+ <p>The effect of this is to partition an isolated network
+ completely from another nodes connected to your node. Your node
+ will appear on and otherwise behave normally on every network to
+ which you are connected, but data from isolated network will not
+ cross onto any other network or vice versa.
+
+ <P>However all the spot, announce and WWV traffic and personal
+ messages will still be handled locally (because you are a real
+ node on all connected networks), that is locally connected users
+ will appear on all networks and will be able to access and receive
+ information from all networks transparently.
+
+ <p>All routed messages will be sent as normal, so if a user on one
+ network knows that you are a gateway for another network, he can still
+ still send a talk/announce etc message via your node and it will
+ be routed across.
+
+ <p>The only limitation currently is that non-private messages
+ cannot be passed down isolated links regardless of whether they
+ are generated locally. This will change when the bulletin routing
+ facility is added.
+
+<!-- Standard Footer!! -->
+ <p> </p>
+ <p>
+ <FONT COLOR="#606060"><hr></font>
+ <font color="#FF0000" size=-2>
+ Copyright © 1998 by Dirk Koopman G1TLH. All Rights Reserved<br>
+ </font>
+ <font color="#000000" size=-2>$Id$</font>
+ </body>
+</html>
<p>
<!-- Created: Wed Dec 2 18:22:33 GMT 1998 -->
<!-- hhmts start -->
-Last modified: Thu Dec 17 00:06:39 GMT 1998
+Last modified: Sun Dec 20 16:25:28 GMT 1998
<!-- hhmts end -->
<p>The DXSpider dx cluster system is written in perl5 as an exercise in self-training
for both protocol research and teaching myself perl.
<li> <a href="install.html">Installation</a> of the main cluster software.
<li> Installing the lastest version of <a href="cpan.html">CPAN</a>.
<li> <a href="connect.html">Connecting</a> to other clusters.
+ <li> <a href="hops.html">Hop</a> control, network <a href="hops.html">isolation</a> etc.
<li> <a href="../download/">Download</a> the software and any patches.
</ol>
<address><A HREF="mailto:ip@g8sjp.demon.co.uk">Iain Phillips G0RDI</A></address>
<!-- Created: Wed Dec 2 16:40:25 GMT 1998 -->
<!-- hhmts start -->
-Last modified: Sat Dec 19 16:10:14 GMT 1998
+Last modified: Sun Dec 20 17:55:19 GMT 1998
<!-- hhmts end -->
<P>This HOWTO describes the installation for DX Spider v1.11 on a "vanilla"
<A href="http://www.redhat.com">RedHat</A> 5.1 platform,
</PRE>
<P>This last step allows various users of group spider to have write access to all the directories. Not really needed for now but will be useful when web interfaces start to appear.
- <p><LI>Should you have any users that require network logins, set them up as real users with 'useradd -m <callsign>'. Alter the default .bashrc so that it contains just one line (assuming you use the default bash shell).
- <PRE>
-exec /spider/perl/client.pl <callsign> telnet
- </PRE>
- <p>Alternatively you can set up a real login for a person (or another cluster) by creating a login using:-
- <pre>
-# useradd gb7djk
+ <p><LI><a name="connect"></a>If you want to be able to allow people or clusters
+ to login via IP then you will need to set up logins for them.
+
+ <p><pre>
+# useradd -m gb7djk
# passwd gb7djk
New UNIX password:
Retype new UNIX password:
passwd: all authentication tokens updated successfully
</pre>
- <p>and editing the <tt>/etc/passwd</tt> file to look like this (do substitute the correct callsigns here ;-):-
+
+ <p>You can then either alter the default .bashrc so that it
+ contains just one line (assuming you use the default bash
+ shell).
+
+ <p><PRE>
+exec /spider/perl/client.pl <callsign> telnet
+ </PRE>
+
+ <p>Alternatively you can alter the <tt>/etc/passwd</tt> thus:-
+
<pre>
fbb:x:505:505::/home/fbb:/bin/bash
gb7djk:x:506:506::/home/gb7djk:/usr/bin/perl /spider/perl/client.pl gb7djk telnet
</pre>
- <P>Don't forget to give them a real password. This is really for network cluster logins. The telnet argument does two things, it sets the EOL convention to \n rather than AX25's \r and it automatically reduces the privilege of the <callsign> to a 'safe[r]' level.).
+ Don't forget to give them a real password. The <tt>telnet</tt> argument
+ does two things, it sets the EOL convention to \n rather than
+ AX25's \r and it automatically reduces the privilege of the
+ <callsign> to a 'safe[r]' level.). If the user or other cluster
+ program requires AX25 conventions to operate then you can use
+ <tt>ax25</tt> instead.
+
+ <p>Another thing you can do is to get <tt>inetd</tt> to listen
+ on a specific port and then start the client up directly. To
+ do this, create an entry in <tt>/etc/services</tt> with a
+ port number > 1000 that isn't used elsewhere eg:-
+
+ <p><pre>
+gb7djk 8001/tcp
+gb7tlh 8002/tcp
+ </pre>
+
+ Then create some lines in <tt>/etc/inetd.conf</tt> that look
+ like this:-
+
+ <p><pre>
+gb7djk stream tcp nowait sysop /usr/sbin/tcpd /usr/bin/perl /spider/perl/client.pl gb7djk telnet
+gb7tlh stream tcp nowait sysop /usr/sbin/tcpd /usr/bin/perl /spider/perl/client.pl gb7tlh telnet
+ </pre>
+
+ Please <b>DON'T</b> run the client as <tt>root</tt> you will only
+ come to regret it later when the next person finds a security hole
+ in DX Spider (there are bound to be some although I have tried to
+ avoid the obvious ones I could think of).
+
+ <p>The only reason I would use this mechanism is for Internet connections
+ to other or from other clusters. Don't use this for normal users.
+
+ <p>In the example I have used <tt>tcpd</tt> as the access control
+ mechanism to the port. Don't (I can't be bothered to emphasize
+ it any more) run a system like this without one, you are asking
+ for trouble. In fact I use the <a href="http://www.tis.com">TIS
+ Firewall Toolkit</a> myself, you may find this more intuitive
+ to use. The point is that <tt>gb7djk</tt> would only be coming
+ from one IP address, if it coming from another, it is an imposter!
+
+ <p><b>You are responsible for arranging and looking after your
+ security - not me.</b>
+
<p><LI>As mentioned earlier, for AX25 connections <B><I>you</B></I> are expected to have the AX25 utilities installed, setup, tested and working. See the AX25-HOWTO for more info on this - it really is beyond the scope of this document DX Spider uses ax25d for incoming connections. You need to have entries like this:-
<PRE>
[ether]
</ol>
<p>You should now have a basic working system. Best of luck! Can I now draw your attention to
- the <a href="http://www.dxcluster.org/spider">Bug Reporting</a> System. Some mailing lists will
- be created RSN for more general discussions.
+ the <a href="http://www.dxcluster.org/spider">Bug Reporting</a> System.
<p>Can I commend to you the Announcements mailing list to which you may
<a href="mailto:majordomo@dxcluster.org?subject=Subscribe&body=subscribe%20dxspider-announce%0D%0A--%0D%0A">subscribe</a>.
<p>If you like what you see and want to be a part of the ongoing development then
<a href="mailto:majordomo@dxcluster.org?subject=Subscribe&body=subscribe%20dxspider-support%0D%0A--%0D%0A">subscribe</a>
- to the support mailing list which will be the initial focus of any discussions.
+ to the support mailing list which will be the focus of any discussion/bug fixing etc.
<!-- Standard Footer!! -->
<p> </p>
use strict;
use vars qw(%channels %valid);
-%channels = undef;
+%channels = ();
%valid = (
call => '0,Callsign',
list => '9,Dep Chan List',
name => '0,User Name',
consort => '9,Connection Type',
- sort => '9,Type of Channel',
+ 'sort' => '9,Type of Channel',
wwv => '0,Want WWV,yesno',
talk => '0,Want Talk,yesno',
ann => '0,Want Announce,yesno',
$self->{lang} = $main::lang if !$self->{lang};
$user->new_group() if !$user->group;
$self->{group} = $user->group;
+ $self->{func} = "";
bless $self, $pkg;
return $channels{$call} = $self;
}
sub is_ak1a
{
my $self = shift;
- return $self->{sort} eq 'A';
+ return $self->{'sort'} eq 'A';
}
# is it a user?
sub is_user
{
my $self = shift;
- return $self->{sort} eq 'U';
+ return $self->{'sort'} eq 'U';
}
# is it a connect type
sub is_connect
{
my $self = shift;
- return $self->{sort} eq 'C';
+ return $self->{'sort'} eq 'C';
}
# handle out going messages, immediately without waiting for the select to drop
$self->{pcversion} = $pcversion;
$self->{list} = { } ;
$self->{mynode} = $self; # for sh/station
+ $self->{users} = 0;
$nodes++;
dbg('cluster', "allocating node $call to cluster\n");
return $self;
} else {
$self->{users} = $count;
}
- $users += $self->{users};
+ $users += $self->{users} if $self->{users};
$maxusers = $users+$nodes if $users+$nodes > $maxusers;
}
sub new
{
my $self = DXChannel::alloc(@_);
- $self->{sort} = 'U'; # in absence of how to find out what sort of an object I am
+ $self->{'sort'} = 'U'; # in absence of how to find out what sort of an object I am
return $self;
}
sub process
{
my $t = time;
- my @chan = DXChannel->get_all();
- my $chan;
+ my @dxchan = DXChannel->get_all();
+ my $dxchan;
- foreach $chan (@chan) {
- next if $chan->sort ne 'U';
+ foreach $dxchan (@dxchan) {
+ next if $dxchan->sort ne 'U';
# send a prompt if no activity out on this channel
- if ($t >= $chan->t + $main::user_interval) {
- $chan->prompt() if $chan->{state} =~ /^prompt/o;
- $chan->t($t);
+ if ($t >= $dxchan->t + $main::user_interval) {
+ $dxchan->prompt() if $dxchan->{state} =~ /^prompt/o;
+ $dxchan->t($t);
}
}
}
my $s = shift; # the line to be rebroadcast
my @except = @_; # to all channels EXCEPT these (dxchannel refs)
my @list = DXChannel->get_all(); # just in case we are called from some funny object
- my ($chan, $except);
+ my ($dxchan, $except);
- L: foreach $chan (@list) {
- next if !$chan->sort eq 'U'; # only interested in user channels
+ L: foreach $dxchan (@list) {
+ next if !$dxchan->sort eq 'U'; # only interested in user channels
foreach $except (@except) {
- next L if $except == $chan; # ignore channels in the 'except' list
+ next L if $except == $dxchan; # ignore channels in the 'except' list
}
- chan->send($s); # send it
+ $dxchan->send($s); # send it
}
}
return () if $short_cmd =~ /\/$/;
# return immediately if we have it
- my ($apath, $acmd) = split ',', $cmd_cache{$short_cmd};
+ ($apath, $acmd) = split ',', $cmd_cache{$short_cmd} if $cmd_cache{$short_cmd};
if ($apath && $acmd) {
dbg('command', "cached $short_cmd = ($apath, $acmd)\n");
return ($apath, $acmd);
pop @lparts; # remove the suffix
$l = join '.', @lparts;
# chop $dirfn; # remove trailing /
+ $dirfn = "" unless $dirfn;
$cmd_cache{"$short_cmd"} = join(',', ($path, "$dirfn$l")); # cache it
dbg('command', "got path: $path cmd: $dirfn$l\n");
return ($path, "$dirfn$l");
my $fn = "$main::cmd/crontab";
-my $localfn = "$main::local_cmd/crontab";
+my $localfn = "$main::localcmd/crontab";
# cron initialisation / reading in cronjobs
sub init
sub isdbg
{
- return $dbglevel{shift};
+ my $s = shift;
+ return $dbglevel{$s};
}
1;
__END__
my $ref = {};
$ref->{prefix} = "$main::data/$prefix";
$ref->{suffix} = $suffix if $suffix;
- $ref->{sort} = $sort;
+ $ref->{'sort'} = $sort;
# make sure the directory exists
mkdir($ref->{prefix}, 0777) if ! -e $ref->{prefix};
delete $self->{mode};
}
- $self->{fn} = sprintf "$self->{prefix}/$year/%02d", $thing if $self->{sort} eq 'm';
- $self->{fn} = sprintf "$self->{prefix}/$year/%03d", $thing if $self->{sort} eq 'd';
+ $self->{fn} = sprintf "$self->{prefix}/$year/%02d", $thing if $self->{'sort'} eq 'm';
+ $self->{fn} = sprintf "$self->{prefix}/$year/%03d", $thing if $self->{'sort'} eq 'd';
$self->{fn} .= ".$self->{suffix}" if $self->{suffix};
$mode = 'r' if !$mode;
sub openprev
{
my $self = shift;
- if ($self->{sort} eq 'm') {
+ if ($self->{'sort'} eq 'm') {
($self->{year}, $self->{thing}) = Julian::subm($self->{year}, $self->{thing}, 1);
- } elsif ($self->{sort} eq 'd') {
+ } elsif ($self->{'sort'} eq 'd') {
($self->{year}, $self->{thing}) = Julian::sub($self->{year}, $self->{thing}, 1);
}
return $self->open($self->{year}, $self->{thing}, @_);
sub opennext
{
my $self = shift;
- if ($self->{sort} eq 'm') {
+ if ($self->{'sort'} eq 'm') {
($self->{year}, $self->{thing}) = Julian::addm($self->{year}, $self->{thing}, 1);
- } elsif ($self->{sort} eq 'd') {
+ } elsif ($self->{'sort'} eq 'd') {
($self->{year}, $self->{thing}) = Julian::add($self->{year}, $self->{thing}, 1);
}
return $self->open($self->{year}, $self->{thing}, @_);
{
my $self = shift;
- if ($self->{sort} eq 'm') {
+ if ($self->{'sort'} eq 'm') {
return Julian::unixtojm(shift);
- } elsif ($self->{sort} eq 'd') {
+ } elsif ($self->{'sort'} eq 'd') {
return Julian::unixtoj(shift);
}
confess "shouldn't get here";
file => '9,File?,yesno',
gotit => '9,Got it Nodes,parray',
lines => '9,Lines,parray',
- read => '9,Times read',
+ 'read' => '9,Times read',
size => '0,Size',
msgno => '0,Msgno',
keep => '0,Keep this?,yesno',
$self->{private} = shift;
$self->{subject} = shift;
$self->{origin} = shift;
- $self->{read} = shift;
+ $self->{'read'} = shift;
$self->{rrreq} = shift;
$self->{gotit} = [];
}
}
$ref->stop_msg($self);
- queue_msg();
+ queue_msg(0);
} else {
$self->send(DXProt::pc42($f[2], $f[1], $f[3])); # unknown stream
}
- queue_msg();
+ queue_msg(0);
last SWITCH;
}
} else {
$self->send(DXProt::pc42($f[2], $f[1], $f[3])); # unknown stream
}
- queue_msg();
+ queue_msg(0);
last SWITCH;
}
if (defined $fh) {
my $rr = $ref->{rrreq} ? '1' : '0';
my $priv = $ref->{private} ? '1': '0';
- print $fh "=== $ref->{msgno}^$ref->{to}^$ref->{from}^$ref->{t}^$priv^$ref->{subject}^$ref->{origin}^$ref->{read}^$rr\n";
+ print $fh "=== $ref->{msgno}^$ref->{to}^$ref->{from}^$ref->{t}^$priv^$ref->{subject}^$ref->{origin}^$ref->{'read'}^$rr\n";
print $fh "=== ", join('^', @{$ref->{gotit}}), "\n";
my $line;
$ref->{size} = 0;
# bat down the message list looking for one that needs to go off site and whose
# nearest node is not busy.
-
+
dbg('msg', "queue msg ($sort)\n");
foreach $ref (@msg) {
# firstly, is it private and unread? if so can I find the recipient
# in my cluster node list offsite?
if ($ref->{private}) {
- if ($ref->{read} == 0) {
+ if ($ref->{'read'} == 0) {
$clref = DXCluster->get_exact($ref->{to});
if ($clref && !grep { $clref->{dxchan} == $_ } DXCommandmode::get_all) {
$dxchan = $clref->{dxchan};
$ref->start_msg($dxchan) if $clref && !get_busy($dxchan->call) && $dxchan->state eq 'normal';
}
}
- } elsif ($sort == undef) {
+ } elsif (!$sort) {
# otherwise we are dealing with a bulletin, compare the gotit list with
# the nodelist up above, if there are sites that haven't got it yet
# then start sending it - what happens when we get loops is anyone's
delete $self->{loc};
$self->state('prompt');
$self->func(undef);
- DXMsg::queue_msg();
+ DXMsg::queue_msg(0);
} elsif ($line eq "\031" || uc $line eq "/ABORT" || uc $line eq "/QUIT") {
#push @out, $self->msg('sendabort');
push @out, "aborted";
use Carp;
use strict;
-use vars qw($me $pc11_max_age $pc11_dup_age %dup $last_hour %pings %rcmds);
+use vars qw($me $pc11_max_age $pc11_dup_age %dup $last_hour %pings %rcmds %nodehops);
$me = undef; # the channel id for this cluster
$pc11_max_age = 1*3600; # the maximum age for an incoming 'real-time' pc11
$last_hour = time; # last time I did an hourly periodic update
%pings = (); # outstanding ping requests outbound
%rcmds = (); # outstanding rcmd requests outbound
+%nodehops = (); # node specific hop control
+
sub init
{
my $user = DXUser->get($main::mycall);
$DXProt::myprot_version += $main::version*100;
- $me = DXProt->new($main::mycall, undef, $user);
+ $me = DXProt->new($main::mycall, 0, $user);
$me->{here} = 1;
+ $me->{state} = "indifferent";
+ do "$main::data/hop_table.pl" if -e "$main::data/hop_table.pl";
+ confess $@ if $@;
# $me->{sort} = 'M'; # M for me
}
sub new
{
my $self = DXChannel::alloc(@_);
- $self->{sort} = 'A'; # in absence of how to find out what sort of an object I am
+ $self->{'sort'} = 'A'; # in absence of how to find out what sort of an object I am
return $self;
}
# process PC frames
my ($pcno) = $field[0] =~ /^PC(\d\d)/; # just get the number
+ return unless $pcno;
return if $pcno < 10 || $pcno > 51;
SWITCH: {
}
# queue up any messages
- DXMsg::queue_msg() if $self->state eq 'normal';
+ DXMsg::queue_msg(0) if $self->state eq 'normal';
last SWITCH;
}
$self->state('normal');
# queue mail
- DXMsg::queue_msg();
+ DXMsg::queue_msg(0);
return;
}
$self->state('normal');
# queue mail
- DXMsg::queue_msg();
+ DXMsg::queue_msg(0);
return;
}
# REBROADCAST!!!!
#
- my $hops;
- if (!$self->{isolate} && (($hops) = $line =~ /H(\d+)\^\~?$/o)) {
- my $newhops = $hops - 1;
- if ($newhops > 0) {
- $line =~ s/\^H$hops(\^\~?)$/\^H$newhops$1/; # change the hop count
- broadcast_ak1a($line, $self); # send it to everyone but me
- }
+ if (!$self->{isolate}) {
+ broadcast_ak1a($line, $self); # send it to everyone but me
}
}
sub process
{
my $t = time;
- my @chan = DXChannel->get_all();
- my $chan;
+ my @dxchan = DXChannel->get_all();
+ my $dxchan;
- foreach $chan (@chan) {
- next if !$chan->is_ak1a();
+ foreach $dxchan (@dxchan) {
+ next unless $dxchan->is_ak1a();
+ next if $dxchan == $me;
# send a pc50 out on this channel
- if ($t >= $chan->pc50_t + $DXProt::pc50_interval) {
- $chan->send(pc50());
- $chan->pc50_t($t);
+ if ($t >= $dxchan->pc50_t + $DXProt::pc50_interval) {
+ $dxchan->send(pc50());
+ $dxchan->pc50_t($t);
}
}
@nodes = DXNode::get_all();
@nodes = grep { $_->dxchan != $self } @nodes;
}
- $self->send($me->pc19(@nodes));
+
+ my @s = $me->pc19(@nodes);
+ for (@s) {
+ my $routeit = adjust_hops($self, $_);
+ $self->send($_) if $routeit;
+ }
# get all the users connected on the above nodes and send them out
foreach $n (@nodes) {
my @users = values %{$n->list};
- $self->send(DXProt::pc16($n, @users));
+ my @s = pc16($n, @users);
+ for (@s) {
+ my $routeit = adjust_hops($self, $_);
+ $self->send($_) if $routeit;
+ }
}
}
if ($cl) {
my $hops;
my $dxchan = $cl->{dxchan};
- if (($hops) = $line =~ /H(\d+)\^\~?$/o) {
- my $newhops = $hops - 1;
- if ($newhops > 0) {
- $line =~ s/\^H$hops(\^\~?)$/\^H$newhops$1/; # change the hop count
+ if ($dxchan) {
+ my $routeit = adjust_hops($dxchan, $line); # adjust its hop count by node name
+ if ($routeit) {
$dxchan->send($line) if $dxchan;
}
- } else {
- $dxchan->send($line) if $dxchan; # for them wot don't have Hops
}
}
}
{
my $s = shift; # the line to be rebroadcast
my @except = @_; # to all channels EXCEPT these (dxchannel refs)
- my @chan = get_all_ak1a();
- my $chan;
+ my @dxchan = get_all_ak1a();
+ my $dxchan;
- foreach $chan (@chan) {
- next if grep $chan == $_, @except;
- $chan->send($s) unless $chan->{isolate}; # send it if it isn't the except list
+ # send it if it isn't the except list and isn't isolated and still has a hop count
+ foreach $dxchan (@dxchan) {
+ next if grep $dxchan == $_, @except;
+ my $routeit = adjust_hops($dxchan, $s); # adjust its hop count by node name
+ $dxchan->send($s) unless $dxchan->{isolate} || !$routeit;
}
}
{
my $s = shift; # the line to be rebroadcast
my @except = @_; # to all channels EXCEPT these (dxchannel refs)
- my @chan = get_all_users();
- my $chan;
+ my @dxchan = get_all_users();
+ my $dxchan;
- foreach $chan (@chan) {
- next if grep $chan == $_, @except;
- $s =~ s/\a//og if !$chan->{beep};
- $chan->send($s); # send it if it isn't the except list or hasn't a passout flag
+ foreach $dxchan (@dxchan) {
+ next if grep $dxchan == $_, @except;
+ $s =~ s/\a//og if !$dxchan->{beep};
+ $dxchan->send($s); # send it if it isn't the except list or hasn't a passout flag
}
}
sub broadcast_list
{
my $s = shift;
- my $chan;
+ my $dxchan;
- foreach $chan (@_) {
- $chan->send($s); # send it
+ foreach $dxchan (@_) {
+ $dxchan->send($s); # send it
}
}
return "H$hops";
}
+#
+# adjust the hop count on a per node basis using the user loadable
+# hop table if available or else decrement an existing one
+#
+
+sub adjust_hops
+{
+ my $self = shift;
+ my $call = $self->{call};
+ my $hops;
+
+ if (($hops) = $_[0] =~ /\^H(\d+)\^~?$/o) {
+ my ($pcno) = $_[0] =~ /^PC(\d\d)/o;
+ confess "$call called adjust_hops with '$_[0]'" unless $pcno;
+ my $ref = $nodehops{$call} if %nodehops;
+ if ($ref) {
+ my $newhops = $ref->{$pcno};
+ return 0 if defined $newhops && $newhops == 0;
+ $newhops = $ref->{default} unless $newhops;
+ return 0 if defined $newhops && $newhops == 0;
+ $newhops = $hops if !$newhops;
+ $_[0] =~ s/\^H(\d+)(\^~?)$/\^H$newhops$2/ if $newhops;
+ } else {
+ # simply decrement it
+ $hops--;
+ return 0 if !$hops;
+ $_[0] =~ s/\^H(\d+)(\^~?)$/\^H$hops$2/ if $hops;
+ }
+ }
+ return 1;
+}
+
+#
+# load hop tables
+#
+sub load_hops
+{
+ my $self = shift;
+ return $self->msg('lh1') unless -e "$main::data/hop_table.pl";
+ do "$main::data/hop_table.pl";
+ return $@ if $@;
+ return 0;
+}
+
# remove leading and trailing spaces from an input string
sub unpad
{
use strict;
use vars qw(%u $dbm $filename %valid);
-%u = undef;
+%u = ();
$dbm = undef;
$filename = undef;
lastin => '0,Last Time in,cldatetime',
passwd => '9,Password',
addr => '0,Full Address',
- sort => '0,Type of User', # A - ak1a, U - User, S - spider cluster, B - BBS
+ 'sort' => '0,Type of User', # A - ak1a, U - User, S - spider cluster, B - BBS
xpert => '0,Expert Status,yesno',
bbs => '0,Home BBS',
node => '0,Last Node',
my $self = {};
$self->{call} = $call;
- $self->{sort} = 'U';
+ $self->{'sort'} = 'U';
$self->{dxok} = 1;
$self->{annok} = 1;
$self->{lang} = $main::lang;
sub sort
{
my $self = shift;
- @_ ? $self->{sort} = shift : $self->{sort} ;
+ @_ ? $self->{'sort'} = shift : $self->{'sort'} ;
}
1;
__END__
{
my $self = shift; # is a dxchan
my $ref = shift; # is a thingy with field_prompt and fields methods defined
- my @out = @_;
-
+ my @out;
my @fields = $ref->fields;
my $field;
- my @out;
foreach $field (sort @fields) {
if (defined $ref->{$field}) {
$def_hopcount $data $system $cmd
$userfn $motd $local_cmd $mybbsaddr
$lang
- $pc50_interval, $user_interval
+ $pc50_interval $user_interval
);
isoc => '$_[0] created and Isolated',
l1 => 'Sorry $_[0], you are already logged on on another channel',
l2 => 'Hello $_[0], this is $main::mycall in $main::myqth running DXSpider V$main::version',
+ 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)',
loc => 'Your Lat/Long is now \"$_[0]\"',
use strict;
use vars qw($db %prefix_loc %pre);
-$db; # the DB_File handle
-%prefix_loc; # the meat of the info
-%pre; # the prefix list
+$db = undef; # the DB_File handle
+%prefix_loc = (); # the meat of the info
+%pre = (); # the prefix list
sub load
{
# the user MAY have an SSID if local, but otherwise doesn't
- my $user = DXUser->get($call);
+ $user = DXUser->get($call);
if (!defined $user) {
$user = DXUser->new($call);
} else {
{
my $dxchan;
foreach $dxchan (DXChannel->get_all()) {
- disconnect($dxchan);
+ disconnect($dxchan) unless $dxchan == $DXProt::me;
}
Log('cluster', "DXSpider V$version stopped");
exit(0);
projects / spider.git / commitdiff