Connecting to other Clusters

From 69c8aeb338cc485103e289fbab7ec4e7e056ed20 Mon Sep 17 00:00:00 2001 From: djk Date: Sun, 20 Dec 1998 01:58:04 +0000 Subject: [PATCH] 1. Fixed problems with sh/rcmd (talk/ann/log) with a callsign as argument and also made what G0RDI wanted work as well! 2. Added isolate flag to allow isolation of different networks at a gateway. 3. Changed make Makefile.PL to perl Makefile.PL in instructions 4. Copied latest instructions to html directory 5. Had another attempt at making clients disconnect without hanging everytime. 6. Changed msg queuing semantics so that the system routes on exact callsign. 7. Changed the protocol version so that it increments with the DXSpider version. --- Changes | 9 + cmd/Commands_en.hlp | 33 +++- cmd/create/node.pl | 0 cmd/create/user.pl | 0 cmd/delete/node.pl | 0 cmd/show/announce.pl | 9 +- cmd/show/log.pl | 9 +- cmd/show/rcmd.pl | 9 +- cmd/show/talk.pl | 9 +- connect/gb7tlh | 16 +- html/connect.html | 58 ++++--- html/cpan.html | 36 ++-- html/index.html | 33 +++- html/install.html | 382 +++++++++++++++++++++++++------------------ perl/DXChannel.pm | 245 +++++++++++++-------------- perl/DXLogPrint.pm | 6 +- perl/DXMsg.pm | 5 +- perl/DXProt.pm | 26 +-- perl/DXProtVars.pm | 2 +- perl/DXProtout.pm | 206 +++++++++++------------ perl/DXUser.pm | 1 + perl/DXUtil.pm | 148 ++++++++--------- perl/cluster.pl | 2 +- 23 files changed, 707 insertions(+), 537 deletions(-) delete mode 100644 cmd/create/node.pl delete mode 100644 cmd/create/user.pl delete mode 100644 cmd/delete/node.pl diff --git a/Changes b/Changes index d8b126bd..35fa1d84 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,12 @@ +19Dec98======================================================================== +1. Fixed problems with sh/rcmd (talk/ann/log) with a callsign as argument and +also made what G0RDI wanted work as well! +2. Added isolate flag to allow isolation of different networks at a gateway. +3. Changed make Makefile.PL to perl Makefile.PL in instructions +4. Copied latest instructions to html directory +5. Had another attempt at making clients disconnect without hanging everytime. +6. Changed msg queuing semantics so that the system routes on exact callsign. +7. Changed the protocol version so that it increments with the DXSpider version. 14Dec98======================================================================== 1. Made the telnet thing work a bit better. It still will not work reliably to a real telnetd on port 23. diff --git a/cmd/Commands_en.hlp b/cmd/Commands_en.hlp index 48b2704d..80f2765a 100644 --- a/cmd/Commands_en.hlp +++ b/cmd/Commands_en.hlp @@ -139,6 +139,13 @@ this command. You can remove more than one message at a time. === 5^KILL-^ As a sysop you can kill any message on the system. +=== 8^PC ^Send arbitrary text to a connected callsign +Send any text you like to the callsign requested. This is used mainly to send +PC protocol to connected nodes either for testing or to unstick things. + +You can also use in the same way as a talk command to a connected user but +without any processing, added of "from to ^Find out the delays an a circuit to another node This command will enable sysops to determine the speed of an inter-cluster node. @@ -220,6 +227,16 @@ to you will normally find their way there should you not be connected. eg:- SET/HOMENODE gb7djk +=== 9^SET/ISOLATE^Isolate a node from the rest of the network +Connect a node to your system in such a way that you are a full protocol +member of its network and can see all spots on it, but nothing either leaks +out from it nor goes back into from the rest of the nodes connected to you. + +You can potentially connect several nodes in this way. + +=== 9^UNSET/ISOLATE^Stop Isolation of a node from the rest of the network +Remove isolation from a node - SET/ISOLATE + === 0^SET/LOCATION ^Set your latitude and longitude In order to get accurate headings and such like you must tell the system what your latitude and longitude is. If you have not yet done a SET/QRA @@ -329,6 +346,18 @@ Display the most recent WWV information that has been received by the system === 5^SHUTDOWN^Shutdown the cluster Shutdown the cluster and disconnect all the users +=== 5^STAT/CHANNEL []^Show the status of a channel on the cluster +Show the internal status of the channel object either for the channel that +you are on or else for the callsign that you asked for. + +Only the fields that are defined (in perl term) will be displayed. + +=== 5^STAT/USER []^Show the full status of a user +Shows the full contents of a user record including all the secret flags +and stuff. + +Only the fields that are defined (in perl term) will be displayed. + === 0^TALK ^Send a text message to another station === 0^TALK > ^Send a text message to another station via a node Send a short message to any other station that is visible on the cluster @@ -337,9 +366,9 @@ command, they don't have to be connected locally. The second form of TALK is used when other cluster nodes are connected with restricted information. This usually means that they don't send -the user information usually associated with loging on and off the cluster. +the user information usually associated with logging on and off the cluster. -If you know that G3JNB is likly to be present on GB7TLH, but you can only +If you know that G3JNB is likely to be present on GB7TLH, but you can only see GB7TLH in the SH/C list but with no users, then you would use the second form of the talk message. diff --git a/cmd/create/node.pl b/cmd/create/node.pl deleted file mode 100644 index e69de29b..00000000 diff --git a/cmd/create/user.pl b/cmd/create/user.pl deleted file mode 100644 index e69de29b..00000000 diff --git a/cmd/delete/node.pl b/cmd/delete/node.pl deleted file mode 100644 index e69de29b..00000000 diff --git a/cmd/show/announce.pl b/cmd/show/announce.pl index 89d87192..71b046d0 100644 --- a/cmd/show/announce.pl +++ b/cmd/show/announce.pl @@ -13,7 +13,7 @@ my $cmdline = shift; my @f = split /\s+/, $cmdline; my $f; my @out; -my ($from, $to); +my ($from, $to, $who); $from = 0; while ($f = shift @f) { # next field @@ -26,9 +26,12 @@ while ($f = shift @f) { # next field ($to) = $f =~ /^(\d+)$/o if !$to; # is it a to count? next if $to; } + next if $who; + ($who) = $f =~ /^(\w+)/o; } -$to = 20 if !$to; +$to = 20 unless $to; +$from = 0 unless $from; -@out = DXLog::print($from, $to, $main::systime, '^ann'); +@out = DXLog::print($from, $to, $main::systime, '^ann', $who); return (1, @out); diff --git a/cmd/show/log.pl b/cmd/show/log.pl index 63326b7b..106bfd47 100644 --- a/cmd/show/log.pl +++ b/cmd/show/log.pl @@ -13,7 +13,7 @@ my $cmdline = shift; my @f = split /\s+/, $cmdline; my $f; my @out; -my ($from, $to); +my ($from, $to, $who); $from = 0; while ($f = shift @f) { # next field @@ -26,9 +26,12 @@ while ($f = shift @f) { # next field ($to) = $f =~ /^(\d+)$/o if !$to; # is it a to count? next if $to; } + next if $who; + ($who) = $f =~ /^(\w+)/o; } -$to = 20 if !$to; +$to = 20 unless $to; +$from = 0 unless $from; -@out = DXLog::print($from, $to, $main::systime); +@out = DXLog::print($from, $to, $main::systime, undef, $who); return (1, @out); diff --git a/cmd/show/rcmd.pl b/cmd/show/rcmd.pl index deff4d33..bc3a71f9 100644 --- a/cmd/show/rcmd.pl +++ b/cmd/show/rcmd.pl @@ -13,7 +13,7 @@ my $cmdline = shift; my @f = split /\s+/, $cmdline; my $f; my @out; -my ($from, $to); +my ($from, $to, $who); $from = 0; while ($f = shift @f) { # next field @@ -26,9 +26,12 @@ while ($f = shift @f) { # next field ($to) = $f =~ /^(\d+)$/o if !$to; # is it a to count? next if $to; } + next if $who; + ($who) = $f =~ /^(\w+)/o; } -$to = 20 if !$to; +$to = 20 unless $to; +$from = 0 unless $from; -@out = DXLog::print($from, $to, $main::systime, '^rcmd'); +@out = DXLog::print($from, $to, $main::systime, '^rcmd', $who); return (1, @out); diff --git a/cmd/show/talk.pl b/cmd/show/talk.pl index 612f2b08..f30d95ec 100644 --- a/cmd/show/talk.pl +++ b/cmd/show/talk.pl @@ -13,7 +13,7 @@ my $cmdline = shift; my @f = split /\s+/, $cmdline; my $f; my @out; -my ($from, $to); +my ($from, $to, $who); $from = 0; while ($f = shift @f) { # next field @@ -26,9 +26,12 @@ while ($f = shift @f) { # next field ($to) = $f =~ /^(\d+)$/o if !$to; # is it a to count? next if $to; } + next if $who; + ($who) = $f =~ /^(\w+)/o; } -$to = 20 if !$to; +$to = 20 unless $to; +$from = 0 unless $from; -@out = DXLog::print($from, $to, $main::systime, '^talk'); +@out = DXLog::print($from, $to, $main::systime, '^talk', $who); return (1, @out); diff --git a/connect/gb7tlh b/connect/gb7tlh index a2834ab4..3918effc 100644 --- a/connect/gb7tlh +++ b/connect/gb7tlh @@ -1,11 +1,7 @@ timeout 15 -# don't forget to chmod 4775 netrom_call! -#connect ax25 /usr/sbin/netrom_call bbs gb7djk g1tlh -#'Connect' '' -#'Connect' 'cluster' -#'Connect' -#client gb7tlh ax25 -connect telnet dirk1 -'login' 'djk' -'word' 'b390vpw' -'last' + don't forget to chmod 4775 netrom_call! +connect ax25 /usr/sbin/netrom_call bbs gb7djk g1tlh-0 +'Connect' '' +'Connect' 'cluster' +'Connect' +client gb7tlh ax25 diff --git a/html/connect.html b/html/connect.html index ebc9ce88..cb349e6c 100644 --- a/html/connect.html +++ b/html/connect.html @@ -2,25 +2,32 @@ Connecting to other Clusters + + + - -

