hamradio/spider
1
0
Fork 0
mirror of git://scm.dxcluster.org/scm/spider synced 2024-09-21 07:47:10 +00:00
Code Issues Packages Projects Releases Wiki Activity

pre 1.13 release

Browse Source
This commit is contained in:
djk 1998-12-21 10:24:48 +00:00
parent 69c8aeb338
commit cce1612210
23 changed files with 493 additions and 172 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
Changes
View File

@ -1,3 +1,10 @@
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!

52
cmd/Aliases
View File

@ -25,16 +25,16 @@ package CmdAlias;
'?' => [
'^\?', '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',
@ -45,41 +45,41 @@ package CmdAlias;
'^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',
@ -92,20 +92,20 @@ package CmdAlias;
'^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' => [
],
)

8
cmd/load/hops.pl Normal file
View File

@ -0,0 +1,8 @@
#
# 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);

0
cmd/set/password.pl Normal file
View File

35
cmd/talk.pl
View File

@ -7,35 +7,46 @@
#
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);

76
html/connect.html
View File

@ -19,7 +19,7 @@
<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>
@ -90,31 +90,59 @@ Last modified: Thu Dec 17 00:06:40 GMT 1998
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!! -->

159
html/hops.html Normal file
View File

@ -0,0 +1,159 @@
<!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 &lt;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>&nbsp;</p>
<p>
<FONT COLOR="#606060"><hr></font>
<font color="#FF0000" size=-2>
Copyright &copy; 1998 by Dirk Koopman G1TLH. All Rights Reserved<br>
</font>
<font color="#000000" size=-2>$Id$</font>
</body>
</html>

3
html/index.html
View File

@ -18,7 +18,7 @@
<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.
@ -29,6 +29,7 @@ Last modified: Thu Dec 17 00:06:39 GMT 1998
<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>

76
html/install.html
View File

@ -17,7 +17,7 @@
<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,
@ -158,25 +158,76 @@ spider:x:251:sysop,g0rdi,root
</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 &lt;callsign&gt;'. Alter the default .bashrc so that it contains just one line (assuming you use the default bash shell).
<PRE>
exec /spider/perl/client.pl &lt;callsign&gt; 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 &lt;callsign&gt; 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 &lt;callsign&gt; 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
&lt;callsign&gt; 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]
@ -258,8 +309,7 @@ PC38^GB7JIM^~ &lt;- the cluster thinks this is a cluster
</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>.
@ -268,7 +318,7 @@ PC38^GB7JIM^~ &lt;- the cluster thinks this is a cluster
<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>&nbsp;</p>

11
perl/DXChannel.pm
View File

@ -34,7 +34,7 @@ use Carp;
use strict;
use vars qw(%channels %valid);
%channels = undef;
%channels = ();
%valid = (
call => '0,Callsign',
@ -49,7 +49,7 @@ use vars qw(%channels %valid);
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',
@ -87,6 +87,7 @@ sub alloc
$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;
}
@ -130,21 +131,21 @@ sub del
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

3
perl/DXCluster.pm
View File

@ -225,6 +225,7 @@ sub new
$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;
@ -266,7 +267,7 @@ sub update_users
} else {
$self->{users} = $count;
}
$users += $self->{users};
$users += $self->{users} if $self->{users};
$maxusers = $users+$nodes if $users+$nodes > $maxusers;
}

29
perl/DXCommandmode.pm
View File

@ -39,7 +39,7 @@ $errstr = (); # error string from eval
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;
}
@ -237,16 +237,16 @@ sub run_cmd
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);
}
}
}
@ -293,14 +293,14 @@ sub broadcast
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
}
}
@ -333,7 +333,7 @@ sub search
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);
@ -369,6 +369,7 @@ sub search
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");

2
perl/DXCron.pm
View File

@ -25,7 +25,7 @@ $lasttime = 0;
my $fn = "$main::cmd/crontab";
my $localfn = "$main::local_cmd/crontab";
my $localfn = "$main::localcmd/crontab";
# cron initialisation / reading in cronjobs
sub init

3
perl/DXDebug.pm
View File

@ -64,7 +64,8 @@ sub dbglist
sub isdbg
{
return $dbglevel{shift};
my $s = shift;
return $dbglevel{$s};
}
1;
__END__

18
perl/DXLog.pm
View File