Connecting to other Clusters

- -

Dirk Koopman G1TLH

+ + +

Connecting to other Clusters

+ + + +

Dirk Koopman G1TLH

- - -Last modified: Mon Dec 14 00:29:00 GMT 1998 + + +Last modified: Thu Dec 17 00:06:40 GMT 1998

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 installation instructions. However, in order to connect outwards, you will need to create connect scripts. - +

Connect scripts live in the /spider/connect directory and are simple ascii scripts that are written using a normal editor. There are a couple of examples in the issue directory. - +

Here are a couple of basic types, first a telnet connection:-

     timeout 15
@@ -28,7 +35,7 @@ Last modified: Mon Dec 14 00:29:00 GMT 1998
     connect telnet dirkl.tobit.co.uk
     'login' 'gb7djk'
     'word' 'gb7djk'
-    client /usr/bin/perl /spider/perl/client.pl gb7djk-1 telnet
+    client gb7djk-1 telnet

and an ax25 example:-

@@ -40,17 +47,17 @@ Last modified: Mon Dec 14 00:29:00 GMT 1998
     'Connect' 'c np7'
     'Connect' 'c gb7dxm'
     'Connect' ''
-    client /usr/bin/perl /spider/perl/client.pl gb7dxm ax25
+    client gb7dxm ax25

- +

A connection is started manually by typing in connect on a sysop enabled client.pl session. For example:-

     G1TLH de GB7DJK 13-Dec-1998 2041Z > connect gb7djk-1
     connection to GB7DJK-1 started
     G1TLH de GB7DJK 13-Dec-1998 2043Z > 
-

- + +

You can watch the progress of the connection (if you have the standard debugging enabled) on the cluster.pl screen and you should see something like this:-

@@ -81,8 +88,8 @@ Last modified: Mon Dec 14 00:29:00 GMT 1998
     <- D GB7DJK-1 PC38^GB7DJK-1^~
     <- D GB7DJK-1 PC18^ 1 nodes, 0 local / 1 total users  Max users 0  Uptime 0 00:00^5447^~
     etc
-

- + +

The connect scripts consist of lines which start with the following keywords or symbols:-

# All lines starting with a # are ignored, as are wholly blank lines. @@ -104,10 +111,19 @@ Last modified: Mon Dec 14 00:29:00 GMT 1998
When the left hand string has found what it is looking (if it is) then the right hand string is sent to the connection.
This process is repeated for every line of chat script. -
client starts the client program and should be exactly as you would want it with an incoming - connection. +
client 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 other which actually + connects to GB7DJK-1 [instead of a script called gb7djk-1]).

$Id$

+ + +

+ + Copyright © 1998 by Dirk Koopman G1TLH. All Rights Reserved
+ + $Id$ diff --git a/html/cpan.html b/html/cpan.html index e6f46c6a..9e9a0064 100644 --- a/html/cpan.html +++ b/html/cpan.html @@ -1,15 +1,23 @@ - - CPAN and perl installation + Installing CPAN + + + - -

CPAN and perl installation

- - -Last modified: Wed Dec 2 19:46:03 GMT 1998 + + + +

Installing CPAN

+ + +

Dirk Koopman G1TLH

+ + +Last modified: Thu Dec 17 00:06:40 GMT 1998

I have captured a typical CPAN load here for your information. The details may be slightly @@ -797,7 +805,13 @@ Appending installation info to /usr/lib/perl5/i386-linux/5.00404/perllocal.pod cpan> q Lockfile removed. -

Version: $Id$

+ +

+ + Copyright © 1998 by Dirk Koopman G1TLH. All Rights Reserved
+ + $Id$ diff --git a/html/index.html b/html/index.html index adfa769a..e3a73743 100644 --- a/html/index.html +++ b/html/index.html @@ -2,16 +2,23 @@ DXSpider + + + - -

DXSpider

+ + +

DXSpider

+ -

- - -Last modified: Sun Dec 13 22:29:57 GMT 1998 +

Dirk Koopman G1TLH

+ + +Last modified: Thu Dec 17 00:06:39 GMT 1998

The DXSpider dx cluster system is written in perl5 as an exercise in self-training for both protocol research and teaching myself perl. @@ -22,6 +29,16 @@ Last modified: Sun Dec 13 22:29:57 GMT 1998

Installation of the main cluster software.

Installing the lastest version of CPAN.

Connecting to other clusters. - +

Download the software and any patches. + + + +

+ + Copyright © 1998 by Dirk Koopman G1TLH. All Rights Reserved
+ + $Id$ diff --git a/html/install.html b/html/install.html index b375941e..74c432ce 100644 --- a/html/install.html +++ b/html/install.html @@ -1,225 +1,283 @@ + - - - -Spider-HOWTO - - - - -

Installing DX Spider on RedHat 5.1

Iain Phillips G0RDI

+ + DX Spider Installation + + + + + + + +

Installing DX Spider (on Redhat 5.1)

+ + +

Iain Phillips G0RDI

-Last modified: Mon Dec 14 00:01:40 GMT 1998 -

This HOWTO describes the installation for DX Spider v1.11 on a "vanilla" Red Hat 5.1 platform, and assumes that you have started with a clean disk, with nothing other than the standard Red Hat 5.1 distribution. I always select 'everything', and that seems to ensure that nothing is missed out :-)

In addition to the standard Red Hat distribution you will require the following CPAN modules: -

- - -

MD5-1.7.tar.gz
-Data-Dumper-2.10.tar.gz
-FreezeThaw-0.3.tar.gz
-MLDBM-2.00.ar.gz
-TimeDate-1.8.tar.gz
-IO-1.20.tar.tgz
-Net-Telnet-3.01.tar.gz
-

- -

Do get the latest versions of these packages if any of the above list -is out of date. - -

You'll also need the AX25 utility package. There is much debate about what is "best", what is "better". What works for 5.1 is this: -

- - -

ax25-utils-2.1.42a-1.i386.rpm

- - -

This can be found at (among other places) ftp://contrib.redhat.com. Note that no attempt is made within this document to describe the steps necessary to install and commission the AX25 kernel package. It remains the responsibility of the reader to have sufficient knowledge and expertise to make this part of the system operation (and to be satisfied that it is operational) before attempting to install DX Spider. Read the AX25-HOWTO and ask around if you - still have trouble after that.

The last "must have" is the DX Spider distribution itself, and this is available via: -

- - -

http://www.dxcluster.org

- - -

Copy the CPAN modules listed above to a convenient place on your computer. For no good reason, I put mine in /usr/local/packages, and the instructions which follow will assume that that's where yours are, too.

Log in as 'root', and make sure you're at '/root' before you continue. Here are exactly the commands you must issue next: -

# tar xvfz /usr/local/packages/MD5-1.7.tar.gz +Last modified: Sat Dec 19 16:10:14 GMT 1998 + +

This HOWTO describes the installation for DX Spider v1.11 on a "vanilla" + RedHat 5.1 platform, + and assumes that you have started with a clean disk, with nothing other than the standard + Red Hat 5.1 distribution. I always select 'everything', and that seems to ensure that + nothing is missed out :-) [ more normal people may like to try with less Ed ]. + +

The crucial ingredient for all of this is Perl 5.004. Now I know + Perl 5.005 is out and this will almost certainly work with it, but + RedHat 5.1 comes with 5.004. + Be Warned earlier versions of RedHat + do not come with 5.004 as standard, you need to + upgrade + +

In addition to the standard Red Hat distribution you will require the following CPAN modules: - +

+ MD5-1.7.tar.gz
+ Data-Dumper-2.10.tar.gz
+ FreezeThaw-0.3.tar.gz
+ MLDBM-2.00.ar.gz
+ TimeDate-1.8.tar.gz
+ IO-1.20.tar.tgz
+ Net-Telnet-3.01.tar.gz
+ + + +

Do get the latest versions of these packages if any of the above list + is out of date. + +

You'll also need the AX25 utility package. There is much debate about what is "best", what is "better". What works for 5.1 is this: - +

+ ax25-utils-2.1.42a-1.i386.rpm + + +

The last "must have" is the DX Spider distribution itself, and this is available via: - + +

+ The DX Spider Software + + +

We can now begin:- +

Copy the CPAN modules listed above to a convenient place on your computer. For no good reason, I put mine in /usr/local/packages, and the instructions which follow will assume that that's where yours are, too. +

Log in as 'root', and make sure you're at '/root' before you continue. Here are exactly the commands you must issue next: - +

+# tar xvfz /usr/local/packages/MD5-1.7.tar.gz
 # cd MD5-1.7
-# make Makefile.PL
+# perl Makefile.PL
 # make test
 # make install
 # cd ..
 #
 # tar xvfz /usr/local/packages/Data-Dumper-2.10.tar.gz
 # cd Data-Dumper-2.10
-# make Makefile.PL
+# perl Makefile.PL
 # make test
 # make install
 # cd ..
 #
 # tar xvfz /usr/local/packages/FreezeThaw-0.3.tar.gz
 # cd FreezeThaw-0.3
-# make Makefile.PL
+# perl Makefile.PL
 # make test
 # make install
 # cd ..
 #
 # tar xvfz /usr/local/packages/MLDBM-2.00.tar.gz
 # cd MLDBM-2.00
-# make Makefile.PL
+# perl Makefile.PL
 # make test
 # make install
 # cd ..
 #
 # tar xvfz /usr/local/packages/TimeDate-1.08.tar.gz
 # cd TimeDate-1.08
-# make Makefile.PL
+# perl Makefile.PL
 # make test
 # make install
 # cd ..
 #
 # tar xvfz /usr/local/packages/IO-1.20.tar.gz
 # cd IO-1.20
-# make Makefile.PL
+# perl Makefile.PL
 # make test
 # make install UNINST=1
 # cd ..
 #
 # tar xvfz /usr/local/packages/Net-Telnet-3.01.tar.gz
 # cd Net-Telnet-3.01.tar.gz
-# make Makefile.PL
+# perl Makefile.PL
 # make test
 # make install
 # cd ..
 #
-

Do not fall into the trap of thinking they're all the same, just because they nearly are! Pay particular attention to the instructions of IO, above.

Create a user to run the cluster under. UNDER NO CIRCUMSTANCES USE ROOT

Again: DO NOT USE root.

In the instructions which follow, it is assumed that this user is called 'sysop'. You may call it anything you wish. Depending upon your security requirements, you may choose to use an existing user. This will be your choice, not ours!

# adduser -m sysop

Now set a password for the user:-

#
+

Do not fall into the trap of thinking they're all the same, just because they nearly are! Pay particular attention to the instructions of IO, above. + +

Create a user to run the cluster under. UNDER NO CIRCUMSTANCES USE ROOT +
Again: DO NOT USE root. +
In the instructions which follow, it is assumed that this user is called 'sysop'. You may call it anything you wish. Depending upon your security requirements, you may choose to use an existing user. This will be your choice, not ours! +
# adduser -m sysop +
Now set a password for the user:- +
```
+#
 # passwd sysop
 # New UNIX password:
 # Retype new UNIX password:
-passwd: all authentication tokens updated successfully
```
-
# Do not fall into the trap of thinking they're all the same, just because they nearly are! Pay particular attention to the instructions of IO, above.
-
Now unpack the DX Spider distribution, set symbolic links and group permissions like this (assumes that the version we're interested in is 1.9. The distribution tar file may be named slightly differently in your case: -

# cd ~sysop
+passwd: all authentication tokens updated successfully
+

# Do not fall into the trap of thinking they're all the same, just because they nearly are! Pay particular attention to the instructions of IO, above. + +

Now unpack the DX Spider distribution, set symbolic links and group permissions like this (assumes that the version we're interested in is 1.9. The distribution tar file may be named slightly differently in your case: - +
```
+# cd ~sysop
 # tar xvfz spider-1.9.tar.gz
 # ln -s ~sysop/spider /spider
 # groupadd -g 251 spider       (or another number)
 # vi /etc/group                (or your favorite editor)
-
```
-
add 'sysop', your own callsign (in my case 'g0rdi' - which will be used as an alias) and 'root' to the group spider. The result should look something like:-
-
```
spider:x:251:sysop,g0rdi,root
```
-
Next step is to set permissions on the 'spider' directory tree and files:-

# chown -R sysop.spider spider
+

add 'sysop', your own callsign (in my case 'g0rdi' - which will be used as an alias) and 'root' to the group spider. The result should look something like:- +

+spider:x:251:sysop,g0rdi,root
+

Next step is to set permissions on the 'spider' directory tree and files:- +
```
+# chown -R sysop.spider spider
 # find . -type d -exec chmod 2775 {} \;
 # find . -type f -exec chmod 775 {} \;
-
```
-
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.
-
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).

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. + +

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). +
```
 exec /spider/perl/client.pl <callsign> telnet
-
```
-
Alternatively you can set up a real login for a person (or another cluster) by creating a login using:- -
```
+		
```
+
Alternatively you can set up a real login for a person (or another cluster) by creating a login using:- +
```
 # useradd gb7djk
 # passwd gb7djk
 New UNIX password: 
 Retype new UNIX password: 
 passwd: all authentication tokens updated successfully
-
```
-
and editing the /etc/passwd file to look like this (do substitute the correct callsigns here ;-):- -
```
+		
```
+
and editing the /etc/passwd file to look like this (do substitute the correct callsigns here ;-):- +
```
 fbb:x:505:505::/home/fbb:/bin/bash
 gb7djk:x:506:506::/home/gb7djk:/usr/bin/perl /spider/perl/client.pl gb7djk telnet
-
```
-
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.).
-
As mentioned earlier, for AX25 connections you 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:-