@ -50,7 +50,7 @@ sub new
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};
@ -71,8 +71,8 @@ sub open
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;
@ -93,9 +93,9 @@ sub open
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}, @_);
@ -105,9 +105,9 @@ sub openprev
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}, @_);
@ -118,9 +118,9 @@ sub unixtoj
{
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";

20
perl/DXMsg.pm
View File

@ -50,7 +50,7 @@ $last_clean = 0; # last time we did a clean
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',
@ -73,7 +73,7 @@ sub alloc
$self->{private} = shift;
$self->{subject} = shift;
$self->{origin} = shift;
$self->{read} = shift;
$self->{'read'} = shift;
$self->{rrreq} = shift;
$self->{gotit} = [];
@ -201,11 +201,11 @@ sub process
}
}
$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;
}
@ -224,7 +224,7 @@ sub process
} else {
$self->send(DXProt::pc42($f[2], $f[1], $f[3])); # unknown stream
}
queue_msg();
queue_msg(0);
last SWITCH;
}
@ -328,7 +328,7 @@ sub store
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;
@ -484,20 +484,20 @@ sub queue_msg
# 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
@ -719,7 +719,7 @@ sub do_send_stuff
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";

138
perl/DXProt.pm
View File

@ -24,7 +24,7 @@ use DXProtout;
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
@ -33,13 +33,18 @@ $pc11_dup_age = 24*3600; # the maximum time to keep the dup list for
$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
}
@ -50,7 +55,7 @@ sub init
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;
}
@ -99,6 +104,7 @@ sub normal
# process PC frames
my ($pcno) = $field[0] =~ /^PC(\d\d)/; # just get the number
return unless $pcno;
return if $pcno < 10 || $pcno > 51;
SWITCH: {
@ -282,7 +288,7 @@ sub normal
}
# queue up any messages
DXMsg::queue_msg() if $self->state eq 'normal';
DXMsg::queue_msg(0) if $self->state eq 'normal';
last SWITCH;
}
@ -292,7 +298,7 @@ sub normal
$self->state('normal');
# queue mail
DXMsg::queue_msg();
DXMsg::queue_msg(0);
return;
}
@ -309,7 +315,7 @@ sub normal
$self->state('normal');
# queue mail
DXMsg::queue_msg();
DXMsg::queue_msg(0);
return;
}
@ -467,13 +473,8 @@ sub normal
# 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
}
}
@ -484,16 +485,17 @@ sub normal
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);
}
}
@ -560,12 +562,21 @@ sub send_local_config
@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;
}
}
}
@ -581,14 +592,11 @@ sub route
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
}
}
}
@ -598,12 +606,14 @@ sub broadcast_ak1a
{
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;
}
}
@ -612,13 +622,13 @@ sub broadcast_users
{
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
}
}
@ -626,10 +636,10 @@ sub broadcast_users
sub broadcast_list
{
my $s = shift;
my $chan;
my $dxchan;
foreach $chan (@_) {
$chan->send($s); # send it
foreach $dxchan (@_) {
$dxchan->send($s); # send it
}
}
@ -683,6 +693,50 @@ sub get_hops
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
{

8
perl/DXUser.pm
View File

@ -18,7 +18,7 @@ use Carp;
use strict;
use vars qw(%u $dbm $filename %valid);
%u = undef;
%u = ();
$dbm = undef;
$filename = undef;
@ -36,7 +36,7 @@ $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',
@ -106,7 +106,7 @@ sub new
my $self = {};
$self->{call} = $call;
$self->{sort} = 'U';
$self->{'sort'} = 'U';
$self->{dxok} = 1;
$self->{annok} = 1;
$self->{lang} = $main::lang;
@ -272,7 +272,7 @@ sub field_prompt
sub sort
{
my $self = shift;
@_ ? $self->{sort} = shift : $self->{sort} ;
@_ ? $self->{'sort'} = shift : $self->{'sort'} ;
}
1;
__END__

4
perl/DXUtil.pm
View File

@ -148,11 +148,9 @@ sub print_all_fields
{
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}) {

2
perl/DXVars.pm
View File

@ -18,7 +18,7 @@ require Exporter;
$def_hopcount $data $system $cmd
$userfn $motd $local_cmd $mybbsaddr
$lang
$pc50_interval, $user_interval
$pc50_interval $user_interval
);

1
perl/Messages
View File

@ -56,6 +56,7 @@ package DXM;
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]\"',

6
perl/Prefix.pm
View File

@ -17,9 +17,9 @@ use Carp;
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
{

4
perl/cluster.pl
View File

@ -110,7 +110,7 @@ sub rec
# 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 {
@ -149,7 +149,7 @@ sub cease
{
my $dxchan;
foreach $dxchan (DXChannel->get_all()) {
disconnect($dxchan);
disconnect($dxchan) unless $dxchan == $DXProt::me;
}
Log('cluster', "DXSpider V$version stopped");
exit(0);