-   [ether]                                                                         
-   NOCALL   * * * * * *  L                                                         
-   default  * * * * * *  - sysop /spider/perl/client.pl client.pl %u ax25
-   <bbs>
-   NOCALL   * * * * * *  L                                                         
-   default  * * * * * *  - sysop /spider/perl/client.pl client.pl %u ax25
-

where 'ether' and 'bbs' are appropriate KNOWN WORKING axport and nrport names respectively. Obviously you can use different names, callsigns or whatever for your purposes, but it is up to you to get it to work. Note I use BPQ over ethernet which why I have the port names I have.

Find your netrom_call and ax25_call programs (which on my system live in /usr/sbin) and chmod them so that they are SUID root

   # chown root ax25_call netrom_call
-   # chmod 4775 ax25_call netrom_call

This has to be done to allow you to specify the correct callsigns on outgoing connects

Login to your computer as sysop, and create the initial DX Spider parameters necessary to start the cluster for the first time.

   $ startx			(much easier to use X)
-   $ cd /spider
-   $ mkdir local
-   $ mkdir local_cmd
-   $ cp perl/DXVars.pm local
-   $ cd local
-   $ vi DXVars.pm			(or 'joe DXVars.pm' if you're a WordStar fan ;-)
-

Using the distributed DXVars.pm as a a template, set your cluster callsign, sysop callsign and other user info to suit your own environment. Note that this a perl file which will be parsed and executed as part of the cluster. If you get it wrong then perl will complain when you start the cluster process.

PLEASE USE CAPITAL LETTERS FOR CALLSIGNS
-

DON'T alter the DXVars.pm (or any other file) in /spider/perl, they are overwritten with every release. Any files or commands you place in /spider/local or /spider/local_cmd will automagically be used in preference to the ones in /spider/perl EVEN whilst the cluster is running!

-   :x
+

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.). + +

As mentioned earlier, for AX25 connections you 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:- +
```
+[ether]                                                                         
+NOCALL   * * * * * *  L                                                         
+default  * * * * * *  - sysop /spider/perl/client.pl client.pl %u ax25
+<bbs>
+NOCALL   * * * * * *  L                                                         
+default  * * * * * *  - sysop /spider/perl/client.pl client.pl %u ax25
+		
```
+
where 'ether' and 'bbs' are appropriate KNOWN WORKING axport and nrport names respectively. Obviously you can use different names, callsigns or whatever for your purposes, but it is up to you to get it to work. Note I use BPQ over ethernet which why I have the port names I have. + +
Find your netrom_call and ax25_call programs (which on my system live in /usr/sbin) and chmod them so that they are SUID root +
```
+# chown root ax25_call netrom_call
+# chmod 4775 ax25_call netrom_call
+		
```
+
This has to be done to allow you to specify the correct callsigns on outgoing connects + +
Login to your computer as sysop, and create the initial DX Spider parameters necessary to start the cluster for the first time. +
```
+$ startx			(much easier to use X)
+$ cd /spider
+$ mkdir local
+$ mkdir local_cmd
+$ cp perl/DXVars.pm local
+$ cd local
+$ vi DXVars.pm			(or 'joe DXVars.pm' if you're a WordStar fan ;-)
+		
```
+
Using the distributed DXVars.pm as a a template, set your cluster callsign, sysop callsign and other user info to suit your own environment. Note that this a perl file which will be parsed and executed as part of the cluster. If you get it wrong then perl will complain when you start the cluster process. +
PLEASE USE CAPITAL LETTERS FOR CALLSIGNS +
DON'T alter the DXVars.pm (or any other file) in /spider/perl, they are overwritten with every release. Any files or commands you place in /spider/local or /spider/local_cmd will automagically be used in preference to the ones in /spider/perl EVEN whilst the cluster is running! +
```
+:x
    
-   $ cd ../perl
-
```
-
Next, run the following script, which will create the basic user file with you as the sysop.
-
```
-   $ create_sysop.pl
-
```
-
Now attempt to startup the cluster program and see whether all the various rivets are flying in approximate formation...
-
```
-   $ cluster.pl
-   DXSpider DX Cluster Version 1.9
-   Copyright (c) 1998 Dirk Koopman G1TLH
-   loading prefixes ...
-   loading band data ...
-   loading user file system ...
-   starting listener ...
-   reading existing message headers
-   reading cron jobs
-   orft we jolly well go ...
-
```
-
now log in again (as 'sysop') or start another rxvt or xterm

-   $ client.pl
-

at the cluster prompt (which will look something like):-

-   G1JIM de GB7JIM 12-Dec-98 1718Z >
-

-   set/node GB7XXX
-

(where 'GB7XXX' is a DX cluster which you expect to connect to or from).

Now shut the cluster down by simply typing 'shutdown' at the prompt.

The cluster and the client should both go back to prompts

The callsigns should be the sysop callsign and the cluster callsign -as per your modified DXVars.pm. You can check that the cluster -connections will work by:- -

-   $ client.pl gb7xxx      (doesn't have to be uppercase).
-   PC38^GB7JIM^~           <- the cluster thinks this is a cluster
-   ^C                      <- to get out
-

Version: $Id$

- +$ cd ../perl +

Next, run the following script, which will create the basic user file with you as the sysop. +

+$ create_sysop.pl
+

Now attempt to startup the cluster program and see whether all the various rivets are flying in approximate formation... +

+$ cluster.pl
+DXSpider DX Cluster Version 1.9
+Copyright (c) 1998 Dirk Koopman G1TLH
+loading prefixes ...
+loading band data ...
+loading user file system ...
+starting listener ...
+reading existing message headers
+reading cron jobs
+orft we jolly well go ...
+

now log in again (as 'sysop') or start another rxvt or xterm + +
```
+$ client.pl
+		
```
+
at the cluster prompt (which will look something like):- +
```
+G1JIM de GB7JIM 12-Dec-98 1718Z >
+		
```
+ Type: +
```
+set/node GB7XXX
+		
```
+
(where 'GB7XXX' is a DX cluster which you expect to connect to or from). +
Now shut the cluster down by simply typing 'shutdown' at the prompt. +
The cluster and the client should both go back to prompts +
The callsigns should be the sysop callsign and the cluster callsign + as per your modified DXVars.pm. You can check that the cluster + connections will work by:- +
```
+$ client.pl gb7xxx      (doesn't have to be uppercase).
+PC38^GB7JIM^~           <- the cluster thinks this is a cluster
+^C                      <- to get out
+		
```
+

+ +

You should now have a basic working system. Best of luck! Can I now draw your attention to + the Bug Reporting System. Some mailing lists will + be created RSN for more general discussions. + +

Can I commend to you the Announcements mailing list to which you may + subscribe. + This is a low volume mailing list which will send you announcements of new patches and + such like things as they arise. + +

If you like what you see and want to be a part of the ongoing development then + subscribe + to the support mailing list which will be the initial focus of any discussions. + + +

+ + Copyright © 1998 by Dirk Koopman G1TLH and Iain Phillips G0RDI. All Rights Reserved
+ + $Id$ + + diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 640bc4e5..c494f59b 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -37,193 +37,198 @@ use vars qw(%channels %valid); %channels = undef; %valid = ( - call => '0,Callsign', - conn => '9,Msg Conn ref', - user => '9,DXUser ref', - startt => '0,Start Time,atime', - t => '9,Time,atime', - pc50_t => '9,Last PC50 Time,atime', - priv => '9,Privilege', - state => '0,Current State', - oldstate => '5,Last State', - list => '9,Dep Chan List', - name => '0,User Name', - consort => '9,Connection Type', - sort => '9,Type of Channel', - wwv => '0,Want WWV,yesno', - talk => '0,Want Talk,yesno', - ann => '0,Want Announce,yesno', - here => '0,Here?,yesno', - confmode => '0,In Conference?,yesno', - dx => '0,DX Spots,yesno', - redirect => '0,Redirect messages to', - lang => '0,Language', - func => '9,Function', - loc => '9,Local Vars', # used by func to store local variables in - beep => '0,Want Beeps,yesno', - lastread => '9,Last Msg Read', - outbound => '9,outbound?,yesno', - remotecmd => '9,doing rcmd,yesno', - pagelth => '0,Page Length', - pagedata => '9,Page Data Store', - group => '0,Access Group,parray', # used to create a group of users/nodes for some purpose or other -); + call => '0,Callsign', + conn => '9,Msg Conn ref', + user => '9,DXUser ref', + startt => '0,Start Time,atime', + t => '9,Time,atime', + pc50_t => '9,Last PC50 Time,atime', + priv => '9,Privilege', + state => '0,Current State', + oldstate => '5,Last State', + list => '9,Dep Chan List', + name => '0,User Name', + consort => '9,Connection Type', + sort => '9,Type of Channel', + wwv => '0,Want WWV,yesno', + talk => '0,Want Talk,yesno', + ann => '0,Want Announce,yesno', + here => '0,Here?,yesno', + confmode => '0,In Conference?,yesno', + dx => '0,DX Spots,yesno', + redirect => '0,Redirect messages to', + lang => '0,Language', + func => '9,Function', + loc => '9,Local Vars', # used by func to store local variables in + beep => '0,Want Beeps,yesno', + lastread => '9,Last Msg Read', + outbound => '9,outbound?,yesno', + remotecmd => '9,doing rcmd,yesno', + pagelth => '0,Page Length', + pagedata => '9,Page Data Store', + group => '0,Access Group,parray', # used to create a group of users/nodes for some purpose or other + isolate => '9,Isolate network,yesno', + ); # create a new channel object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)] sub alloc { - my ($pkg, $call, $conn, $user) = @_; - my $self = {}; + my ($pkg, $call, $conn, $user) = @_; + my $self = {}; - die "trying to create a duplicate channel for $call" if $channels{$call}; - $self->{call} = $call; - $self->{conn} = $conn if defined $conn; # if this isn't defined then it must be a list - $self->{user} = $user if defined $user; - $self->{startt} = $self->{t} = time; - $self->{state} = 0; - $self->{oldstate} = 0; - $self->{lang} = $user->{lang} if defined $user; - $self->{lang} = $main::lang if !$self->{lang}; - $user->new_group() if !$user->group; - $self->{group} = $user->group; - bless $self, $pkg; - return $channels{$call} = $self; + die "trying to create a duplicate channel for $call" if $channels{$call}; + $self->{call} = $call; + $self->{conn} = $conn if defined $conn; # if this isn't defined then it must be a list + $self->{user} = $user if defined $user; + $self->{startt} = $self->{t} = time; + $self->{state} = 0; + $self->{oldstate} = 0; + $self->{lang} = $user->{lang} if defined $user; + $self->{lang} = $main::lang if !$self->{lang}; + $user->new_group() if !$user->group; + $self->{group} = $user->group; + bless $self, $pkg; + return $channels{$call} = $self; } # obtain a channel object by callsign [$obj = DXChannel->get($call)] sub get { - my ($pkg, $call) = @_; - return $channels{$call}; + my ($pkg, $call) = @_; + return $channels{$call}; } # obtain all the channel objects sub get_all { - my ($pkg) = @_; - return values(%channels); + my ($pkg) = @_; + return values(%channels); } # obtain a channel object by searching for its connection reference sub get_by_cnum { - my ($pkg, $conn) = @_; - my $self; + my ($pkg, $conn) = @_; + my $self; - foreach $self (values(%channels)) { - return $self if ($self->{conn} == $conn); - } - return undef; + foreach $self (values(%channels)) { + return $self if ($self->{conn} == $conn); + } + return undef; } # get rid of a channel object [$obj->del()] sub del { - my $self = shift; - $self->{group} = undef; # belt and braces - delete $channels{$self->{call}}; + my $self = shift; + + $self->{group} = undef; # belt and braces + delete $channels{$self->{call}}; } # is it an ak1a cluster ? sub is_ak1a { - my $self = shift; - return $self->{sort} eq 'A'; + my $self = shift; + return $self->{sort} eq 'A'; } # is it a user? sub is_user { - my $self = shift; - return $self->{sort} eq 'U'; + my $self = shift; + return $self->{sort} eq 'U'; } # is it a connect type sub is_connect { - my $self = shift; - return $self->{sort} eq 'C'; + my $self = shift; + return $self->{sort} eq 'C'; } # handle out going messages, immediately without waiting for the select to drop # this could, in theory, block sub send_now { - my $self = shift; - my $conn = $self->{conn}; - my $sort = shift; - my $call = $self->{call}; - my $line; + my $self = shift; + my $conn = $self->{conn}; + my $sort = shift; + my $call = $self->{call}; + my $line; - foreach $line (@_) { - chomp $line; - $conn->send_now("$sort$call|$line") if $conn; - dbg('chan', "-> $sort $call $line") if $conn; - } - $self->{t} = time; + foreach $line (@_) { + chomp $line; + $conn->send_now("$sort$call|$line") if $conn; + dbg('chan', "-> $sort $call $line") if $conn; + } + $self->{t} = time; } # # the normal output routine # -sub send # this is always later and always data +sub send # this is always later and always data { - my $self = shift; - my $conn = $self->{conn}; - my $call = $self->{call}; - my $line; + my $self = shift; + my $conn = $self->{conn}; + my $call = $self->{call}; + my $line; - foreach $line (@_) { - chomp $line; - $conn->send_later("D$call|$line") if $conn; - dbg('chan', "-> D $call $line") if $conn; - } - $self->{t} = time; + foreach $line (@_) { + chomp $line; + $conn->send_later("D$call|$line") if $conn; + dbg('chan', "-> D $call $line") if $conn; + } + $self->{t} = time; } # send a file (always later) sub send_file { - my ($self, $fn) = @_; - my $call = $self->{call}; - my $conn = $self->{conn}; - my @buf; + my ($self, $fn) = @_; + my $call = $self->{call}; + my $conn = $self->{conn}; + my @buf; - open(F, $fn) or die "can't open $fn for sending file ($!)"; - @buf = ; - close(F); - $self->send(@buf); + open(F, $fn) or die "can't open $fn for sending file ($!)"; + @buf = ; + close(F); + $self->send(@buf); } # this will implement language independence (in time) sub msg { - my $self = shift; - return DXM::msg($self->{lang}, @_); + my $self = shift; + return DXM::msg($self->{lang}, @_); } # change the state of the channel - lots of scope for debugging here :-) sub state { - my $self = shift; - if (@_) { - $self->{oldstate} = $self->{state}; - $self->{state} = shift; - dbg('state', "$self->{call} channel func $self->{func} state $self->{oldstate} -> $self->{state}\n"); - } - return $self->{state}; + my $self = shift; + if (@_) { + $self->{oldstate} = $self->{state}; + $self->{state} = shift; + dbg('state', "$self->{call} channel func $self->{func} state $self->{oldstate} -> $self->{state}\n"); + } + return $self->{state}; } # disconnect this channel sub disconnect { - my $self = shift; - my $user = $self->{user}; - my $conn = $self->{conn}; - $self->finish(); - $user->close() if defined $user; - $conn->disconnect() if defined $conn; - $self->del(); + my $self = shift; + my $user = $self->{user}; + my $conn = $self->{conn}; + my $call = $self->{call}; + + $self->finish(); + $conn->send_now("Z$call|bye") if $conn; # this will cause 'client' to disconnect + $user->close() if defined $user; + $conn->disconnect() if $conn; + $self->del(); } # various access routines @@ -234,7 +239,7 @@ sub disconnect sub fields { - return keys(%valid); + return keys(%valid); } # @@ -243,20 +248,20 @@ sub fields sub field_prompt { - my ($self, $ele) = @_; - return $valid{$ele}; + my ($self, $ele) = @_; + return $valid{$ele}; } no strict; sub AUTOLOAD { - my $self = shift; - my $name = $AUTOLOAD; - return if $name =~ /::DESTROY$/; - $name =~ s/.*:://o; + my $self = shift; + my $name = $AUTOLOAD; + return if $name =~ /::DESTROY$/; + $name =~ s/.*:://o; - confess "Non-existant field '$AUTOLOAD'" if !$valid{$name}; - @_ ? $self->{$name} = shift : $self->{$name} ; + confess "Non-existant field '$AUTOLOAD'" if !$valid{$name}; + @_ ? $self->{$name} = shift : $self->{$name} ; } 1; diff --git a/perl/DXLogPrint.pm b/perl/DXLogPrint.pm index 54cfc516..8a12b05c 100644 --- a/perl/DXLogPrint.pm +++ b/perl/DXLogPrint.pm @@ -30,13 +30,17 @@ sub print my $to = shift; my @date = $self->unixtoj(shift); my $pattern = shift; + my $who = uc shift; my $search; my @in; my @out; my $eval; my $count; - $search = $pattern ? "\$ref->[1] =~ /$pattern/" : '1' ; + $search = '1' unless $pattern || $who; + $search = "\$ref->[1] =~ /$pattern/" if $pattern; + $search .= ' && ' if $pattern && $who; + $search .= "(\$ref->[2] =~ /$who/ || \$ref->[3] =~ /$who/)" if $who; $eval = qq( my \$c; my \$ref; diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index c4d895b2..63710e4b 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -477,10 +477,10 @@ sub queue_msg { my $sort = shift; my $call = shift; - my @nodelist = DXProt::get_all_ak1a(); my $ref; my $clref; my $dxchan; + my @nodelist = DXProt::get_all_ak1a(); # bat down the message list looking for one that needs to go off site and whose # nearest node is not busy. @@ -491,7 +491,7 @@ sub queue_msg # in my cluster node list offsite? if ($ref->{private}) { if ($ref->{read} == 0) { - $clref = DXCluster->get($ref->{to}); + $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'; @@ -505,6 +505,7 @@ sub queue_msg my $noderef; foreach $noderef (@nodelist) { next if $noderef->call eq $main::mycall; + next if $noderef->isolate; # maybe add code for stuff originated here? next if grep { $_ eq $noderef->call } @{$ref->{gotit}}; # if we are here we have a node that doesn't have this message diff --git a/perl/DXProt.pm b/perl/DXProt.pm index f50b1e14..f3612791 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -37,6 +37,7 @@ $last_hour = time; # last time I did an hourly periodic update sub init { my $user = DXUser->get($main::mycall); + $DXProt::myprot_version += $main::version*100; $me = DXProt->new($main::mycall, undef, $user); $me->{here} = 1; # $me->{sort} = 'M'; # M for me @@ -67,6 +68,7 @@ sub start $self->{outbound} = $sort eq 'O'; $self->{priv} = $user->priv; $self->{lang} = $user->lang; + $self->{isolate} = $user->{isolate}; $self->{consort} = $line; # save the connection type $self->{here} = 1; @@ -280,7 +282,7 @@ sub normal } # queue up any messages - DXMsg::queue_msg() if $self->state eq 'normal'; + DXMsg::queue_msg() if $self->state eq 'normal'; last SWITCH; } @@ -465,8 +467,8 @@ sub normal # REBROADCAST!!!! # - my $hops; - if (($hops) = $line =~ /H(\d+)\^\~?$/o) { + 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 @@ -526,7 +528,7 @@ sub finish foreach $node (@gonenodes) { next if $node->call eq $call; - broadcast_ak1a(pc21($node->call, 'Gone'), $self); # done like this 'cos DXNodes don't have a pc21 method + broadcast_ak1a(pc21($node->call, 'Gone'), $self) unless $self->{isolate}; # done like this 'cos DXNodes don't have a pc21 method $node->del(); } @@ -548,12 +550,16 @@ sub send_local_config { my $self = shift; my $n; + my @nodes; # send our nodes - my @nodes = DXNode::get_all(); - - # create a list of all the nodes that are not connected to this connection - @nodes = grep { $_->dxchan != $self } @nodes; + if ($self->{isolate}) { + @nodes = (DXCluster->get_exact($main::mycall)); + } else { + # create a list of all the nodes that are not connected to this connection + @nodes = DXNode::get_all(); + @nodes = grep { $_->dxchan != $self } @nodes; + } $self->send($me->pc19(@nodes)); # get all the users connected on the above nodes and send them out @@ -597,7 +603,7 @@ sub broadcast_ak1a foreach $chan (@chan) { next if grep $chan == $_, @except; - $chan->send($s); # send it if it isn't the except list + $chan->send($s) unless $chan->{isolate}; # send it if it isn't the except list } } @@ -612,7 +618,7 @@ sub broadcast_users 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 + $chan->send($s); # send it if it isn't the except list or hasn't a passout flag } } diff --git a/perl/DXProtVars.pm b/perl/DXProtVars.pm index dcd51d61..da3a68b5 100644 --- a/perl/DXProtVars.pm +++ b/perl/DXProtVars.pm @@ -21,7 +21,7 @@ $pc19_max_nodes = 5; $pc50_interval = 14*60; # the version of DX cluster (tm) software I am masquerading as -$myprot_version = "5447"; +$myprot_version = 5300; # default hopcount to use $def_hopcount = 15; diff --git a/perl/DXProtout.pm b/perl/DXProtout.pm index a5d5250b..9a782960 100644 --- a/perl/DXProtout.pm +++ b/perl/DXProtout.pm @@ -26,34 +26,34 @@ use strict; # create a talk string ($from, $to, $via, $text) sub pc10 { - my ($from, $to, $via, $text) = @_; - my $user2 = $via ? $to : ' '; - my $user1 = $via ? $via : $to; - $text = unpad($text); - $text = ' ' if !$text; - return "PC10^$from^$user1^$text^*^$user2^$main::mycall^~"; + my ($from, $to, $via, $text) = @_; + my $user2 = $via ? $to : ' '; + my $user1 = $via ? $via : $to; + $text = unpad($text); + $text = ' ' if !$text; + return "PC10^$from^$user1^$text^*^$user2^$main::mycall^~"; } # create a dx message (call, freq, dxcall, text) sub pc11 { - my ($mycall, $freq, $dxcall, $text) = @_; - my $hops = get_hops(11); - my $t = time; - $text = ' ' if !$text; - return sprintf "PC11^%.1f^$dxcall^%s^%s^$text^$mycall^$hops^~", $freq, cldate($t), ztime($t); + my ($mycall, $freq, $dxcall, $text) = @_; + my $hops = get_hops(11); + my $t = time; + $text = ' ' if !$text; + return sprintf "PC11^%.1f^$dxcall^%s^%s^$text^$mycall^$hops^~", $freq, cldate($t), ztime($t); } # create an announce message sub pc12 { - my ($call, $text, $tonode, $sysop, $wx) = @_; - my $hops = get_hops(12); - $sysop = ' ' if !$sysop; - $text = ' ' if !$text; - $wx = '0' if !$wx; - $tonode = '*' if !$tonode; - return "PC12^$call^$tonode^$text^$sysop^$main::mycall^$wx^$hops^~"; + my ($call, $text, $tonode, $sysop, $wx) = @_; + my $hops = get_hops(12); + $sysop = ' ' if !$sysop; + $text = ' ' if !$text; + $wx = '0' if !$wx; + $tonode = '*' if !$tonode; + return "PC12^$call^$tonode^$text^$sysop^$main::mycall^$wx^$hops^~"; } # @@ -65,29 +65,29 @@ sub pc12 # sub pc16 { - my $self = shift; - my @out; + my $self = shift; + my @out; - foreach (@_) { - my $str = "PC16^$self->{call}"; - my $i; + foreach (@_) { + my $str = "PC16^$self->{call}"; + my $i; - for ($i = 0; @_ > 0 && $i < $DXProt::pc16_max_users; $i++) { - my $ref = shift; - $str .= sprintf "^%s %s %d", $ref->call, $ref->confmode ? '*' : '-', $ref->here; + for ($i = 0; @_ > 0 && $i < $DXProt::pc16_max_users; $i++) { + my $ref = shift; + $str .= sprintf "^%s %s %d", $ref->call, $ref->confmode ? '*' : '-', $ref->here; + } + $str .= sprintf "^%s^", get_hops(16); + push @out, $str; } - $str .= sprintf "^%s^", get_hops(16); - push @out, $str; - } - return (@out); + return (@out); } # remove a local user sub pc17 { - my ($self, $ref) = @_; - my $hops = get_hops(17); - return "PC17^$ref->{call}^$self->{call}^$hops^"; + my ($self, $ref) = @_; + my $hops = get_hops(17); + return "PC17^$ref->{call}^$self->{call}^$hops^"; } # Request init string @@ -102,102 +102,102 @@ sub pc18 # sub pc19 { - my $self = shift; - my @out; + my $self = shift; + my @out; - while (@_) { - my $str = "PC19"; - my $i; + while (@_) { + my $str = "PC19"; + my $i; - for ($i = 0; @_ && $i < $DXProt::pc19_max_nodes; $i++) { - my $ref = shift; - my $here = $ref->{here} ? '1' : '0'; - my $confmode = $ref->{confmode} ? '1' : '0'; - $str .= "^$here^$ref->{call}^$confmode^$ref->{pcversion}"; + for ($i = 0; @_ && $i < $DXProt::pc19_max_nodes; $i++) { + my $ref = shift; + my $here = $ref->{here} ? '1' : '0'; + my $confmode = $ref->{confmode} ? '1' : '0'; + $str .= "^$here^$ref->{call}^$confmode^$ref->{pcversion}"; + } + $str .= sprintf "^%s^", get_hops(19); + push @out, $str; } - $str .= sprintf "^%s^", get_hops(19); - push @out, $str; - } - return @out; + return @out; } # end of Rinit phase sub pc20 { - return 'PC20^'; + return 'PC20^'; } # delete a node sub pc21 { - my ($call, $reason) = @_; - my $hops = get_hops(21); - $reason = "Gone." if !$reason; - return "PC21^$call^$reason^$hops^"; + my ($call, $reason) = @_; + my $hops = get_hops(21); + $reason = "Gone." if !$reason; + return "PC21^$call^$reason^$hops^"; } # end of init phase sub pc22 { - return 'PC22^'; + return 'PC22^'; } # here status sub pc24 { - my $self = shift; - my $call = $self->call; - my $flag = $self->here ? '1' : '0'; - my $hops = get_hops(24); + my $self = shift; + my $call = $self->call; + my $flag = $self->here ? '1' : '0'; + my $hops = get_hops(24); - return "PC24^$call^$flag^$hops^"; + return "PC24^$call^$flag^$hops^"; } # message start (fromnode, tonode, to, from, t, private, subject, origin) sub pc28 { - my ($tonode, $fromnode, $to, $from, $t, $private, $subject, $origin, $rr) = @_; - my $date = cldate($t); - my $time = ztime($t); - $private = $private ? '1' : '0'; - $rr = $rr ? '1' : '0'; - return "PC28^$tonode^$fromnode^$to^$from^$date^$time^$private^$subject^ ^5^$rr^ ^$origin^~"; + my ($tonode, $fromnode, $to, $from, $t, $private, $subject, $origin, $rr) = @_; + my $date = cldate($t); + my $time = ztime($t); + $private = $private ? '1' : '0'; + $rr = $rr ? '1' : '0'; + return "PC28^$tonode^$fromnode^$to^$from^$date^$time^$private^$subject^ ^5^$rr^ ^$origin^~"; } # message text (from and to node same way round as pc29) sub pc29 { - my ($fromnode, $tonode, $stream, $text) = @_; - $text =~ s/\^//og; # remove ^ - return "PC29^$fromnode^$tonode^$stream^$text^~"; + my ($fromnode, $tonode, $stream, $text) = @_; + $text =~ s/\^//og; # remove ^ + return "PC29^$fromnode^$tonode^$stream^$text^~"; } # subject acknowledge (will have to and from node reversed to pc28) sub pc30 { - my ($fromnode, $tonode, $stream) = @_; - return "PC30^$fromnode^$tonode^$stream^"; + my ($fromnode, $tonode, $stream) = @_; + return "PC30^$fromnode^$tonode^$stream^"; } # acknowledge this tranche of lines (to and from nodes reversed to pc29 and pc28 sub pc31 { - my ($fromnode, $tonode, $stream) = @_; - return "PC31^$fromnode^$tonode^$stream^"; + my ($fromnode, $tonode, $stream) = @_; + return "PC31^$fromnode^$tonode^$stream^"; } # end of message from the sending end (pc28 node order) sub pc32 { - my ($fromnode, $tonode, $stream) = @_; - return "PC32^$fromnode^$tonode^$stream^"; + my ($fromnode, $tonode, $stream) = @_; + return "PC32^$fromnode^$tonode^$stream^"; } # acknowledge end of message from receiving end (opposite pc28 node order) sub pc33 { - my ($fromnode, $tonode, $stream) = @_; - return "PC33^$fromnode^$tonode^$stream^"; + my ($fromnode, $tonode, $stream) = @_; + return "PC33^$fromnode^$tonode^$stream^"; } # remote cmd send @@ -217,70 +217,70 @@ sub pc35 # send all the DX clusters I reckon are connected sub pc38 { - my @list = DXNode->get_all(); - my $list; - my @nodes; + my @list = DXNode->get_all(); + my $list; + my @nodes; - foreach $list (@list) { - push @nodes, $list->call; - } - return "PC38^" . join(',', @nodes) . "^~"; + foreach $list (@list) { + push @nodes, $list->call; + } + return "PC38^" . join(',', @nodes) . "^~"; } # tell the local node to discconnect sub pc39 { - my ($call, $reason) = @_; - my $hops = get_hops(39); - $reason = "Gone." if !$reason; - return "PC39^$call^$reason^$hops^"; + my ($call, $reason) = @_; + my $hops = get_hops(39); + $reason = "Gone." if !$reason; + return "PC39^$call^$reason^$hops^"; } # cue up bulletin or file for transfer sub pc40 { - my ($to, $from, $fn, $bull) = @_; - $bull = $bull ? '1' : '0'; - return "PC40^$to^$from^$fn^$bull^5^"; + my ($to, $from, $fn, $bull) = @_; + $bull = $bull ? '1' : '0'; + return "PC40^$to^$from^$fn^$bull^5^"; } # user info sub pc41 { - my ($call, $sort, $info) = @_; - my $hops = get_hops(41); - $sort = $sort ? "$sort" : '0'; - return "PC41^$call^$sort^$info^$hops^~"; + my ($call, $sort, $info) = @_; + my $hops = get_hops(41); + $sort = $sort ? "$sort" : '0'; + return "PC41^$call^$sort^$info^$hops^~"; } # abort message sub pc42 { - my ($fromnode, $tonode, $stream) = @_; - return "PC42^$fromnode^$tonode^$stream^"; + my ($fromnode, $tonode, $stream) = @_; + return "PC42^$fromnode^$tonode^$stream^"; } # bull delete sub pc49 { - my ($from, $subject) = @_; - my $hops = get_hops(49); - return "PC49^$from^$subject^$hops^~"; + my ($from, $subject) = @_; + my $hops = get_hops(49); + return "PC49^$from^$subject^$hops^~"; } # periodic update of users, plus keep link alive device (always H99) sub pc50 { - my $me = DXCluster->get_exact($main::mycall); - my $n = $me->users ? $me->users : '0'; - return "PC50^$main::mycall^$n^H99^"; + my $me = DXCluster->get_exact($main::mycall); + my $n = $me->users ? $me->users : '0'; + return "PC50^$main::mycall^$n^H99^"; } # generate pings sub pc51 { - my ($to, $from, $val) = @_; - return "PC51^$to^$from^$val^"; + my ($to, $from, $val) = @_; + return "PC51^$to^$from^$val^"; } 1; __END__ diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 65948d59..e1b44dfa 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -48,6 +48,7 @@ $filename = undef; lang => '0,Language', hmsgno => '0,Highest Msgno', group => '0,Access Group,parray', # used to create a group of users/nodes for some purpose or other + isolate => '9,Isolate network,yesno', ); no strict; diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index 9f63c890..81bace8c 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -22,97 +22,97 @@ require Exporter; # a full time for logging and other purposes sub atime { - my $t = shift; - my ($sec,$min,$hour,$mday,$mon,$year) = gmtime((defined $t) ? $t : time); - $year += 1900; - my $buf = sprintf "%02d%s%04d\@%02d:%02d:%02d", $mday, $month[$mon], $year, $hour, $min, $sec; - return $buf; + my $t = shift; + my ($sec,$min,$hour,$mday,$mon,$year) = gmtime((defined $t) ? $t : time); + $year += 1900; + my $buf = sprintf "%02d%s%04d\@%02d:%02d:%02d", $mday, $month[$mon], $year, $hour, $min, $sec; + return $buf; } # get a zulu time in cluster format (2300Z) sub ztime { - my $t = shift; - my ($sec,$min,$hour) = gmtime((defined $t) ? $t : time); - $year += 1900; - my $buf = sprintf "%02d%02dZ", $hour, $min; - return $buf; + my $t = shift; + my ($sec,$min,$hour) = gmtime((defined $t) ? $t : time); + $year += 1900; + my $buf = sprintf "%02d%02dZ", $hour, $min; + return $buf; } # get a cluster format date (23-Jun-1998) sub cldate { - my $t = shift; - my ($sec,$min,$hour,$mday,$mon,$year) = gmtime((defined $t) ? $t : time); - $year += 1900; - my $buf = sprintf "%02d-%s-%04d", $mday, $month[$mon], $year; - return $buf; + my $t = shift; + my ($sec,$min,$hour,$mday,$mon,$year) = gmtime((defined $t) ? $t : time); + $year += 1900; + my $buf = sprintf "%02d-%s-%04d", $mday, $month[$mon], $year; + return $buf; } # return a cluster style date time sub cldatetime { - my $t = shift; - my $date = cldate($t); - my $time = ztime($t); - return "$date $time"; + my $t = shift; + my $date = cldate($t); + my $time = ztime($t); + return "$date $time"; } # return a unix date from a cluster date and time sub cltounix { - my $date = shift; - my $time = shift; - $date =~ s/^\s*(\d+)-(\w\w\w)-(19\d\d)$/$1 $2 $3/; - $time =~ s/^(\d\d)(\d\d)Z$/$1:$2 +0000/; - return str2time("$date $time"); + my $date = shift; + my $time = shift; + $date =~ s/^\s*(\d+)-(\w\w\w)-(19\d\d)$/$1 $2 $3/; + $time =~ s/^(\d\d)(\d\d)Z$/$1:$2 +0000/; + return str2time("$date $time"); } # turn a latitude in degrees into a string sub slat { - my $n = shift; - my ($deg, $min, $let); - $let = $n >= 0 ? 'N' : 'S'; - $n = abs $n; - $deg = int $n; - $min = int ((($n - $deg) * 60) + 0.5); - return "$deg $min $let"; + my $n = shift; + my ($deg, $min, $let); + $let = $n >= 0 ? 'N' : 'S'; + $n = abs $n; + $deg = int $n; + $min = int ((($n - $deg) * 60) + 0.5); + return "$deg $min $let"; } # turn a longitude in degrees into a string sub slong { - my $n = shift; - my ($deg, $min, $let); - $let = $n >= 0 ? 'E' : 'W'; - $n = abs $n; - $deg = int $n; - $min = int ((($n - $deg) * 60) + 0.5); - return "$deg $min $let"; + my $n = shift; + my ($deg, $min, $let); + $let = $n >= 0 ? 'E' : 'W'; + $n = abs $n; + $deg = int $n; + $min = int ((($n - $deg) * 60) + 0.5); + return "$deg $min $let"; } # turn a true into 'yes' and false into 'no' sub yesno { - my $n = shift; - return $n ? $main::yes : $main::no; + my $n = shift; + return $n ? $main::yes : $main::no; } # format a prompt with its current value and return it with its privilege sub promptf { - my ($line, $value) = @_; - my ($priv, $prompt, $action) = split ',', $line; - - # if there is an action treat it as a subroutine and replace $value - if ($action) { - my $q = qq{\$value = $action(\$value)}; - eval $q; - } - $prompt = sprintf "%15s: %s", $prompt, $value; - return ($priv, $prompt); + my ($line, $value) = @_; + my ($priv, $prompt, $action) = split ',', $line; + + # if there is an action treat it as a subroutine and replace $value + if ($action) { + my $q = qq{\$value = $action(\$value)}; + eval $q; + } + $prompt = sprintf "%15s: %s", $prompt, $value; + return ($priv, $prompt); } # take an arg as an array list and print it @@ -125,18 +125,18 @@ sub parray # take the arg as an array reference and print as a list of pairs sub parraypairs { - my $ref = shift; - my $i; - my $out; + my $ref = shift; + my $i; + my $out; - for ($i = 0; $i < @$ref; $i += 2) { - my $r1 = @$ref[$i]; - my $r2 = @$ref[$i+1]; - $out .= "$r1-$r2, "; - } - chop $out; # remove last space - chop $out; # remove last comma - return $out; + for ($i = 0; $i < @$ref; $i += 2) { + my $r1 = @$ref[$i]; + my $r2 = @$ref[$i+1]; + $out .= "$r1-$r2, "; + } + chop $out; # remove last space + chop $out; # remove last comma + return $out; } # print all the fields for a record according to privilege @@ -146,18 +146,20 @@ sub parraypairs # 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 $self = shift; # is a dxchan + my $ref = shift; # is a thingy with field_prompt and fields methods defined + my @out = @_; - my @fields = $ref->fields; - my $field; - my @out; - - foreach $field (sort @fields) { - my ($priv, $ans) = promptf($ref->field_prompt($field), $ref->{$field}); - push @out, $ans if ($self->priv >= $priv); - } - return @out; + my @fields = $ref->fields; + my $field; + my @out; + + foreach $field (sort @fields) { + if (defined $ref->{$field}) { + my ($priv, $ans) = promptf($ref->field_prompt($field), $ref->{$field}); + push @out, $ans if ($self->priv >= $priv); + } + } + return @out; } diff --git a/perl/cluster.pl b/perl/cluster.pl index 73cb401a..ad71b688 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -48,7 +48,7 @@ package main; @inqueue = (); # the main input queue, an array of hashes $systime = 0; # the time now (in seconds) -$version = "1.12"; # the version no of the software +$version = "1.13"; # the version no of the software $starttime = 0; # the starting time of the cluster # handle disconnections -- 2.43.0