From 3643ef870e040d437448632209039477eac4e52c Mon Sep 17 00:00:00 2001 From: djk Date: Tue, 15 Dec 1998 23:41:32 +0000 Subject: [PATCH 01/16] 6. Implemented PC49 delete/full from outside (kill full on the inside) 7. Implemented the client command in connect scripts so that you can have different scripts for the same callsign. 8. Added sh/wwv command --- Changes | 5 ++- cmd/Aliases | 17 ++++++----- cmd/Commands_en.hlp | 14 +++++++++ cmd/kill.pl | 10 ++++++ cmd/show/wwv.pl | 33 ++++++++++++++++++++ connect/gb7tlh | 2 +- perl/DXProt.pm | 24 +++++++++------ perl/Geomag.pm | 74 +++++++++++++++++++++++++++++++++++++++++++++ perl/client.pl | 17 +++++++++-- 9 files changed, 176 insertions(+), 20 deletions(-) diff --git a/Changes b/Changes index 2b81d77a..d8b126bd 100644 --- a/Changes +++ b/Changes @@ -8,7 +8,10 @@ is only done on channels that are in state 'normal'. mods to the callsign, useful for sending manual PC protocol to unstick things. Also for sending anonymous messages to online users. 5. Stopped duplicate messages being stored (it receives them and then bins them) -6. Implemented PC49 delete/full from outside +6. Implemented PC49 delete/full from outside (kill full on the inside) +7. Implemented the client command in connect scripts so that you can have +different scripts for the same callsign. +8. Added sh/wwv command 13Dec98======================================================================== 1. Fixed VS6 lat/long in prefix_data and wpxloc.raw 2. Sorted out last in times for remote users diff --git a/cmd/Aliases b/cmd/Aliases index e187ec88..0d64571e 100644 --- a/cmd/Aliases +++ b/cmd/Aliases @@ -36,6 +36,7 @@ package CmdAlias; ], d => [ '^del', 'kill', 'kill', + '^del.*/fu', 'kill full', 'kill', '^di\w*/a\w*', 'directory all', 'directory', '^di\w*/b\w*', 'directory bulletins', 'directory', '^di\w*/n\w*', 'directory new', 'directory', @@ -81,14 +82,16 @@ package CmdAlias; s => [ '^set/nobe', 'unset/beep', 'unset/beep', '^set/nohe', 'unset/here', 'unset/here', - '^sh/c/n', 'show/configuration nodes', 'show/configuration', - '^sh/c$', 'show/configuration', 'show/configuration', - '^sh/dx/(\d+)-(\d+)', 'show/dx $1-$2', 'show/dx', - '^sh/dx/(\d+)', 'show/dx $1', 'show/dx', - '^sh/dx/d(\d+)', 'show/dx from $1', 'show/dx', + '^sh.*/c/n', 'show/configuration nodes', 'show/configuration', + '^sh.*/c$', 'show/configuration', 'show/configuration', + '^sh.*/dx/(\d+)-(\d+)', 'show/dx $1-$2', 'show/dx', + '^sh.*/dx/(\d+)', 'show/dx $1', 'show/dx', + '^sh.*/dx/d(\d+)', 'show/dx from $1', 'show/dx', '^sp$', 'send', 'send', - '^sb$', 'send noprivate', 'send', - ], + '^sb$', 'send noprivate', 'send', + '^sh.*/wwv/(\d+)-(\d+)', 'show/wwv $1-$2', 'show/wwv', + '^sh.*/wwv/(\d+)', 'show/wwv $1', 'show/wwv', + ], t => [ ], u => [ diff --git a/cmd/Commands_en.hlp b/cmd/Commands_en.hlp index 95a36b8b..48b2704d 100644 --- a/cmd/Commands_en.hlp +++ b/cmd/Commands_en.hlp @@ -82,6 +82,16 @@ Look at the APROPOS command which will search the help database for the you specify and give you a list of likely commands to look at with HELP. +=== 0^KILL [ [^Show last WWV broadcasts +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 diff --git a/cmd/kill.pl b/cmd/kill.pl index b6d193fe..d3614c36 100644 --- a/cmd/kill.pl +++ b/cmd/kill.pl @@ -13,6 +13,13 @@ my @out; my @body; my $ref; my $call = $self->call; +my $full; + +if ($f[0] =~ /^f/io) { + return (1, $self->msg('e5')) if $self->priv < 5; + $full = 1; + shift @f; +} # $DB::single = 1; @@ -29,6 +36,9 @@ for $msgno (@f) { next; } Log('msg', "Message $ref->{msgno} from $ref->{from} to $ref->{to} deleted by $call"); + if ($full) { + DXProt::broadcast_ak1a(DXProt::pc49($self->call, $ref->{subject}), $DXProt::me); + } $ref->del_msg; push @out, "Message $msgno deleted"; } diff --git a/cmd/show/wwv.pl b/cmd/show/wwv.pl index e69de29b..a8e4992a 100644 --- a/cmd/show/wwv.pl +++ b/cmd/show/wwv.pl @@ -0,0 +1,33 @@ +# +# print out the wwv stats +# +# Copyright (c) 1998 - Dirk Koopman G1TLH +# +# $Id$ +# +my $self = shift; + +my $cmdline = shift; +my @f = split /\s+/, $cmdline; +my $f; +my @out; +my ($from, $to); + +$from = 0; +while ($f = shift @f) { # next field + # print "f: $f list: ", join(',', @list), "\n"; + if (!$from && !$to) { + ($from, $to) = $f =~ /^(\d+)-(\d+)$/o; # is it a from -> to count? + next if $from && $to > $from; + } + if (!$to) { + ($to) = $f =~ /^(\d+)$/o if !$to; # is it a to count? + next if $to; + } +} + +$to = 10 if !$to; + +push @out, "Date Hour SFI A K Forecast Logger"; +push @out, Geomag::print($from, $to, $main::systime); +return (1, @out); diff --git a/connect/gb7tlh b/connect/gb7tlh index 18a1ac9b..de20f6e1 100644 --- a/connect/gb7tlh +++ b/connect/gb7tlh @@ -4,4 +4,4 @@ connect ax25 /usr/sbin/netrom_call bbs gb7djk g1tlh 'Connect' '' 'Connect' 'cluster' 'Connect' -client /usr/bin/perl /spider/perl/client.pl gb7tlh ax25 +client gb7tlh ax25 diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 7bccfcb9..f50b1e14 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -161,7 +161,7 @@ sub normal my @list; if ($field[4] eq '*') { # sysops - $target = "Sysops"; + $target = "SYSOP"; @list = map { $_->priv >= 5 ? $_ : () } get_all_users(); } elsif ($field[4] gt ' ') { # speciality list handling my ($name) = split /\./, $field[4]; @@ -270,6 +270,8 @@ sub normal if (!$user) { $user = DXUser->new($call); $user->sort('A'); + $user->priv(1); # I have relented and defaulted nodes + $self->{priv} = 1; # to user RCMDs allowed $user->homenode($call); $user->node($call); } @@ -334,15 +336,19 @@ sub normal if ($field[1] eq $main::mycall) { my $ref = DXUser->get_current($field[2]); Log('rcmd', 'in', $ref->{priv}, $field[2], $field[3]); - if ($ref->{priv}) { # you have to have SOME privilege, the commands have further filtering - $self->{remotecmd} = 1; # for the benefit of any command that needs to know - my @in = (DXCommandmode::run_cmd($self, $field[3])); - for (@in) { - s/\s*$//og; - $self->send(pc35($main::mycall, $field[2], "$main::mycall:$_")); - Log('rcmd', 'out', $field[2], $_); + unless ($field[3] =~ /rcmd/i) { # not allowed to relay RCMDS! + if ($ref->{priv}) { # you have to have SOME privilege, the commands have further filtering + $self->{remotecmd} = 1; # for the benefit of any command that needs to know + my @in = (DXCommandmode::run_cmd($self, $field[3])); + for (@in) { + s/\s*$//og; + $self->send(pc35($main::mycall, $field[2], "$main::mycall:$_")); + Log('rcmd', 'out', $field[2], $_); + } + delete $self->{remotecmd}; } - delete $self->{remotecmd}; + } else { + $self->send(pc35($main::mycall, $field[2], "$main::mycall:Tut tut tut...!")); } } else { route($field[1], $line); diff --git a/perl/Geomag.pm b/perl/Geomag.pm index 0fc16d06..a63d19b6 100644 --- a/perl/Geomag.pm +++ b/perl/Geomag.pm @@ -135,5 +135,79 @@ sub forecast @_ ? $forecast = shift : $forecast ; } +# +# print some items from the log backwards in time +# +# This command outputs a list of n lines starting from line $from to $to +# +sub print +{ + my $self = $fp; + my $from = shift; + my $to = shift; + my @date = $self->unixtoj(shift); + my $pattern = shift; + my $search; + my @in; + my @out; + my $eval; + my $count; + + $search = 1; + $eval = qq( + my \$c; + my \$ref; + for (\$c = \$#in; \$c >= 0; \$c--) { + \$ref = \$in[\$c]; + if ($search) { + \$count++; + next if \$count < $from; + push \@out, print_item(\$ref); + last LOOP if \$count >= \$to; # stop after n + } + } + ); + + $self->close; # close any open files + + my $fh = $self->open(@date); +LOOP: + while ($count < $to) { + my @spots = (); + if ($fh) { + while (<$fh>) { + chomp; + push @in, [ split '\^' ] if length > 2; + } + eval $eval; # do the search on this file + return ("Spot search error", $@) if $@; + } + $fh = $self->openprev(); # get the next file + last if !$fh; + } + + return @out; +} + +# +# the standard log printing interpreting routine. +# +# every line that is printed should call this routine to be actually visualised +# +# Don't really know whether this is the correct place to put this stuff, but where +# else is correct? +# +# I get a reference to an array of items +# +sub print_item +{ + my $r = shift; + my @ref = @$r; + my $d = cldate($ref[1]); + my ($t) = (gmtime($ref[1]))[2]; + + return sprintf("$d %02d %5d %3d %3d %-37s <%s>", $t, $ref[2], $ref[3], $ref[4], $ref[5], $ref[0]); +} + 1; __END__; diff --git a/perl/client.pl b/perl/client.pl index a2a690ca..cc185a17 100755 --- a/perl/client.pl +++ b/perl/client.pl @@ -374,6 +374,15 @@ if ($loginreq) { } } +# handle callsign and connection type firtling +sub doclient +{ + my $line = shift; + my @f = split /\s+/, $line; + $call = uc $f[0] if $f[0]; + $csort = $f[1] if $f[1]; +} + # is this an out going connection? if ($connsort eq "connect") { my $mcall = lc $call; @@ -391,10 +400,14 @@ if ($connsort eq "connect") { doconnect($1, $2) if /^\s*co\w*\s+(\w+)\s+(.*)$/io; doabort($1) if /^\s*a\w*\s+(.*)/io; dotimeout($1) if /^\s*t\w*\s+(\d+)/io; - dochat($1, $2) if /\s*\'(.*)\'\s+\'(.*)\'/io; + dochat($1, $2) if /\s*\'(.*)\'\s+\'(.*)\'/io; + if (/\s*cl\w+\s+(.*)/io) { + doclient($1); + last; + } } - dbg('connect', "Connected to $call, starting normal protocol"); + dbg('connect', "Connected to $call ($csort), starting normal protocol"); dbgsub('connect'); # if we get here we are connected -- 2.34.1 From 0f8cb479221e09bae8e03447c78527604cf69be4 Mon Sep 17 00:00:00 2001 From: djk Date: Sat, 19 Dec 1998 23:25:09 +0000 Subject: [PATCH 02/16] added set/unset isolate and unset/node (untested) --- cmd/set/isolate.pl | 38 ++++++++++++++++++++++++++++++++++++++ cmd/unset/isolate.pl | 33 +++++++++++++++++++++++++++++++++ cmd/unset/node.pl | 33 +++++++++++++++++++++++++++++++++ connect/gb7tlh | 14 +++++++++----- perl/Messages | 4 ++++ 5 files changed, 117 insertions(+), 5 deletions(-) create mode 100644 cmd/set/isolate.pl create mode 100644 cmd/unset/isolate.pl create mode 100644 cmd/unset/node.pl diff --git a/cmd/set/isolate.pl b/cmd/set/isolate.pl new file mode 100644 index 00000000..b008a9b0 --- /dev/null +++ b/cmd/set/isolate.pl @@ -0,0 +1,38 @@ +# +# set isolation for this node +# +# Please note that this is only effective if the user is not on-line +# +# Copyright (c) 1998 - Dirk Koopman +# +# $Id$ +# + +my ($self, $line) = @_; +my @args = split /\s+/, $line; +my $call; +my @out; +my $user; +my $create; + +return (0) if $self->priv < 9; + +foreach $call (@args) { + $call = uc $call; + my $chan = DXChannel->get($call); + if ($chan) { + push @out, $self->msg('nodee1', $call); + } else { + $user = DXUser->get($call); + $create = !$user; + $user = DXUser->new($call) if $create; + if ($user) { + $user->isolate(1); + $user->close(); + push @out, $self->msg($create ? 'isoc' : 'iso', $call); + } else { + push @out, $self->msg('e3', "Set/Isolate", $call); + } + } +} +return (1, @out); diff --git a/cmd/unset/isolate.pl b/cmd/unset/isolate.pl new file mode 100644 index 00000000..13fbf655 --- /dev/null +++ b/cmd/unset/isolate.pl @@ -0,0 +1,33 @@ +# +# set user type BACK TO 'U' (user) +# +# Please note that this is only effective if the user is not on-line +# +# Copyright (c) 1998 - Dirk Koopman +# +# $Id$ +# + +my ($self, $line) = @_; +my @args = split /\s+/, $line; +my $call; +my @out; +my $user; +my $create; + +return (0) if $self->priv < 5; + +foreach $call (@args) { + $call = uc $call; + my $chan = DXChannel->get($call); + if ($chan) { + push @out, $self->msg('nodee1', $call); + } else { + $user = DXUser->get($call); + return (1, $self->msg('usernf', $call)) if !$user; + $user->isolate(0); + $user->close(); + push @out, $self->msg('isou', $call); + } +} +return (1, @out); diff --git a/cmd/unset/node.pl b/cmd/unset/node.pl new file mode 100644 index 00000000..bd0a29ef --- /dev/null +++ b/cmd/unset/node.pl @@ -0,0 +1,33 @@ +# +# set user type BACK TO 'U' (user) +# +# Please note that this is only effective if the user is not on-line +# +# Copyright (c) 1998 - Dirk Koopman +# +# $Id$ +# + +my ($self, $line) = @_; +my @args = split /\s+/, $line; +my $call; +my @out; +my $user; +my $create; + +return (0) if $self->priv < 5; + +foreach $call (@args) { + $call = uc $call; + my $chan = DXChannel->get($call); + if ($chan) { + push @out, $self->msg('nodee1', $call); + } else { + $user = DXUser->get($call); + return (1, $self->msg('usernf', $call)) if !$user; + $user->sort('U'); + $user->close(); + push @out, $self->msg('nodeu', $call); + } +} +return (1, @out); diff --git a/connect/gb7tlh b/connect/gb7tlh index de20f6e1..a2834ab4 100644 --- a/connect/gb7tlh +++ b/connect/gb7tlh @@ -1,7 +1,11 @@ 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 ax25 /usr/sbin/netrom_call bbs gb7djk g1tlh +#'Connect' '' +#'Connect' 'cluster' +#'Connect' +#client gb7tlh ax25 +connect telnet dirk1 +'login' 'djk' +'word' 'b390vpw' +'last' diff --git a/perl/Messages b/perl/Messages index 16ad509e..a7250016 100644 --- a/perl/Messages +++ b/perl/Messages @@ -51,6 +51,9 @@ package DXM; homenode => 'Home Node set to: $_[0]', hnodee1 => 'Please enter your Home Node, set/homenode ', hnode => 'Your Homenode is now \"$_[0]\"', + iso => '$_[0] Isolated', + isou => '$_[0] UnIsolated', + 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', loce1 => 'Please enter your location,, set/location ', @@ -63,6 +66,7 @@ package DXM; namee2 => 'Can\'t find user $_[0]!', name => 'Your name is now \"$_[0]\"', node => '$_[0] set as AK1A style Node', + nodeu => '$_[0] set back as a User', nodec => '$_[0] created as AK1A style Node', nodee1 => 'You cannot use this command whilst your target ($_[0]) is on-line', ok => 'Operation successful', -- 2.34.1 From 69c8aeb338cc485103e289fbab7ec4e7e056ed20 Mon Sep 17 00:00:00 2001 From: djk Date: Sun, 20 Dec 1998 01:58:04 +0000 Subject: [PATCH 03/16] 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

    -

     

    -
    - -
      - -
    1. 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.
    2. -

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

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

      +

      + The DX Spider Software + + +

      We can now begin:- +

      +

        + +

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

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

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

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

        -
      5. 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: -
      6. -
        # 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. + +

      7. 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
        -
      8. Next step is to set permissions on the 'spider' directory tree and files:-
      9. -
        # 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
        +		
        + +

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

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

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

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

        -
      14. 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:-
      15. -
        -   [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.

        -
      16. 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
      17. -
           # 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

        -
      18. Login to your computer as sysop, and create the initial DX Spider parameters necessary to start the cluster for the first time.
      19. -
           $ 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.). + +

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

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

      22. 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 ...
        -
        -
      23. now log in again (as 'sysop') or start another rxvt or xterm
      24. - -
        -   $ 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
        -
        -
      -
      -
      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 ...
      +		
      + +

    3. 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.34.1 From cce161221036760959ff1d0b7628a55942bf558a Mon Sep 17 00:00:00 2001 From: djk Date: Mon, 21 Dec 1998 10:24:48 +0000 Subject: [PATCH 04/16] pre 1.13 release --- Changes | 7 ++ cmd/Aliases | 52 +++++++------- cmd/load/hops.pl | 8 +++ cmd/set/password.pl | 0 cmd/talk.pl | 35 ++++++---- html/connect.html | 76 +++++++++++++------- html/hops.html | 159 ++++++++++++++++++++++++++++++++++++++++++ html/index.html | 3 +- html/install.html | 76 ++++++++++++++++---- perl/DXChannel.pm | 11 +-- perl/DXCluster.pm | 3 +- perl/DXCommandmode.pm | 29 ++++---- perl/DXCron.pm | 2 +- perl/DXDebug.pm | 3 +- perl/DXLog.pm | 18 ++--- perl/DXMsg.pm | 20 +++--- perl/DXProt.pm | 138 +++++++++++++++++++++++++----------- perl/DXUser.pm | 8 +-- perl/DXUtil.pm | 4 +- perl/DXVars.pm | 2 +- perl/Messages | 1 + perl/Prefix.pm | 6 +- perl/cluster.pl | 4 +- 23 files changed, 493 insertions(+), 172 deletions(-) create mode 100644 cmd/load/hops.pl create mode 100644 cmd/set/password.pl create mode 100644 html/hops.html diff --git a/Changes b/Changes index 35fa1d84..d74a7b85 100644 --- a/Changes +++ b/Changes @@ -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! diff --git a/cmd/Aliases b/cmd/Aliases index 0d64571e..bef5f9d1 100644 --- a/cmd/Aliases +++ b/cmd/Aliases @@ -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' => [ ], ) diff --git a/cmd/load/hops.pl b/cmd/load/hops.pl new file mode 100644 index 00000000..592b7920 --- /dev/null +++ b/cmd/load/hops.pl @@ -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); diff --git a/cmd/set/password.pl b/cmd/set/password.pl new file mode 100644 index 00000000..e69de29b diff --git a/cmd/talk.pl b/cmd/talk.pl index 4002c828..899a4430 100644 --- a/cmd/talk.pl +++ b/cmd/talk.pl @@ -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); diff --git a/html/connect.html b/html/connect.html index cb349e6c..902af164 100644 --- a/html/connect.html +++ b/html/connect.html @@ -19,7 +19,7 @@

    -Last modified: Thu Dec 17 00:06:40 GMT 1998 +Last modified: Sun Dec 20 17:04:05 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 @@ -90,31 +90,59 @@ Last modified: Thu Dec 17 00:06:40 GMT 1998 etc -

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

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

    • timeout followed by a number is the number of seconds to wait for a command - to complete. If there is no timeout specified in the script then the default is 60 seconds. -

    • abort 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. -

    • connect followed by ax25 or telnet and some type dependent information. In - the case of a telnet 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). -

      In the case of an ax25 session then this would normally be a call to ax25_call - or netrom_call as in the example above. It is your responsibility to get your node - and other ax25 parameters to work before going down this route! -

    • ' or " are the delimiting characters for a chat 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. -

      When the left hand string has found what it is looking (if it is) then the right hand string is - sent to the connection. + +

    • # All lines starting with a # are + ignored, as are wholly blank lines. + +

    • timeout followed by a number is the number of + seconds to wait for a command to complete. If there is no + timeout specified in the script then the default is 60 + seconds. + +

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

    • connect followed by ax25 or telnet + and some type dependent information. In the case of a + telnet 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). + +

      In the case of an ax25 session then this would + normally be a call to ax25_call or + netrom_call as in the example above. It is your + responsibility to get your node and other ax25 parameters to + work before going down this route! + +

    • ' is the delimiting character for a word or + phrase of an expect/send line in a chat 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. + +

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

    • 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]). +
    diff --git a/html/hops.html b/html/hops.html new file mode 100644 index 00000000..5ffa84c3 --- /dev/null +++ b/html/hops.html @@ -0,0 +1,159 @@ + + + + Hops, Network Isolation and other matters... + + + + + + + +
    +

    Hops, Network Isolation and other matters...

    +
    +
    + + +
    Dirk Koopman G1TLH
    +

    + + +Last modified: Sun Dec 20 18:15:15 GMT 1998 + + +

    Introduction

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

    Basic Hop Control

    + + The number of hops that are set for all PC protocol messages (that require them) + are specified in /spider/perl/DXProtVars.pm. + +

    In versions prior to 1.13 you would move this file to + /spider/local/ and modify the perl variables: + $def_hopcount and %hopcount to some reasonable + values. + +

    From version 1.13 onwards a new mechanism has been introduced + which uses a file called /spider/data/hop_count.pl. 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 + hop_count.pl file can be found in the + /spider/examples directory. + +

    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 load/hops command on a + client console with full sysop privileges. + +

    Per Node Hop Control

    + + From version 1.13 it is possible to control the number of hops to each + node. This is done by adding information to the %nodehops perl + variable in the hop_count.pl 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. + +

    You can also have a entry called default 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. + +

    Example hop_count.pl File

    + + An example for you:- + +

    +#
    +# 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, 
    +    },
    +);                              
    +	
    + +

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

    Isolated Networks

    + + It is possible to isolate networks from each other on a "gateway" node using + the set/isolate <node call> command. + +

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

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

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

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

     

    +

    +


    + + Copyright © 1998 by Dirk Koopman G1TLH. All Rights Reserved
    +
    + $Id$ + + diff --git a/html/index.html b/html/index.html index e3a73743..72e277a5 100644 --- a/html/index.html +++ b/html/index.html @@ -18,7 +18,7 @@

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

  • Installation of the main cluster software.
  • Installing the lastest version of CPAN.
  • Connecting to other clusters. +
  • Hop control, network isolation etc.
  • Download the software and any patches. diff --git a/html/install.html b/html/install.html index 74c432ce..089854b7 100644 --- a/html/install.html +++ b/html/install.html @@ -17,7 +17,7 @@
    Iain Phillips G0RDI
    -Last modified: Sat Dec 19 16:10:14 GMT 1998 +Last modified: Sun Dec 20 17:55:19 GMT 1998

    This HOWTO describes the installation for DX Spider v1.11 on a "vanilla" RedHat 5.1 platform, @@ -158,25 +158,76 @@ spider:x:251:sysop,g0rdi,root

    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:- -

    -# useradd gb7djk
    +		

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

    +# useradd -m 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 ;-):- + +

    You can then either 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 alter the /etc/passwd thus:- +

     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.). + Don't forget to give them a real password. 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.). If the user or other cluster + program requires AX25 conventions to operate then you can use + ax25 instead. + +

    Another thing you can do is to get inetd to listen + on a specific port and then start the client up directly. To + do this, create an entry in /etc/services with a + port number > 1000 that isn't used elsewhere eg:- + +

    +gb7djk     8001/tcp 
    +gb7tlh     8002/tcp
    +        
    + + Then create some lines in /etc/inetd.conf that look + like this:- + +

    +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
    +		
    + + Please DON'T run the client as root 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). + +

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

    In the example I have used tcpd 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 TIS + Firewall Toolkit myself, you may find this more intuitive + to use. The point is that gb7djk would only be coming + from one IP address, if it coming from another, it is an imposter! + +

    You are responsible for arranging and looking after your + security - not me. +

  • 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]                                                                         
    @@ -258,8 +309,7 @@ PC38^GB7JIM^~           <- the cluster thinks this is a cluster
     	
     
     	

    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. + the Bug Reporting System.

    Can I commend to you the Announcements mailing list to which you may subscribe. @@ -268,7 +318,7 @@ PC38^GB7JIM^~ <- the cluster thinks this is a cluster

    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. + to the support mailing list which will be the focus of any discussion/bug fixing etc.

     

    diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index c494f59b..7319344c 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -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 diff --git a/perl/DXCluster.pm b/perl/DXCluster.pm index 0eb98a4b..153c70e9 100644 --- a/perl/DXCluster.pm +++ b/perl/DXCluster.pm @@ -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; } diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 91d268b0..e8fd7d5a 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -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"); diff --git a/perl/DXCron.pm b/perl/DXCron.pm index ba200502..961fa3a6 100644 --- a/perl/DXCron.pm +++ b/perl/DXCron.pm @@ -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 diff --git a/perl/DXDebug.pm b/perl/DXDebug.pm index 530f3b21..c03f92af 100644 --- a/perl/DXDebug.pm +++ b/perl/DXDebug.pm @@ -64,7 +64,8 @@ sub dbglist sub isdbg { - return $dbglevel{shift}; + my $s = shift; + return $dbglevel{$s}; } 1; __END__ diff --git a/perl/DXLog.pm b/perl/DXLog.pm index 3a6e0e35..c6994137 100644 --- a/perl/DXLog.pm +++ b/perl/DXLog.pm @@ -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"; diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index 63710e4b..262a4155 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -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"; diff --git a/perl/DXProt.pm b/perl/DXProt.pm index f3612791..655da52b 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -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 { diff --git a/perl/DXUser.pm b/perl/DXUser.pm index e1b44dfa..0ef376f0 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -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__ diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index 81bace8c..5c6c51af 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -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}) { diff --git a/perl/DXVars.pm b/perl/DXVars.pm index 91f43707..4d208b1b 100644 --- a/perl/DXVars.pm +++ b/perl/DXVars.pm @@ -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 ); diff --git a/perl/Messages b/perl/Messages index a7250016..26bf7fa8 100644 --- a/perl/Messages +++ b/perl/Messages @@ -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 ', loce2 => 'Don\'t recognise \"$_[0]\" as a Lat/Long (eg 52 20 N 0 16 E)', loc => 'Your Lat/Long is now \"$_[0]\"', diff --git a/perl/Prefix.pm b/perl/Prefix.pm index ae431485..cab54cd8 100644 --- a/perl/Prefix.pm +++ b/perl/Prefix.pm @@ -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 { diff --git a/perl/cluster.pl b/perl/cluster.pl index ad71b688..b7bdd037 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -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); -- 2.34.1 From 0565e35bbb112b94c89f693dcb74ac7efa9e424a Mon Sep 17 00:00:00 2001 From: djk Date: Mon, 21 Dec 1998 11:01:38 +0000 Subject: [PATCH 05/16] added examples added data/issue to login clients --- examples/djk | 7 +++++++ examples/gb7djk | 6 ++++++ examples/gb7tlh | 7 +++++++ examples/hop_table.pl | 36 ++++++++++++++++++++++++++++++++++++ perl/client.pl | 26 +++++++++++++++++++++++--- 5 files changed, 79 insertions(+), 3 deletions(-) create mode 100644 examples/djk create mode 100644 examples/gb7djk create mode 100644 examples/gb7tlh create mode 100644 examples/hop_table.pl diff --git a/examples/djk b/examples/djk new file mode 100644 index 00000000..8e6a0cfb --- /dev/null +++ b/examples/djk @@ -0,0 +1,7 @@ +timeout 15 +connect telnet dirk1 +'login' 'djk' +'word' 'xxxxx' +'\$ ' 'cd spider/perl' +'\$ ' 'client.pl gb7djk-1 telnet' +client gb7djk telnet diff --git a/examples/gb7djk b/examples/gb7djk new file mode 100644 index 00000000..e2e20cd0 --- /dev/null +++ b/examples/gb7djk @@ -0,0 +1,6 @@ +timeout 15 +# don't forget to chmod 4775 netrom_call! +connect ax25 /usr/sbin/netrom_call bbs gb7djk-1 gb7djk-0 +'Connect' '' +'Connect' +client gb7djk ax25 diff --git a/examples/gb7tlh b/examples/gb7tlh new file mode 100644 index 00000000..83046c6b --- /dev/null +++ b/examples/gb7tlh @@ -0,0 +1,7 @@ +timeout 15 +# 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/examples/hop_table.pl b/examples/hop_table.pl new file mode 100644 index 00000000..7bb647ff --- /dev/null +++ b/examples/hop_table.pl @@ -0,0 +1,36 @@ +# +# 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 => { + 16 => 23, + 17 => 23, + }, + GB7TLH => { + 19 => 99, + 21 => 99, + 16 => 99, + 17 => 99, + } +); diff --git a/perl/client.pl b/perl/client.pl index cc185a17..8d2d683b 100755 --- a/perl/client.pl +++ b/perl/client.pl @@ -348,28 +348,48 @@ if ($loginreq) { my $user; my $s; + if (-e "$data/issue") { + open(I, "$data/issue") or die; + local $/ = undef; + $issue = ; + close(I); + $issue = s/\n/\r/og if $mode == 1; + local $/ = $nl; + $stdout->print($issue) if issue; + } + + DXUser->init($userfn); + # allow a login from an existing user. I could create a user but + # I want to check for valid callsigns and I don't have the + # necessary info / regular expression yet for ($state = 0; $state < 2; ) { alarm($timeout); if ($state == 0) { $stdout->print('login: '); $stdout->flush(); - local $/ = $mode == 1 ? "\r" : "\n"; + local $\ = $nl; $s = $stdin->getline(); chomp $s; + $s =~ s/\s+//og; + $s =~ s/-\d+$//o; # no ssids! + cease(0) unless $s gt ' '; $call = uc $s; $user = DXUser->get($call); $state = 1; } elsif ($state == 1) { $stdout->print('password: '); $stdout->flush(); - local $/ = $mode == 1 ? "\r" : "\n"; + local $\ = $nl; $s = $stdin->getline(); chomp $s; $state = 2; - cease(0) if !$user || ($user->passwd && $user->passwd ne $s); + if (!$user || ($user->passwd && $user->passwd ne $s)) { + $stdout->print("sorry...$nl"); + cease(0); + } } } } -- 2.34.1 From c66d28ace3e5bf4b9fa20256425d7d1416e7d8c5 Mon Sep 17 00:00:00 2001 From: djk Date: Mon, 21 Dec 1998 12:10:09 +0000 Subject: [PATCH 06/16] 1. Added "issue" to the client program for 'login' connections 2. Added more docs for client program. 3. Fixed problem introduced in 1.12 where a connect locally with a callsign of someone connected remotely would stop the cluster. 4. issue release 1.13 --- Changes | 6 ++++++ perl/cluster.pl | 8 +++----- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/Changes b/Changes index d74a7b85..c8f8ee15 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,9 @@ +21Dec98======================================================================== +1. Added "issue" to the client program for 'login' connections +2. Added more docs for client program. +3. Fixed problem introduced in 1.12 where a connect locally with a callsign of +someone connected remotely would stop the cluster. +4. issue release 1.13 20Dec98======================================================================== 1. Removed all the warnings I get with perl -w (at least for just starting the cluster and running a few commands). diff --git a/perl/cluster.pl b/perl/cluster.pl index b7bdd037..16a03037 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -89,19 +89,17 @@ sub rec # is there one already connected elsewhere in the cluster (and not a cluster) my $user = DXUser->get($call); if ($user) { - if ($user->sort eq 'A' && !DXCluster->get_exact($call)) { - ; - } elsif ($user->sort eq 'U' && $call eq $main::myalias && !DXCluster->get_exact($call)) { + if (($user->sort eq 'A' || $call == $myalias) && !DXCluster->get_exact($call)) { ; } else { - if (DXChannel->get($call)) { + if (DXCluster->get($call) || DXChannel->get($call)) { my $mess = DXM::msg($lang, $user->sort eq 'A' ? 'concluster' : 'conother', $call); already_conn($conn, $call, $mess); return; } } } else { - if (DXChannel->get($call)) { + if (DXCluster->get($call) || DXChannel->get($call)) { my $mess = DXM::msg($lang, 'conother', $call); already_conn($conn, $call, $mess); return; -- 2.34.1 From c4284750b659c9f1ce58119a13daf4c52e3c1e38 Mon Sep 17 00:00:00 2001 From: djk Date: Mon, 21 Dec 1998 12:32:06 +0000 Subject: [PATCH 07/16] added client file --- html/client.html | 119 ++++++++++++++++++++++++++++++++++++++++++++++ html/hops.html | 4 +- html/index.html | 5 +- html/install.html | 4 +- 4 files changed, 126 insertions(+), 6 deletions(-) create mode 100644 html/client.html diff --git a/html/client.html b/html/client.html new file mode 100644 index 00000000..b63ec801 --- /dev/null +++ b/html/client.html @@ -0,0 +1,119 @@ + + + + The Standard Client + Connecting to other Clusters + + + + + + + +
    +

    The Standard Client

    +
    +
    + + +
    Dirk Koopman G1TLH
    +

    + + +Last modified: Mon Dec 21 12:26:18 GMT 1998 + + +

    Introduction

    + + The standard client program is written in perl and lives in /spider/perl/client.pl. + It performs the interface function + between the cluster daemon (/spider/perl/cluster.pl) and + AX25 or Telnet connections, both incoming and outgoing. + +

    client.pl

    + + The client itself is a rather rudimentary program which really only deals with + things like line end conventions and noticing when a connection goes away. It is + envisaged that at some time in the nearish future this program will be written in + C and thus become considerably smaller. But, for the moment and whilst this area + is under some development, it will remain in perl for ease of change. + +

    The client can take up two arguments: a "callsign" and a connection type. + +

    The "callsign" can have the following values:- +

      +

    1. A real callsign (!). + +

      For incoming connections it is important to make sure that + the callsign passed DOES NOT have an SSID (use the %u + or %U in ax25d.conf). The DXSpider system largely + ignores what it regards as 'duplicate' callsigns (and that + includes those with SSIDs) except in certain special cases. + +

    2. The name of a connect script. + +

    3. login This will cause a unix like login: and + password: phase to be run. With version 1.13 the password isn't + checked unless there is a password recorded in the user file - but you have + no means of recording a password! (unless you have created a local set/password + command - please donate a copy it you have) + +

      Also in 1.13 only existing users can enter via this means. This will probably + change, but please discuss this in the support + mailing list. + +

    + +

    The connection type can be:- +

      +

    1. ax25 This tells the client to use ax25 line conventions. + +

    2. telnet This tells the client to use normal unix line conventions. + +

    3. connect Start an outgoing connect script. + Use the line conventions in that script. +
    + +

    The connection type can be missing in which case the default is unix line conventions. + +

    If both the callsign and the connection are missing then it is + assumed that the client is the sysop and uses the callsign set in + your local copy of DXVars.pm. + +

    Considerations

    + + As mentioned earlier, SSIDs are generally stripped from + callsigns except in two cases: +
      +

    1. For Cluster node callsigns. Although here in the UK we are issued with + special callsigns to run cluster nodes and BBSs, this is not universal. Therefore + by marking a callsign as a node you disable SSID checking. You will have to treat + incoming cluster callsigns specially in ax25d.conf to use this feature (i.e + you will have to set up a line specially for that callsign with a %s or %S for the + callsign substitution [better just put the callsign you want!]). + +

    2. The sysop callsign set up in your local copy of + DXVars.pm. You must call client.pl with + no parameters for this to work. +
    + +

    Files

    + + The client only uses files when in the login phase. It + prints the /spider/data/issue file, if it is present, to + the user before issuing the login: prompt. After a callsign + and password is entered it uses + the standard cluster user file to check them. + + + +

     

    +

    +


    + + Copyright © 1998 by Dirk Koopman G1TLH. All Rights Reserved
    +
    + $Id$ + + diff --git a/html/hops.html b/html/hops.html index 5ffa84c3..1da20554 100644 --- a/html/hops.html +++ b/html/hops.html @@ -19,7 +19,7 @@

    -Last modified: Sun Dec 20 18:15:15 GMT 1998 +Last modified: Mon Dec 21 11:57:54 GMT 1998

    Introduction

    @@ -120,7 +120,7 @@ $def_hopcount = 15; is working at least as well as advertised) you should keep the default hop counts down to the sort of levels shown above. -

    Isolated Networks

    +

    Isolated Networks

    It is possible to isolate networks from each other on a "gateway" node using the set/isolate <node call> command. diff --git a/html/index.html b/html/index.html index 72e277a5..f10c0265 100644 --- a/html/index.html +++ b/html/index.html @@ -18,7 +18,7 @@

    -Last modified: Sun Dec 20 16:25:28 GMT 1998 +Last modified: Mon Dec 21 11:58:48 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. @@ -28,8 +28,9 @@ Last modified: Sun Dec 20 16:25:28 GMT 1998

    1. Installation of the main cluster software.
    2. Installing the lastest version of CPAN. +
    3. Explaining the client.pl program.
    4. Connecting to other clusters. -
    5. Hop control, network isolation etc. +
    6. Hop control, network isolation etc.
    7. Download the software and any patches.
    diff --git a/html/install.html b/html/install.html index 089854b7..753144b7 100644 --- a/html/install.html +++ b/html/install.html @@ -17,7 +17,7 @@
    Iain Phillips G0RDI
    -Last modified: Sun Dec 20 17:55:19 GMT 1998 +Last modified: Mon Dec 21 11:26:05 GMT 1998

    This HOWTO describes the installation for DX Spider v1.11 on a "vanilla" RedHat 5.1 platform, @@ -246,7 +246,7 @@ default * * * * * * - sysop /spider/perl/client.pl client.pl %u ax25

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

  • 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
    -- 
    2.34.1
    
    
    From 97d5445b1e468d9228367640421b2f90ac021224 Mon Sep 17 00:00:00 2001
    From: djk 
    Date: Mon, 21 Dec 1998 15:08:09 +0000
    Subject: [PATCH 08/16] fixed one ot two little buglets
    
    ---
     cmd/connect.pl  |  2 +-
     perl/DXProt.pm  | 49 +++++++++++++++++++++++++++++--------------------
     perl/client.pl  | 24 ++++++++++++++----------
     perl/cluster.pl | 15 +++++----------
     4 files changed, 49 insertions(+), 41 deletions(-)
    
    diff --git a/cmd/connect.pl b/cmd/connect.pl
    index e1263887..93f62b71 100644
    --- a/cmd/connect.pl
    +++ b/cmd/connect.pl
    @@ -7,7 +7,7 @@ my $lccall = lc $call;
     
     return (0) if $self->priv < 8;
     return (1, $self->msg('e6')) unless $call gt ' ';
    -return (1, $self->msg('already', $call)) if DXChannel::get($call);
    +return (1, $self->msg('already', $call)) if DXChannel->get($call);
     return (1, $self->msg('conscript', $lccall)) unless -e "$main::root/connect/$lccall";
     
     my $prog = "$main::root/local/client.pl";
    diff --git a/perl/DXProt.pm b/perl/DXProt.pm
    index 655da52b..15466e36 100644
    --- a/perl/DXProt.pm
    +++ b/perl/DXProt.pm
    @@ -133,8 +133,12 @@ sub normal
     			
     			# convert the date to a unix date
     			my $d = cltounix($field[3], $field[4]);
    -			return if !$d || ($pcno == 11 && $d < $main::systime - $pc11_max_age); # bang out (and don't pass on) if date is invalid or the spot is too old
    -			
    +			# bang out (and don't pass on) if date is invalid or the spot is too old
    +			if (!$d || ($pcno == 11 && $d < $main::systime - $pc11_max_age)) {
    +				dbg('chan', "Spot ignored, invalid date or too old");
    +				return;
    +			}
    +
     			# strip off the leading & trailing spaces from the comment
     			my $text = unpad($field[5]);
     			
    @@ -144,7 +148,11 @@ sub normal
     			
     			# do some de-duping
     			my $dupkey = "$field[1]$field[2]$d$text$field[6]";
    -			return if $dup{$dupkey};
    +			if ($dup{$dupkey}) {
    +				dbg('chan', "Duplicate Spot ignored");
    +				return;
    +			}
    +			
     			$dup{$dupkey} = $d;
     			
     			my $spot = Spot::add($field[1], $field[2], $d, $text, $spotter);
    @@ -250,7 +258,7 @@ sub normal
     			$self->send_local_config();
     			$self->send(pc20());
     			$self->state('init');	
    -			last SWITCH;
    +			return;             # we don't pass these on
     		}
     		
     		if ($pcno == 19) {		# incoming cluster list
    @@ -529,8 +537,8 @@ sub finish
     	my $node;
     	
     	foreach $node (@gonenodes) {
    -		next if $node->call eq $call; 
    -		broadcast_ak1a(pc21($node->call, 'Gone'), $self) unless $self->{isolate}; # done like this 'cos DXNodes don't have a pc21 method
    +		next if $node->call eq $call;
    +		broadcast_ak1a(pc21($node->call, 'Gone') , $self) unless $self->{isolate}; 
     		$node->del();
     	}
     
    @@ -566,7 +574,7 @@ sub send_local_config
     	my @s = $me->pc19(@nodes);
     	for (@s) {
     		my $routeit = adjust_hops($self, $_);
    -		$self->send($_) if $routeit;
    +		$self->send($routeit) if $routeit;
     	}
     	
     	# get all the users connected on the above nodes and send them out
    @@ -575,7 +583,7 @@ sub send_local_config
     		my @s = pc16($n, @users);
     		for (@s) {
     			my $routeit = adjust_hops($self, $_);
    -			$self->send($_) if $routeit;
    +			$self->send($routeit) if $routeit;
     		}
     	}
     }
    @@ -595,7 +603,7 @@ sub route
     		if ($dxchan) {
     			my $routeit = adjust_hops($dxchan, $line);   # adjust its hop count by node name
     			if ($routeit) {
    -				$dxchan->send($line) if $dxchan;
    +				$dxchan->send($routeit) if $dxchan;
     			}
     		}
     	}
    @@ -612,8 +620,8 @@ sub broadcast_ak1a
     	# send it if it isn't the except list and isn't isolated and still has a hop count
     	foreach $dxchan (@dxchan) {
     		next if grep $dxchan == $_, @except;
    -		my $routeit = adjust_hops($dxchan, $s);      # adjust its hop count by node name       
    -		$dxchan->send($s) unless $dxchan->{isolate} || !$routeit; 
    +		my $routeit = adjust_hops($dxchan, $s);      # adjust its hop count by node name
    +		$dxchan->send($routeit) unless $dxchan->{isolate} || !$routeit;
     	}
     }
     
    @@ -701,28 +709,29 @@ sub get_hops
     sub adjust_hops
     {
     	my $self = shift;
    +	my $s = 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;
    +	if (($hops) = $s =~ /\^H(\d+)\^~?$/o) {
    +		my ($pcno) = $s =~ /^PC(\d\d)/o;
    +		confess "$call called adjust_hops with '$s'" unless $pcno;
     		my $ref = $nodehops{$call} if %nodehops;
     		if ($ref) {
     			my $newhops = $ref->{$pcno};
    -			return 0 if defined $newhops && $newhops == 0;
    +			return "" if defined $newhops && $newhops == 0;
     			$newhops = $ref->{default} unless $newhops;
    -			return 0 if defined $newhops && $newhops == 0;
    +			return "" if defined $newhops && $newhops == 0;
     			$newhops = $hops if !$newhops;
    -			$_[0] =~ s/\^H(\d+)(\^~?)$/\^H$newhops$2/ if $newhops;
    +			$s =~ 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 "" if !$hops;
    +			$s =~ s/\^H(\d+)(\^~?)$/\^H$hops$2/ if $hops;
     		}
     	}
    -	return 1;
    +	return $s;
     }
     
     # 
    diff --git a/perl/client.pl b/perl/client.pl
    index 8d2d683b..c39bda4c 100755
    --- a/perl/client.pl
    +++ b/perl/client.pl
    @@ -26,6 +26,7 @@
     # $Id$
     # 
     
    +require 5.004;
     
     # search local then perl directories
     BEGIN {
    @@ -55,7 +56,10 @@ sub cease
     		$conn->send_now("Z$call|bye...\n");
     	}
     	$stdout->flush if $stdout;
    -	kill(15, $pid) if $pid;
    +	if ($pid) {
    +		dbg('connect', "killing $pid");
    +		kill(9, $pid);
    +	}
     	sleep(1);
     	exit(0);	
     }
    @@ -71,6 +75,7 @@ sub sig_chld
     {
     	$SIG{CHLD} = \&sig_chld;
     	$waitedpid = wait;
    +	dbg('connect', "caught $pid");
     }
     
     
    @@ -201,19 +206,18 @@ sub doconnect
     		my ($host, $port) = split /\s+/, $line;
     		$port = 23 if !$port;
     		
    -		if ($port == 23) {
    -			$sock = new Net::Telnet (Timeout => $timeout);
    +#		if ($port == 23) {
    +			$sock = new Net::Telnet (Timeout => $timeout, Port => $port);
     			$sock->option_callback(\&optioncb);
     			$sock->output_record_separator('');
     			$sock->option_log('option_log');
     			$sock->dump_log('dump');
     			$sock->option_accept(Wont => TELOPT_ECHO);
     			$sock->open($host) or die "Can't connect to $host port $port $!";
    -		} else {
    -			$sock = IO::Socket::INET->new(PeerAddr => "$host:$port", Proto => 'tcp')
    -				or die "Can't connect to $host port $port $!";
    -			
    -		}
    +#		} else {
    +#			$sock = IO::Socket::INET->new(PeerAddr => "$host:$port", Proto => 'tcp')
    +#				or die "Can't connect to $host port $port $!";
    +#		}
     	} elsif ($sort eq 'ax25' || $sort eq 'prog') {
     		my @args = split /\s+/, $line;
     		$rfh = new IO::File;
    @@ -282,7 +286,7 @@ sub dochat
     sub timeout
     {
     	dbg('connect', "timed out after $timeout seconds");
    -	cease(10);
    +	cease(0);
     }
     
     
    @@ -411,7 +415,7 @@ if ($connsort eq "connect") {
     	@in = ;
     	close IN;
     	
    -	#	alarm($timeout);
    +	alarm($timeout);
     	
     	for (@in) {
     		chomp;
    diff --git a/perl/cluster.pl b/perl/cluster.pl
    index 16a03037..32f90d88 100755
    --- a/perl/cluster.pl
    +++ b/perl/cluster.pl
    @@ -10,6 +10,8 @@
     # $Id$
     # 
     
    +require 5.004;
    +
     # make sure that modules are searched in the order local then perl
     BEGIN {
     	# root of directory tree for this system
    @@ -98,23 +100,16 @@ sub rec
     					return;
     				}
     			}
    +			$user->{lang} = $main::lang if !$user->{lang}; # to autoupdate old systems
     		} else {
    -			if (DXCluster->get($call) || DXChannel->get($call)) {
    +			if (DXCluster->get($call)) {
     				my $mess = DXM::msg($lang, 'conother', $call);
     				already_conn($conn, $call, $mess);
     				return;
     			}
    -		}
    -
    -		
    -		# the user MAY have an SSID if local, but otherwise doesn't
    -		$user = DXUser->get($call);
    -		if (!defined $user) {
     			$user = DXUser->new($call);
    -		} else {
    -			$user->{lang} = $main::lang if !$user->{lang}; # to autoupdate old systems
     		}
    -		
    +
     		# is he locked out ?
     		if ($user->lockout) {
     			Log('DXCommand', "$call is locked out, disconnected");
    -- 
    2.34.1
    
    
    From 4c0591c17b89dbb049ba119d3f3ea15c5b56128c Mon Sep 17 00:00:00 2001
    From: djk 
    Date: Mon, 21 Dec 1998 15:27:07 +0000
    Subject: [PATCH 09/16] removed extraneous help files from load
    
    ---
     cmd/load/aliases.hlp  | 0
     cmd/load/messages.hlp | 0
     2 files changed, 0 insertions(+), 0 deletions(-)
     delete mode 100644 cmd/load/aliases.hlp
     delete mode 100644 cmd/load/messages.hlp
    
    diff --git a/cmd/load/aliases.hlp b/cmd/load/aliases.hlp
    deleted file mode 100644
    index e69de29b..00000000
    diff --git a/cmd/load/messages.hlp b/cmd/load/messages.hlp
    deleted file mode 100644
    index e69de29b..00000000
    -- 
    2.34.1
    
    
    From d5b4190c36f130852973121042876af3c5642cd7 Mon Sep 17 00:00:00 2001
    From: djk 
    Date: Mon, 21 Dec 1998 23:49:08 +0000
    Subject: [PATCH 10/16] 1. fixed problem with missing DXDebug in DXProt. 2.
     Fixed DXDebug so that it actually works as advertised with and without
     trailing \n. 3. Added deduping of WWV spots as well (at for date,time,sfi,k
     and i) dups 4. Replaced the 0 in "02-Dec-1998" with ' ' so it reads "
     2-Dec-1998", it seems hard to credit it but some 'programs' out there that
     connect to clusters have problems with the leading '0'! 5. In the same vain,
     included a strictly AK1A compatible sh/heading, apparently this is necessary
     for the same reason as 4. 6. Started contrib tree stored the old show/heading
     in contrib/g0rdi/show. 7. Because I now correctly dedupe spots and wwv
     (there's a hostage to fortune..) I have added a merge command.
    
    ---
     Changes               |  13 +++
     cmd/Commands_en.hlp   |  13 ++-
     cmd/announce.pl       |   4 +-
     cmd/show/heading.pl   |  33 +++---
     cmd/show/wwv.pl       |   2 +-
     perl/DXChannel.pm     |  18 ++-
     perl/DXCommandmode.pm |  12 +-
     perl/DXDebug.pm       |  11 +-
     perl/DXProt.pm        |  69 ++++++++++--
     perl/DXUtil.pm        |   2 +-
     perl/Geomag.pm        |  32 ++++--
     perl/Messages         |   3 +
     perl/Prefix.pm        | 250 +++++++++++++++++++++---------------------
     perl/Spot.pm          | 194 +++++++++++++++++---------------
     perl/cluster.pl       |  10 +-
     15 files changed, 388 insertions(+), 278 deletions(-)
    
    diff --git a/Changes b/Changes
    index c8f8ee15..58f0b328 100644
    --- a/Changes
    +++ b/Changes
    @@ -1,3 +1,16 @@
    +21Dec98============= late! ====================================================
    +1. fixed problem with missing DXDebug in DXProt.
    +2. Fixed DXDebug so that it actually works as advertised with and without 
    +trailing \n. 
    +3. Added deduping of WWV spots as well (at for date,time,sfi,k and i) dups
    +4. Replaced the 0 in "02-Dec-1998" with ' ' so it reads " 2-Dec-1998", it seems
    +hard to credit it but some 'programs' out there that connect to clusters have
    +problems with the leading '0'!
    +5. In the same vain, included a strictly AK1A compatible sh/heading, apparently
    +this is necessary for the same reason as 4.
    +6. Started contrib tree stored the old show/heading in contrib/g0rdi/show.
    +7. Because I now correctly dedupe spots and wwv (there's a hostage to fortune..)
    +I have added a merge command. 
     21Dec98========================================================================
     1. Added "issue" to the client program for 'login' connections
     2. Added more docs for client program.
    diff --git a/cmd/Commands_en.hlp b/cmd/Commands_en.hlp
    index 80f2765a..368d57d5 100644
    --- a/cmd/Commands_en.hlp
    +++ b/cmd/Commands_en.hlp
    @@ -139,6 +139,15 @@ 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.
     
    +=== 5^MERGE  [/]^Ask for the latest spots and WWV 
    +MERGE allows you to bring your spot and wwv database up to date. By default
    +it will request the last 10 spots and 5 WWVs from the node you select. The 
    +node must be connected locally.
    +
    +You can request any number of spots or wwv and although they will be appended
    +to your databases they will not duplicate any that have recently been added 
    +(the last 2 days for spots and last month for WWV data).
    +
     === 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. 
    @@ -243,8 +252,8 @@ what your latitude and longitude is. If you have not yet done a SET/QRA
     then this command will set your QRA locator for you. For example:-
       SET/LOCATION 52 22 N 0 57 E
     
    -=== 0^SET/LOCKOUT ^Stop a callsign connecting to the cluster
    -=== 0^UNSET/LOCKOUT ^Allow a callsign to connect to the cluster
    +=== 9^SET/LOCKOUT ^Stop a callsign connecting to the cluster
    +=== 9^UNSET/LOCKOUT ^Allow a callsign to connect to the cluster
     
     === 0^SET/NAME ^Set your name
     Tell the system what your name is eg:-
    diff --git a/cmd/announce.pl b/cmd/announce.pl
    index b839e9c7..6c66bcd0 100644
    --- a/cmd/announce.pl
    +++ b/cmd/announce.pl
    @@ -39,10 +39,8 @@ if ($sort eq "FULL") {
     } elsif ($sort eq "LOCAL") {
       $line =~ s/^$f[0]\s+//;     # remove it
       $to = "LOCAL";
    -} elsif ($sort eq "") {
    -  $to = "LOCAL";
     } else {
    -  return (1, $self->msg('e11'));
    +  $to = "LOCAL";
     }
     
     Log('ann', $to, $from, $line);
    diff --git a/cmd/show/heading.pl b/cmd/show/heading.pl
    index aa7bb2f8..122ed5e4 100644
    --- a/cmd/show/heading.pl
    +++ b/cmd/show/heading.pl
    @@ -3,32 +3,33 @@
     #
     # $Id$
     #
    -
    +# AK1A-compatible output Iain Philipps, G0RDI 16-Dec-1998
    +#
     my ($self, $line) = @_;
    -my @list = split /\s+/, $line;		      # generate a list of callsigns
    +my @list = split /\s+/, $line;                # generate a list of callsigns
     
     my $l;
     my @out;
     my $lat = $self->user->lat;
     my $long = $self->user->long;
     if (!$long && !$lat) {
    -	push @out, $self->msg('heade1');
    -	$lat = $main::mylatitude;
    -	$long = $main::mylongitude;
    +        push @out, $self->msg('heade1');
    +        $lat = $main::mylatitude;
    +        $long = $main::mylongitude;
     }
     
     foreach $l (@list) {
    -	# prefixes --->
    -	my @ans = Prefix::extract($l);
    -	next if !@ans;
    -	my $pre = shift @ans;
    -	my $a;
    -	foreach $a (@ans) {
    -		my ($b, $dx) = DXBearing::bdist($lat, $long, $a->{lat}, $a->{long});
    -		my ($r, $rdx) = DXBearing::bdist($a->{lat}, $a->{long}, $lat, $long);
    -		push @out, sprintf "%-9s (%s, %s) Bearing: %.0f Recip: %.0f %.0fKm %.0fMi", uc $l, $pre, $a->name(), $b, $r, $dx, $dx * 0.62133785;
    -		$l = "";
    -	}
    +        # prefixes --->
    +        my @ans = Prefix::extract($l);
    +        next if !@ans;
    +        my $pre = shift @ans;
    +        my $a;
    +        foreach $a (@ans) {
    +                my ($b, $dx) = DXBearing::bdist($lat, $long, $a->{lat}, $a->{long});
    +                my ($r, $rdx) = DXBearing::bdist($a->{lat}, $a->{long}, $lat, $long);
    +                push @out, sprintf "%-2s %s: %.0f degs - dist: %.0f mi, %.0f km Reciprocal heading: %.0f degs", $pre, $a->name(), $b, $dx * 0.62133785, $dx, $r;
    +                $l = "";
    +        }
     }
     
     return (1, @out);
    diff --git a/cmd/show/wwv.pl b/cmd/show/wwv.pl
    index a8e4992a..ed5022d7 100644
    --- a/cmd/show/wwv.pl
    +++ b/cmd/show/wwv.pl
    @@ -21,7 +21,7 @@ while ($f = shift @f) {                 # next field
     		next if $from && $to > $from;
     	}
     	if (!$to) {
    -		($to) = $f =~ /^(\d+)$/o if !$to;              # is it a to count?
    +		($to) = $f =~ /^(\d+)$/o;              # is it a to count?
     		next if $to;
     	}
     }
    diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
    index 7319344c..8f641a44 100644
    --- a/perl/DXChannel.pm
    +++ b/perl/DXChannel.pm
    @@ -156,12 +156,11 @@ sub send_now
     	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;
    +	for (@_) {
    +		chomp;
    +		$conn->send_now("$sort$call|$_") if $conn;
    +		dbg('chan', "-> $sort $call $_") if $conn;
     	}
     	$self->{t} = time;
     }
    @@ -174,12 +173,11 @@ sub send						# this is always later and always data
     	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;
    +	for (@_) {
    +		chomp;
    +		$conn->send_later("D$call|$_") if $conn;
    +		dbg('chan', "-> D $call $_") if $conn;
     	}
     	$self->{t} = time;
     }
    diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
    index e8fd7d5a..1450a6c6 100644
    --- a/perl/DXCommandmode.pm
    +++ b/perl/DXCommandmode.pm
    @@ -258,12 +258,20 @@ sub finish
     {
     	my $self = shift;
     	my $call = $self->call;
    -	
    +
    +	# log out text
    +	if (-e "$main::data/logout") {
    +		open(I, "$main::data/logout") or confess;
    +		my @in = ;
    +		close(I);
    +		$self->sendnow('D', @in);
    +	}
    +
     	if ($call eq $main::myalias) { # unset the channel if it is us really
     		my $node = DXNode->get($main::mycall);
     		$node->{dxchan} = 0;
     	}
    -	my $ref = DXNodeuser->get($call);
    +	my $ref = DXCluster->get_exact($call);
     	
     	# issue a pc17 to everybody interested
     	my $nchan = DXChannel->get($main::mycall);
    diff --git a/perl/DXDebug.pm b/perl/DXDebug.pm
    index c03f92af..e19f309c 100644
    --- a/perl/DXDebug.pm
    +++ b/perl/DXDebug.pm
    @@ -29,13 +29,14 @@ sub dbg
     {
     	my $l = shift;
     	if ($dbglevel{$l}) {
    -		for (@_) {
    -			s/\n$//og;
    +	    my @in = @_;
    +		my $t = time;
    +		for (@in) {
    +		    s/\n$//o;
     			s/\a//og;   # beeps
    +			print "$_\n" if defined \*STDOUT;
    +			$fp->writeunix($t, "$t^$_");
     		}
    -		print "@_\n" if defined \*STDOUT;
    -		my $t = time;
    -		$fp->writeunix($t, "$t^@_");
     	}
     }
     
    diff --git a/perl/DXProt.pm b/perl/DXProt.pm
    index 15466e36..c1fad111 100644
    --- a/perl/DXProt.pm
    +++ b/perl/DXProt.pm
    @@ -21,15 +21,18 @@ use DXCommandmode;
     use DXLog;
     use Spot;
     use DXProtout;
    +use DXDebug;
     use Carp;
     
     use strict;
    -use vars qw($me $pc11_max_age $pc11_dup_age %dup $last_hour %pings %rcmds %nodehops);
    +use vars qw($me $pc11_max_age $pc11_dup_age $pc23_dup_age %spotdup %wwvdup $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
    -$pc11_dup_age = 24*3600;		# the maximum time to keep the dup list for
    -%dup = ();						# the pc11 and 26 dup hash 
    +$pc11_dup_age = 24*3600;		# the maximum time to keep the spot dup list for
    +$pc23_dup_age = 24*3600;		# the maximum time to keep the wwv dup list for
    +%spotdup = ();				    # the pc11 and 26 dup hash 
    +%wwvdup = ();				    # the pc23 and 27 dup hash 
     $last_hour = time;				# last time I did an hourly periodic update
     %pings = ();                    # outstanding ping requests outbound
     %rcmds = ();                    # outstanding rcmd requests outbound
    @@ -46,6 +49,24 @@ sub init
     	do "$main::data/hop_table.pl" if -e "$main::data/hop_table.pl";
     	confess $@ if $@;
     	#  $me->{sort} = 'M';    # M for me
    +
    +	# now prime the spot duplicates file with today's and yesterday's data
    +    my @today = Julian::unixtoj(time);
    +	my @spots = Spot::readfile(@today);
    +	@today = Julian::sub(@today, 1);
    +	push @spots, Spot::readfile(@today);
    +	for (@spots) {
    +		my $dupkey = "$_->[0]$_->[1]$_->[2]$_->[3]$_->[4]";
    +		$spotdup{$dupkey} = $_->[2];
    +	}
    +
    +	# now prime the wwv duplicates file with just this month's data
    +	my @wwv = Geomag::readfile(time);
    +	for (@wwv) {
    +		my $dupkey = "$_->[1].$_->[2]$_->[3]$_->[4]";
    +		$wwvdup{$dupkey} = $_->[1];
    +	}
    +
     }
     
     #
    @@ -135,7 +156,7 @@ sub normal
     			my $d = cltounix($field[3], $field[4]);
     			# bang out (and don't pass on) if date is invalid or the spot is too old
     			if (!$d || ($pcno == 11 && $d < $main::systime - $pc11_max_age)) {
    -				dbg('chan', "Spot ignored, invalid date or too old");
    +				dbg('chan', "Spot ignored, invalid date or too old\n");
     				return;
     			}
     
    @@ -147,21 +168,25 @@ sub normal
     			$spotter =~ s/-\d+$//o;	# strip off the ssid from the spotter
     			
     			# do some de-duping
    -			my $dupkey = "$field[1]$field[2]$d$text$field[6]";
    -			if ($dup{$dupkey}) {
    -				dbg('chan', "Duplicate Spot ignored");
    +			my $freq = $field[1] - 0;
    +			my $dupkey = "$freq$field[2]$d$text$spotter";
    +			if ($spotdup{$dupkey}) {
    +				dbg('chan', "Duplicate Spot ignored\n");
     				return;
     			}
     			
    -			$dup{$dupkey} = $d;
    +			$spotdup{$dupkey} = $d;
     			
    -			my $spot = Spot::add($field[1], $field[2], $d, $text, $spotter);
    +			my $spot = Spot::add($freq, $field[2], $d, $text, $spotter);
     			
     			# send orf to the users
     			if ($spot && $pcno == 11) {
     				my $buf = Spot::formatb($field[1], $field[2], $d, $text, $spotter);
     				broadcast_users("$buf\a\a");
     			}
    +
    +			# DON'T be silly and send on PC26s!
    +			return if $pcno == 26;
     			
     			last SWITCH;
     		}
    @@ -328,7 +353,23 @@ sub normal
     		}
     		
     		if ($pcno == 23 || $pcno == 27) { # WWV info
    -			Geomag::update(@field[1..$#field]);
    +			# do some de-duping
    +			my $d = cltounix($field[1], sprintf("%02d18Z", $field[2]));
    +			my $sfi = unpad($field[3]);
    +			my $k = unpad($field[4]);
    +			my $i = unpad($field[5]);
    +			my $dupkey = "$d.$sfi$k$i";
    +			if ($wwvdup{$dupkey}) {
    +				dbg('chan', "Dup WWV Spot ignored\n");
    +				return;
    +			}
    +			
    +			$wwvdup{$dupkey} = $d;
    +			Geomag::update($field[1], $field[2], $sfi, $k, $i, @field[6..$#field]);
    +
    +			# DON'T be silly and send on PC27s!
    +			return if $pcno == 27;
    +			
     			last SWITCH;
     		}
     		
    @@ -512,8 +553,12 @@ sub process
     	my $cutoff;
     	if ($main::systime - 3600 > $last_hour) {
     		$cutoff  = $main::systime - $pc11_dup_age;
    -		while (($key, $val) = each %dup) {
    -			delete $dup{$key} if $val < $cutoff;
    +		while (($key, $val) = each %spotdup) {
    +			delete $spotdup{$key} if $val < $cutoff;
    +		}
    +		$cutoff = $main::systime - $pc23_dup_age;
    +		while (($key, $val) = each %wwvdup) {
    +			delete $wwvdup{$key} if $val < $cutoff;
     		}
     		$last_hour = $main::systime;
     	}
    diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm
    index 5c6c51af..994cdd98 100644
    --- a/perl/DXUtil.pm
    +++ b/perl/DXUtil.pm
    @@ -46,7 +46,7 @@ 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;
    +	my $buf = sprintf "%2d-%s-%04d", $mday, $month[$mon], $year;
     	return $buf;
     }
     
    diff --git a/perl/Geomag.pm b/perl/Geomag.pm
    index a63d19b6..3ee01361 100644
    --- a/perl/Geomag.pm
    +++ b/perl/Geomag.pm
    @@ -142,13 +142,11 @@ sub forecast
     #
     sub print
     {
    -	my $self = $fp;
     	my $from = shift;
     	my $to = shift;
    -	my @date = $self->unixtoj(shift);
    +	my @date = $fp->unixtoj(shift);
     	my $pattern = shift;
     	my $search;
    -	my @in;
     	my @out;
     	my $eval;
     	my $count;
    @@ -161,19 +159,19 @@ sub print
     					\$ref = \$in[\$c];
     					if ($search) {
     						\$count++;
    -						next if \$count < $from;
    +						next if \$count < \$from;
     						push \@out, print_item(\$ref);
     						last LOOP if \$count >= \$to;                  # stop after n
     					}
     				}
     			  );
     	
    -	$self->close;                                      # close any open files
    +	$fp->close;                                      # close any open files
     
    -	my $fh = $self->open(@date); 
    +	my $fh = $fp->open(@date); 
     LOOP:
     	while ($count < $to) {
    -		my @spots = ();
    +		my @in = ();
     		if ($fh) {
     			while (<$fh>) {
     				chomp;
    @@ -182,7 +180,7 @@ LOOP:
     			eval $eval;               # do the search on this file
     			return ("Spot search error", $@) if $@;
     		}
    -		$fh = $self->openprev();      # get the next file
    +		$fh = $fp->openprev();      # get the next file
     		last if !$fh;
     	}
     
    @@ -209,5 +207,23 @@ sub print_item
     	return sprintf("$d   %02d %5d %3d %3d %-37s <%s>", $t, $ref[2], $ref[3], $ref[4], $ref[5], $ref[0]);
     }
     
    +#
    +# read in this month's data
    +#
    +sub readfile
    +{
    +	my @date = $fp->unixtoj(shift);
    +	my $fh = $fp->open(@date); 
    +	my @spots = ();
    +	my @in;
    +	
    +	if ($fh) {
    +		while (<$fh>) {
    +			chomp;
    +			push @in, [ split '\^' ] if length > 2;
    +		}
    +	}
    +	return @in;
    +}
     1;
     __END__;
    diff --git a/perl/Messages b/perl/Messages
    index 26bf7fa8..e43667bf 100644
    --- a/perl/Messages
    +++ b/perl/Messages
    @@ -39,6 +39,8 @@ package DXM;
     				e8 => 'Need a callsign and some text',
     				e9 => 'Need at least some text',
     				e10 => '$_[0] not connected locally',
    +				e12 => 'Need a node callsign',
    +				e13 => '$_[0] is not a node',
     				emaile1 => 'Please enter your email address, set/email ',
     				emaila => 'Your E-Mail Address is now \"$_[0]\"',
     				email => 'E-mail address set to: $_[0]',
    @@ -63,6 +65,7 @@ package DXM;
     				lockout => '$_[0] Locked out',
     				lockoutun => '$_[0] Unlocked',
     				m2 => '$_[0] Information: $_[1]',
    +				merge1 => 'Merge request for $_[1] spots and $_[2] WWV sent to $_[0]',
     				namee1 => 'Please enter your name, set/name ',
     				namee2 => 'Can\'t find user $_[0]!',
     				name => 'Your name is now \"$_[0]\"',
    diff --git a/perl/Prefix.pm b/perl/Prefix.pm
    index cab54cd8..ba9ea2b9 100644
    --- a/perl/Prefix.pm
    +++ b/perl/Prefix.pm
    @@ -17,66 +17,66 @@ use Carp;
     use strict;
     use vars qw($db  %prefix_loc %pre);
     
    -$db = undef;     # 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
     {
    -  if ($db) {
    -    untie %pre;
    -	%pre = ();
    -	%prefix_loc = ();
    -  }
    -  $db = tie(%pre, "DB_File", undef, O_RDWR|O_CREAT, 0666, $DB_BTREE) or confess "can't tie \%pre ($!)";  
    -  my $out = $@ if $@;
    -  do "$main::data/prefix_data.pl" if !$out;
    -  $out = $@ if $@;
    -#  print Data::Dumper->Dump([\%pre, \%prefix_loc], [qw(pre prefix_loc)]);
    -  return $out;
    +	if ($db) {
    +		untie %pre;
    +		%pre = ();
    +		%prefix_loc = ();
    +	}
    +	$db = tie(%pre, "DB_File", undef, O_RDWR|O_CREAT, 0666, $DB_BTREE) or confess "can't tie \%pre ($!)";  
    +	my $out = $@ if $@;
    +	do "$main::data/prefix_data.pl" if !$out;
    +	$out = $@ if $@;
    +	#  print Data::Dumper->Dump([\%pre, \%prefix_loc], [qw(pre prefix_loc)]);
    +	return $out;
     }
     
     sub store
     {
    -  my ($k, $l);
    -  my $fh = new FileHandle;
    -  my $fn = "$main::data/prefix_data.pl";
    +	my ($k, $l);
    +	my $fh = new FileHandle;
    +	my $fn = "$main::data/prefix_data.pl";
       
    -  confess "Prefix system not started" if !$db;
    +	confess "Prefix system not started" if !$db;
       
    -  # save versions!
    -  rename "$fn.oooo", "$fn.ooooo" if -e "$fn.oooo";
    -  rename "$fn.ooo", "$fn.oooo" if -e "$fn.ooo";
    -  rename "$fn.oo", "$fn.ooo" if -e "$fn.oo";
    -  rename "$fn.o", "$fn.oo" if -e "$fn.o";
    -  rename "$fn", "$fn.o" if -e "$fn";
    +	# save versions!
    +	rename "$fn.oooo", "$fn.ooooo" if -e "$fn.oooo";
    +	rename "$fn.ooo", "$fn.oooo" if -e "$fn.ooo";
    +	rename "$fn.oo", "$fn.ooo" if -e "$fn.oo";
    +	rename "$fn.o", "$fn.oo" if -e "$fn.o";
    +	rename "$fn", "$fn.o" if -e "$fn";
       
    -  $fh->open(">$fn") or die "Can't open $fn ($!)";
    -
    -  # prefix location data
    -  $fh->print("%prefix_loc = (\n");
    -  foreach $l (sort {$a <=> $b} keys %prefix_loc) {
    -    my $r = $prefix_loc{$l};
    -	$fh->printf("   $l => bless( { name => '%s', dxcc => %d, itu => %d, utcoff => %d, lat => %f, long => %f }, 'Prefix'),\n",
    -	            $r->{name}, $r->{dxcc}, $r->{itu}, $r->{cq}, $r->{utcoff}, $r->{lat}, $r->{long});
    -  }
    -  $fh->print(");\n\n");
    -
    -  # prefix data
    -  $fh->print("%pre = (\n");
    -  foreach $k (sort keys %pre) {
    -    $fh->print("   '$k' => [");
    -	my @list = @{$pre{$k}};
    -	my $l;
    -	my $str;
    -	foreach $l (@list) {
    -      $str .= " $l,";
    -    }
    -	chop $str;  
    -	$fh->print("$str ],\n");
    -  }
    -  $fh->print(");\n");
    -  $fh->close;
    +	$fh->open(">$fn") or die "Can't open $fn ($!)";
    +
    +	# prefix location data
    +	$fh->print("%prefix_loc = (\n");
    +	foreach $l (sort {$a <=> $b} keys %prefix_loc) {
    +		my $r = $prefix_loc{$l};
    +		$fh->printf("   $l => bless( { name => '%s', dxcc => %d, itu => %d, utcoff => %d, lat => %f, long => %f }, 'Prefix'),\n",
    +					$r->{name}, $r->{dxcc}, $r->{itu}, $r->{cq}, $r->{utcoff}, $r->{lat}, $r->{long});
    +	}
    +	$fh->print(");\n\n");
    +
    +	# prefix data
    +	$fh->print("%pre = (\n");
    +	foreach $k (sort keys %pre) {
    +		$fh->print("   '$k' => [");
    +		my @list = @{$pre{$k}};
    +		my $l;
    +		my $str;
    +		foreach $l (@list) {
    +			$str .= " $l,";
    +		}
    +		chop $str;  
    +		$fh->print("$str ],\n");
    +	}
    +	$fh->print(");\n");
    +	$fh->close;
     }
     
     # what you get is a list that looks like:-
    @@ -88,18 +88,18 @@ sub store
     #
     sub get
     {
    -  my $key = shift;
    -  my @out;
    -  my @outref;
    -  my $ref;
    -  my $gotkey;
    +	my $key = shift;
    +	my @out;
    +	my @outref;
    +	my $ref;
    +	my $gotkey;
       
    -  $gotkey = $key;
    -  return () if $db->seq($gotkey, $ref, R_CURSOR);
    -  return () if $key ne substr $gotkey, 0, length $key;
    +	$gotkey = $key;
    +	return () if $db->seq($gotkey, $ref, R_CURSOR);
    +	return () if $key ne substr $gotkey, 0, length $key;
     
    -  @outref = map { $prefix_loc{$_} } split ',', $ref;
    -  return ($gotkey, @outref);
    +	@outref = map { $prefix_loc{$_} } split ',', $ref;
    +	return ($gotkey, @outref);
     }
     
     #
    @@ -108,17 +108,17 @@ sub get
     # 
     sub next
     {
    -  my $key = shift;
    -  my @out;
    -  my @outref;
    -  my $ref;
    -  my $gotkey;
    +	my $key = shift;
    +	my @out;
    +	my @outref;
    +	my $ref;
    +	my $gotkey;
       
    -  return () if $db->seq($gotkey, $ref, R_NEXT);
    -  return () if $key ne substr $gotkey, 0, length $key;
    +	return () if $db->seq($gotkey, $ref, R_NEXT);
    +	return () if $key ne substr $gotkey, 0, length $key;
       
    -  @outref = map { $prefix_loc{$_} } split ',', $ref;
    -  return ($gotkey, @outref);
    +	@outref = map { $prefix_loc{$_} } split ',', $ref;
    +	return ($gotkey, @outref);
     }
     
     #
    @@ -131,75 +131,75 @@ sub next
     
     sub extract
     {
    -  my $call = uc shift;
    -  my @out;
    -  my @nout;
    -  my $p;
    -  my @parts;
    -  my ($sp, $i);
    +	my $call = uc shift;
    +	my @out;
    +	my @nout;
    +	my $p;
    +	my @parts;
    +	my ($sp, $i);
       
    -  # first check if the whole thing succeeds
    -  @out = get($call);
    -  return @out if @out > 0 && $out[0] eq $call;
    +	# first check if the whole thing succeeds
    +	@out = get($call);
    +	return @out if @out > 0 && $out[0] eq $call;
       
    -  # now split the call into parts if required
    -  @parts = ($call =~ '/') ? split('/', $call) : ($call);
    -
    -  # remove any /0-9 /P /A /M /MM /AM suffixes etc
    -  if (@parts > 1) {
    -    $p = $parts[$#parts];
    -	pop @parts if $p =~ /^(\d+|[PABM]|AM|MM|BCN|SIX|Q\w+)$/o;
    -    $p = $parts[$#parts];
    -	pop @parts if $p =~ /^(\d+|[PABM]|AM|MM|BCN|SIX|Q\w+)$/o;
    +	# now split the call into parts if required
    +	@parts = ($call =~ '/') ? split('/', $call) : ($call);
    +
    +	# remove any /0-9 /P /A /M /MM /AM suffixes etc
    +	if (@parts > 1) {
    +		$p = $parts[$#parts];
    +		pop @parts if $p =~ /^(\d+|[PABM]|AM|MM|BCN|SIX|Q\w+)$/o;
    +		$p = $parts[$#parts];
    +		pop @parts if $p =~ /^(\d+|[PABM]|AM|MM|BCN|SIX|Q\w+)$/o;
       
    -    # can we resolve them by direct lookup
    -	foreach $p (@parts) {
    -      @out = get($p);
    -	  return @out if @out > 0 && $out[0] eq $call;
    +		# can we resolve them by direct lookup
    +		foreach $p (@parts) {
    +			@out = get($p);
    +			return @out if @out > 0 && $out[0] eq $call;
    +		}
     	}
    -  }
       
    -  # which is the shortest part (first if equal)?
    -  $sp = $parts[0];
    -  foreach $p (@parts) {
    -    $sp = $p if length $sp > length $p;
    -  }
    -  # now start to resolve it from the left hand end
    -  for (@out = (), $i = 1; $i <= length $sp; ++$i) {
    -    @nout = get(substr($sp, 0, $i));
    -	last if @nout > 0 && $nout[0] gt $sp;
    -	last if @nout == 0;
    -	@out = @nout;
    -  }
    +	# which is the shortest part (first if equal)?
    +	$sp = $parts[0];
    +	foreach $p (@parts) {
    +		$sp = $p if length $sp > length $p;
    +	}
    +	# now start to resolve it from the left hand end
    +	for (@out = (), $i = 1; $i <= length $sp; ++$i) {
    +		@nout = get(substr($sp, 0, $i));
    +		last if @nout > 0 && $nout[0] gt $sp;
    +		last if @nout == 0;
    +		@out = @nout;
    +	}
       
    -  # not found
    -  return (@out > 0) ? @out : ();
    +	# not found
    +	return (@out > 0) ? @out : ();
     }
     
     my %valid = (
    -  lat => '0,Latitude,slat',
    -  long => '0,Longitude,slong',
    -  dxcc => '0,DXCC',
    -  name => '0,Name',
    -  itu => '0,ITU',
    -  cq => '0,CQ',
    -  utcoff => '0,UTC offset',
    -);
    +			 lat => '0,Latitude,slat',
    +			 long => '0,Longitude,slong',
    +			 dxcc => '0,DXCC',
    +			 name => '0,Name',
    +			 itu => '0,ITU',
    +			 cq => '0,CQ',
    +			 utcoff => '0,UTC offset',
    +			);
     
     no strict;
     sub AUTOLOAD
     {
    -  my $self = shift;
    -  my $name = $AUTOLOAD;
    +	my $self = shift;
    +	my $name = $AUTOLOAD;
       
    -  return if $name =~ /::DESTROY$/;
    -  $name =~ s/.*:://o;
    +	return if $name =~ /::DESTROY$/;
    +	$name =~ s/.*:://o;
       
    -  confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
    -  if (@_) {
    -    $self->{$name} = shift;
    -  }
    -  return $self->{$name};
    +	confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
    +	if (@_) {
    +		$self->{$name} = shift;
    +	}
    +	return $self->{$name};
     }
     use strict;
     
    @@ -209,8 +209,8 @@ use strict;
     
     sub field_prompt
     { 
    -  my ($self, $ele) = @_;
    -  return $valid{$ele};
    +	my ($self, $ele) = @_;
    +	return $valid{$ele};
     }
     1;
     
    diff --git a/perl/Spot.pm b/perl/Spot.pm
    index 7fb1c227..b8938bb9 100644
    --- a/perl/Spot.pm
    +++ b/perl/Spot.pm
    @@ -21,9 +21,9 @@ use strict;
     use vars qw($fp $maxspots $defaultspots $maxdays $dirprefix);
     
     $fp = undef;
    -$maxspots = 50;      # maximum spots to return
    -$defaultspots = 10;    # normal number of spots to return
    -$maxdays = 35;        # normal maximum no of days to go back
    +$maxspots = 50;					# maximum spots to return
    +$defaultspots = 10;				# normal number of spots to return
    +$maxdays = 35;					# normal maximum no of days to go back
     $dirprefix = "spots";
     
     sub init
    @@ -34,32 +34,32 @@ sub init
     
     sub prefix
     {
    -  return $fp->{prefix};
    +	return $fp->{prefix};
     }
     
     # add a spot to the data file (call as Spot::add)
     sub add
     {
    -  my @spot = @_;    # $freq, $call, $t, $comment, $spotter = @_
    +	my @spot = @_;				# $freq, $call, $t, $comment, $spotter = @_
     
    -  # sure that the numeric things are numeric now (saves time later)
    -  $spot[0] = 0 + $spot[0];
    -  $spot[2] = 0 + $spot[2];
    +	# sure that the numeric things are numeric now (saves time later)
    +	$spot[0] = 0 + $spot[0];
    +	$spot[2] = 0 + $spot[2];
       
    -  # remove ssid if present on spotter
    -  $spot[4] =~ s/-\d+$//o;
    +	# remove ssid if present on spotter
    +	$spot[4] =~ s/-\d+$//o;
     
    -  # add the 'dxcc' country on the end
    -  my @dxcc = Prefix::extract($spot[1]);
    -  push @spot, (@dxcc > 0 ) ? $dxcc[1]->dxcc() : 0;
    +	# add the 'dxcc' country on the end
    +	my @dxcc = Prefix::extract($spot[1]);
    +	push @spot, (@dxcc > 0 ) ? $dxcc[1]->dxcc() : 0;
     
    -  my $buf = join("\^", @spot);
    +	my $buf = join("\^", @spot);
     
    -  # compare dates to see whether need to open another save file (remember, redefining $fp 
    -  # automagically closes the output file (if any)). 
    -  $fp->writeunix($spot[2], $buf);
    +	# compare dates to see whether need to open another save file (remember, redefining $fp 
    +	# automagically closes the output file (if any)). 
    +	$fp->writeunix($spot[2], $buf);
       
    -  return $buf;
    +	return $buf;
     }
     
     # search the spot database for records based on the field no and an expression
    @@ -86,93 +86,109 @@ sub add
     
     sub search
     {
    -  my ($expr, $dayfrom, $dayto, $from, $to) = @_;
    -  my $eval;
    -  my @out;
    -  my $ref;
    -  my $i;
    -  my $count;
    -  my @today = Julian::unixtoj(time);
    -  my @fromdate;
    -  my @todate;
    +	my ($expr, $dayfrom, $dayto, $from, $to) = @_;
    +	my $eval;
    +	my @out;
    +	my $ref;
    +	my $i;
    +	my $count;
    +	my @today = Julian::unixtoj(time);
    +	my @fromdate;
    +	my @todate;
       
    -  if ($dayfrom > 0) {
    -    @fromdate = Julian::sub(@today, $dayfrom);
    -  } else {
    -    @fromdate = @today;
    -	$dayfrom = 0;
    -  }
    -  if ($dayto > 0) {
    -    @todate = Julian::sub(@fromdate, $dayto);
    -  } else {
    -    @todate = Julian::sub(@fromdate, $maxdays);
    -  }
    -  if ($from || $to) {
    -    $to = $from + $maxspots if $to - $from > $maxspots || $to - $from <= 0;
    -  } else {
    -    $from = 0;
    -	$to = $defaultspots;
    -  }
    -
    -  $expr =~ s/\$f(\d)/\$ref->[$1]/g;               # swap the letter n for the correct field name
    -#  $expr =~ s/\$f(\d)/\$spots[$1]/g;               # swap the letter n for the correct field name
    +	if ($dayfrom > 0) {
    +		@fromdate = Julian::sub(@today, $dayfrom);
    +	} else {
    +		@fromdate = @today;
    +		$dayfrom = 0;
    +	}
    +	if ($dayto > 0) {
    +		@todate = Julian::sub(@fromdate, $dayto);
    +	} else {
    +		@todate = Julian::sub(@fromdate, $maxdays);
    +	}
    +	if ($from || $to) {
    +		$to = $from + $maxspots if $to - $from > $maxspots || $to - $from <= 0;
    +	} else {
    +		$from = 0;
    +		$to = $defaultspots;
    +	}
    +
    +	$expr =~ s/\$f(\d)/\$ref->[$1]/g; # swap the letter n for the correct field name
    +	#  $expr =~ s/\$f(\d)/\$spots[$1]/g;               # swap the letter n for the correct field name
       
    -  dbg("search", "expr='$expr', spotno=$from-$to, day=$dayfrom-$dayto\n");
    +	dbg("search", "expr='$expr', spotno=$from-$to, day=$dayfrom-$dayto\n");
       
    -  # build up eval to execute
    -  $eval = qq(
    -    my \$c;
    -	my \$ref;
    -    for (\$c = \$#spots; \$c >= 0; \$c--) {
    -	  \$ref = \$spots[\$c];
    -	  if ($expr) {
    -	    \$count++;
    -		next if \$count < \$from;                  # wait until from 
    -        push(\@out, \$ref);
    -		last LOOP if \$count >= \$to;                  # stop after to
    -	  }
    -    }
    -  );
    -
    -  $fp->close;                                      # close any open files
    -
    -LOOP:
    -  for ($i = 0; $i < $maxdays; ++$i) {             # look thru $maxdays worth of files only
    -    my @now = Julian::sub(@fromdate, $i);         # but you can pick which $maxdays worth
    -	last if Julian::cmp(@now, @todate) <= 0;         
    +	# build up eval to execute
    +	$eval = qq(
    +			   my \$c;
    +			   my \$ref;
    +			   for (\$c = \$	#spots; \$c >= 0; \$c--) {
    +					\$ref = \$spots[\$c];
    +					if ($expr) {
    +						\$count++;
    +						next if \$count < \$from; # wait until from 
    +						push(\@out, \$ref);
    +						last LOOP if \$count >= \$to; # stop after to
    +					}
    +				}
    +			  );
    +
    +	$fp->close;					# close any open files
    +
    + LOOP:
    +	for ($i = 0; $i < $maxdays; ++$i) {	# look thru $maxdays worth of files only
    +		my @now = Julian::sub(@fromdate, $i); # but you can pick which $maxdays worth
    +		last if Julian::cmp(@now, @todate) <= 0;         
     	
    -	my @spots = ();
    -	my $fh = $fp->open(@now);  # get the next file
    -	if ($fh) {
    -	  my $in;
    -	  while (<$fh>) {
    -		  chomp;
    -		  push @spots, [ split '\^' ];
    -	  }
    -	  eval $eval;               # do the search on this file
    -	  return ("Spot search error", $@) if $@;
    +		my @spots = ();
    +		my $fh = $fp->open(@now); # get the next file
    +		if ($fh) {
    +			my $in;
    +			while (<$fh>) {
    +				chomp;
    +				push @spots, [ split '\^' ];
    +			}
    +			eval $eval;			# do the search on this file
    +			return ("Spot search error", $@) if $@;
    +		}
     	}
    -  }
     
    -  return @out;
    +	return @out;
     }
     
     # format a spot for user output in 'broadcast' mode
     sub formatb
     {
    -  my @dx = @_;
    -  my $t = ztime($dx[2]);
    -  return sprintf "DX de %-7.7s%11.1f  %-12.12s %-30s %s", "$dx[4]:", $dx[0], $dx[1], $dx[3], $t ;
    +	my @dx = @_;
    +	my $t = ztime($dx[2]);
    +	return sprintf "DX de %-7.7s%11.1f  %-12.12s %-30s %s", "$dx[4]:", $dx[0], $dx[1], $dx[3], $t ;
     }
     
     # format a spot for user output in list mode
     sub formatl
     {
    -  my @dx = @_;
    -  my $t = ztime($dx[2]);
    -  my $d = cldate($dx[2]);
    -  return sprintf "%8.1f  %-11s %s %s  %-28.28s%7s>", $dx[0], $dx[1], $d, $t, $dx[3], "<$dx[4]" ;
    +	my @dx = @_;
    +	my $t = ztime($dx[2]);
    +	my $d = cldate($dx[2]);
    +	return sprintf "%8.1f  %-11s %s %s  %-28.28s%7s>", $dx[0], $dx[1], $d, $t, $dx[3], "<$dx[4]" ;
     }
     
    -
    +#
    +# return all the spots from a day's file as an array of references
    +# the parameter passed is a julian day
    +sub readfile
    +{
    +	my @spots;
    +	
    +	my $fh = $fp->open(@_); 
    +	if ($fh) {
    +		my $in;
    +		while (<$fh>) {
    +			chomp;
    +			push @spots, [ split '\^' ];
    +		}
    +	}
    +	return @spots;
    +}
     1;
    diff --git a/perl/cluster.pl b/perl/cluster.pl
    index 32f90d88..26f3b97a 100755
    --- a/perl/cluster.pl
    +++ b/perl/cluster.pl
    @@ -50,7 +50,7 @@ package main;
     
     @inqueue = ();					# the main input queue, an array of hashes
     $systime = 0;					# the time now (in seconds)
    -$version = "1.13";				# the version no of the software
    +$version = "1.14";				# the version no of the software
     $starttime = 0;                 # the starting time of the cluster   
      
     # handle disconnections
    @@ -245,15 +245,17 @@ DXM->init();
     # read in command aliases
     CmdAlias->init();
     
    -# initialise the protocol engine
    -DXProt->init();
    -
     # initialise the Geomagnetic data engine
     Geomag->init();
     
     # initial the Spot stuff
     Spot->init();
     
    +# initialise the protocol engine
    +print "reading in duplicate spot and WWV info ...\n";
    +DXProt->init();
    +
    +
     # put in a DXCluster node for us here so we can add users and take them away
     DXNode->new(0, $mycall, 0, 1, $DXProt::myprot_version); 
     
    -- 
    2.34.1
    
    
    From 607875172776440f54ab90d611d81661f279326b Mon Sep 17 00:00:00 2001
    From: djk 
    Date: Tue, 22 Dec 1998 00:24:47 +0000
    Subject: [PATCH 11/16] fixed little buglet on logout text
    
    ---
     perl/DXCommandmode.pm | 3 ++-
     1 file changed, 2 insertions(+), 1 deletion(-)
    
    diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
    index 1450a6c6..da449f72 100644
    --- a/perl/DXCommandmode.pm
    +++ b/perl/DXCommandmode.pm
    @@ -264,7 +264,8 @@ sub finish
     		open(I, "$main::data/logout") or confess;
     		my @in = ;
     		close(I);
    -		$self->sendnow('D', @in);
    +		$self->send_now('D', @in);
    +		sleep(1);
     	}
     
     	if ($call eq $main::myalias) { # unset the channel if it is us really
    -- 
    2.34.1
    
    
    From 8b8c9033879165730ca7601c2364e315782f25c7 Mon Sep 17 00:00:00 2001
    From: djk 
    Date: Tue, 22 Dec 1998 00:26:14 +0000
    Subject: [PATCH 12/16] *** empty log message ***
    
    ---
     contrib/g0rdi/show/heading.pl | 34 ++++++++++++++++++++++++++++++++++
     1 file changed, 34 insertions(+)
     create mode 100644 contrib/g0rdi/show/heading.pl
    
    diff --git a/contrib/g0rdi/show/heading.pl b/contrib/g0rdi/show/heading.pl
    new file mode 100644
    index 00000000..aa7bb2f8
    --- /dev/null
    +++ b/contrib/g0rdi/show/heading.pl
    @@ -0,0 +1,34 @@
    +#
    +# show the heading and distance for each callsign or prefix entered
    +#
    +# $Id$
    +#
    +
    +my ($self, $line) = @_;
    +my @list = split /\s+/, $line;		      # generate a list of callsigns
    +
    +my $l;
    +my @out;
    +my $lat = $self->user->lat;
    +my $long = $self->user->long;
    +if (!$long && !$lat) {
    +	push @out, $self->msg('heade1');
    +	$lat = $main::mylatitude;
    +	$long = $main::mylongitude;
    +}
    +
    +foreach $l (@list) {
    +	# prefixes --->
    +	my @ans = Prefix::extract($l);
    +	next if !@ans;
    +	my $pre = shift @ans;
    +	my $a;
    +	foreach $a (@ans) {
    +		my ($b, $dx) = DXBearing::bdist($lat, $long, $a->{lat}, $a->{long});
    +		my ($r, $rdx) = DXBearing::bdist($a->{lat}, $a->{long}, $lat, $long);
    +		push @out, sprintf "%-9s (%s, %s) Bearing: %.0f Recip: %.0f %.0fKm %.0fMi", uc $l, $pre, $a->name(), $b, $r, $dx, $dx * 0.62133785;
    +		$l = "";
    +	}
    +}
    +
    +return (1, @out);
    -- 
    2.34.1
    
    
    From 4f4cd7ea04f04162f2e755981b4c716deb792cef Mon Sep 17 00:00:00 2001
    From: djk 
    Date: Tue, 22 Dec 1998 00:52:54 +0000
    Subject: [PATCH 13/16] added set/password added brackets for nohere
    
    ---
     Changes               |  3 +++
     cmd/set/password.pl   | 30 ++++++++++++++++++++++++++++++
     perl/DXCommandmode.pm |  4 +---
     perl/Messages         |  3 +++
     4 files changed, 37 insertions(+), 3 deletions(-)
    
    diff --git a/Changes b/Changes
    index 58f0b328..8b4c925d 100644
    --- a/Changes
    +++ b/Changes
    @@ -1,3 +1,6 @@
    +22Dec98========================================================================
    +1. Added brackets round callsign if not here for prompt
    +2. Added Iain's set/password routine
     21Dec98============= late! ====================================================
     1. fixed problem with missing DXDebug in DXProt.
     2. Fixed DXDebug so that it actually works as advertised with and without 
    diff --git a/cmd/set/password.pl b/cmd/set/password.pl
    index e69de29b..b408278d 100644
    --- a/cmd/set/password.pl
    +++ b/cmd/set/password.pl
    @@ -0,0 +1,30 @@
    +#
    +# set a user's password
    +#
    +# Copyright (c) 1998 Iain Phillips G0RDI
    +# 21-Dec-1998
    +#
    +# Syntax:	set/pass  
    +#
    +
    +my ($self, $line) = @_;
    +my @args = split /\s+/, $line;
    +my $call;
    +my $pass = shift @args;
    +my @out;
    +my $user;
    +my $ref;
    +
    +return (1, $self->msg('e5')) if $self->priv < 9;
    +
    +foreach $call (@args) {
    +	$call = uc $call;
    +	if ($ref = DXUser->get_current($call)) {
    +		$ref->passwd($pass);
    +		$ref->put();
    +		push @out, $self->msg("password", $call);
    +	} else {
    +		push @out, $self->msg('e3', 'User record for', $call);
    +	}
    +}
    +return (1, @out);
    diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
    index da449f72..e429654c 100644
    --- a/perl/DXCommandmode.pm
    +++ b/perl/DXCommandmode.pm
    @@ -290,9 +290,7 @@ sub finish
     sub prompt
     {
     	my $self = shift;
    -	my $call = $self->{call};
    -	$self->send($self->msg('pr', $call));
    -	#DXChannel::msg($self, 'pr', $call);
    +	$self->send($self->msg($self->here ? 'pr' : 'pr2', $self->call));
     }
     
     # broadcast a message to all users [except those mentioned after buffer]
    diff --git a/perl/Messages b/perl/Messages
    index e43667bf..cd4b12ab 100644
    --- a/perl/Messages
    +++ b/perl/Messages
    @@ -76,9 +76,12 @@ package DXM;
     				ok => 'Operation successful',
     				page => 'Press Enter to continue, A to abort ($_[0] lines) >',
     				pagelth => 'Page Length is now $_[0]',
    +				passerr => 'Please use: SET/PASS  ',
    +				password => 'Password set or changed for $_[0]',
     				pingo => 'Ping Started to $_[0]',
     				pingi => 'Ping Returned from $_[0] ($_[2] secs)',
     				pr => '$_[0] de $main::mycall $main::cldate $main::ztime >',
    +				pr2 => '($_[0]) de $main::mycall $main::cldate $main::ztime >',
     				priv => 'Privilege level changed on $_[0]',
     				prx => '$main::mycall >',
     				qll => 'Please enter your location with set/location or set/qra',
    -- 
    2.34.1
    
    
    From 8195bc13ac14b8fbf13d804186680653b5fd8564 Mon Sep 17 00:00:00 2001
    From: djk 
    Date: Tue, 22 Dec 1998 12:55:12 +0000
    Subject: [PATCH 14/16] fixed sh/dx
    
    ---
     cmd/show/configuration.pl |   2 +-
     cmd/show/dx.pl            | 128 +++++++++++++++++++-------------------
     perl/DXCommandmode.pm     |   6 +-
     perl/Spot.pm              |  32 ++++------
     perl/cluster.pl           |   2 +-
     5 files changed, 79 insertions(+), 91 deletions(-)
    
    diff --git a/cmd/show/configuration.pl b/cmd/show/configuration.pl
    index 4cd50e26..a7a1773b 100644
    --- a/cmd/show/configuration.pl
    +++ b/cmd/show/configuration.pl
    @@ -15,7 +15,7 @@ my @l;
     my @val;
     
     push @out, "Node         Callsigns";
    -if ($list[0] =~ /^NOD/) {
    +if ($list[0] && $list[0] =~ /^NOD/) {
     	my @ch = DXProt::get_all_ak1a();
     	my $dxchan;
     	
    diff --git a/cmd/show/dx.pl b/cmd/show/dx.pl
    index 42fb646c..06cc5d04 100644
    --- a/cmd/show/dx.pl
    +++ b/cmd/show/dx.pl
    @@ -5,7 +5,7 @@
     #
     
     my ($self, $line) = @_;
    -my @list = split /\s+/, $line;		      # split the line up
    +my @list = split /\s+/, $line;	# split the line up
     
     my @out;
     my $f;
    @@ -19,85 +19,85 @@ my $spotter;
     my $info;
     my $expr;
     
    -while ($f = shift @list) {                 # next field
    -#  print "f: $f list: ", join(',', @list), "\n";
    -  if (!$from && !$to) {
    -    ($from, $to) = $f =~ /^(\d+)-(\d+)$/o;         # is it a from -> to count?
    -    next if $from && $to > $from;
    -  }
    -  if (!$to) {
    -    ($to) = $f =~ /^(\d+)$/o if !$to;              # is it a to count?
    -    next if $to;
    -  }
    -  if (lc $f eq 'on' && $list[0]) {                  # is it freq range?
    -#    print "yup freq\n";
    -    my @r = split '/', $list[0];
    -#	print "r0: $r[0] r1: $r[1]\n";
    -	@freq = Bands::get_freq($r[0], $r[1]);
    -	if (@freq) {                 # yup, get rid of extranous param
    -#	  print "freq: ", join(',', @freq), "\n";
    -	  shift @list;
    -	  next;
    +while ($f = shift @list) {		# next field
    +	#  print "f: $f list: ", join(',', @list), "\n";
    +	if (!$from && !$to) {
    +		($from, $to) = $f =~ /^(\d+)-(\d+)$/o; # is it a from -> to count?
    +		next if $from && $to > $from;
    +	}
    +	if (!$to) {
    +		($to) = $f =~ /^(\d+)$/o if !$to; # is it a to count?
    +		next if $to;
    +	}
    +	if (lc $f eq 'on' && $list[0]) { # is it freq range?
    +		#    print "yup freq\n";
    +		my @r = split '/', $list[0];
    +		#	print "r0: $r[0] r1: $r[1]\n";
    +		@freq = Bands::get_freq($r[0], $r[1]);
    +		if (@freq) {			# yup, get rid of extranous param
    +			#	  print "freq: ", join(',', @freq), "\n";
    +			shift @list;
    +			next;
    +		}
    +	}
    +	if (lc $f eq 'day' && $list[0]) {
    +		#   print "got day\n";
    +		($fromday, $today) = split '-', shift(@list);
    +		next;
    +	}
    +	if (lc $f eq 'info' && $list[0]) {
    +		#   print "got info\n";
    +		$info = shift @list;
    +		next;
    +	}
    +	if (lc $f eq 'spotter' && $list[0]) {
    +		#    print "got spotter\n";
    +		$spotter = uc shift @list;
    +		next;
    +	}
    +	if (!$pre) {
    +		$pre = uc $f;
     	}
    -  }
    -  if (lc $f eq 'day' && $list[0]) {
    -#   print "got day\n";
    -    ($fromday, $today) = split '-', shift(@list);
    -	next;
    -  }
    -  if (lc $f eq 'info' && $list[0]) {
    -#   print "got info\n";
    -	$info = shift @list;
    -	next;
    -  }
    -  if (lc $f eq 'spotter' && $list[0]) {
    -#    print "got spotter\n";
    -	$spotter = uc shift @list;
    -	next;
    -  }
    -  if (!$pre) {
    -    $pre = uc $f;
    -  }
     }
     
     # first deal with the prefix
     if ($pre) {
    -  $expr = "\$f1 =~ /";
    -  $pre =~ s|/|\\/|;          # change the slashes to \/ 
    -  if ($pre =~ /^\*/o) {
    -    $pre =~ s/^\*//;;
    -    $expr .= "$pre\$/o";
    -  } else {
    -	$expr .= "^$pre/o";
    -  }
    +	$expr = "\$f1 =~ /";
    +	$pre =~ s|/|\\/|;			# change the slashes to \/ 
    +	if ($pre =~ /^\*/o) {
    +		$pre =~ s/^\*//;;
    +		$expr .= "$pre\$/o";
    +	} else {
    +		$expr .= "^$pre/o";
    +	}
     } else {
    -  $expr = "1";             # match anything
    +	$expr = "1";				# match anything
     }
       
     # now deal with any frequencies specified
     if (@freq) {
    -  $expr .= ($expr) ? " && (" : "(";
    -  my $i;
    -  for ($i; $i < @freq; $i += 2) {
    -    $expr .= "(\$f0 >= $freq[$i] && \$f0 <= $freq[$i+1]) ||";
    -  }
    -  chop $expr;
    -  chop $expr;
    -  $expr .= ")";
    +	$expr .= ($expr) ? " && (" : "(";
    +	my $i;
    +	for ($i = 0; $i < @freq; $i += 2) {
    +		$expr .= "(\$f0 >= $freq[$i] && \$f0 <= $freq[$i+1]) ||";
    +	}
    +	chop $expr;
    +	chop $expr;
    +	$expr .= ")";
     }
     
     # any info
     if ($info) {
    -  $expr .= " && " if $expr;
    -  $info =~ s|/|\\/|;
    -  $expr .= "\$f3 =~ /$info/io";
    +	$expr .= " && " if $expr;
    +	$info =~ s|/|\\/|;
    +	$expr .= "\$f3 =~ /$info/io";
     }
     
     # any spotter
     if ($spotter) {
    -  $expr .= " && " if $expr;
    -  $spotter =~ s|/|\\/|;
    -  $expr .= "\$f4 =~ /$spotter/o";
    +	$expr .= " && " if $expr;
    +	$spotter =~ s|/|\\/|;
    +	$expr .= "\$f4 =~ /$spotter/o";
     }
     
     #print "expr: $expr from: $from to: $to fromday: $fromday today: $today\n";
    @@ -107,8 +107,8 @@ my @res = Spot::search($expr, $fromday, $today, $from, $to);
     my $ref;
     my @dx;
     foreach $ref (@res) {
    -  @dx = @$ref;
    -  push @out, Spot::formatl(@dx);
    +	@dx = @$ref;
    +	push @out, Spot::formatl(@dx);
     }
     
     return (1, @out);
    diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
    index e429654c..0f802d89 100644
    --- a/perl/DXCommandmode.pm
    +++ b/perl/DXCommandmode.pm
    @@ -488,11 +488,7 @@ sub find_cmd_name {
     		close $fh;
     		
     		#wrap the code into a subroutine inside our unique package
    -		my $eval = qq{ 
    -			sub $package 
    -			{ 
    -			 $sub 
    -			} };
    +		my $eval = qq{ sub $package { $sub } };
     		
     		if (isdbg('eval')) {
     			my @list = split /\n/, $eval;
    diff --git a/perl/Spot.pm b/perl/Spot.pm
    index b8938bb9..5831e9b3 100644
    --- a/perl/Spot.pm
    +++ b/perl/Spot.pm
    @@ -95,24 +95,15 @@ sub search
     	my @today = Julian::unixtoj(time);
     	my @fromdate;
     	my @todate;
    -  
    -	if ($dayfrom > 0) {
    -		@fromdate = Julian::sub(@today, $dayfrom);
    -	} else {
    -		@fromdate = @today;
    -		$dayfrom = 0;
    -	}
    -	if ($dayto > 0) {
    -		@todate = Julian::sub(@fromdate, $dayto);
    -	} else {
    -		@todate = Julian::sub(@fromdate, $maxdays);
    -	}
    -	if ($from || $to) {
    -		$to = $from + $maxspots if $to - $from > $maxspots || $to - $from <= 0;
    -	} else {
    -		$from = 0;
    -		$to = $defaultspots;
    -	}
    +
    +	$dayfrom = 0 if !$dayfrom;
    +	$dayto = $maxdays if !$dayto;
    +	@fromdate = Julian::sub(@today, $dayfrom);
    +	@todate = Julian::sub(@fromdate, $dayto);
    +	$from = 0 unless $from;
    +	$to = $defaultspots unless $to;
    +	
    +	$to = $from + $maxspots if $to - $from > $maxspots || $to - $from <= 0;
     
     	$expr =~ s/\$f(\d)/\$ref->[$1]/g; # swap the letter n for the correct field name
     	#  $expr =~ s/\$f(\d)/\$spots[$1]/g;               # swap the letter n for the correct field name
    @@ -123,13 +114,13 @@ sub search
     	$eval = qq(
     			   my \$c;
     			   my \$ref;
    -			   for (\$c = \$	#spots; \$c >= 0; \$c--) {
    +			   for (\$c = \$#spots; \$c >= 0; \$c--) {
     					\$ref = \$spots[\$c];
     					if ($expr) {
     						\$count++;
     						next if \$count < \$from; # wait until from 
     						push(\@out, \$ref);
    -						last LOOP if \$count >= \$to; # stop after to
    +						last if \$count >= \$to; # stop after to
     					}
     				}
     			  );
    @@ -150,6 +141,7 @@ sub search
     				push @spots, [ split '\^' ];
     			}
     			eval $eval;			# do the search on this file
    +			last if $count >= $to; # stop after to
     			return ("Spot search error", $@) if $@;
     		}
     	}
    diff --git a/perl/cluster.pl b/perl/cluster.pl
    index 26f3b97a..e671c5d4 100755
    --- a/perl/cluster.pl
    +++ b/perl/cluster.pl
    @@ -91,7 +91,7 @@ sub rec
     		# is there one already connected elsewhere in the cluster (and not a cluster)
     		my $user = DXUser->get($call);
     		if ($user) {
    -			if (($user->sort eq 'A' || $call == $myalias) && !DXCluster->get_exact($call)) {
    +			if (($user->sort eq 'A' || $call eq $myalias) && !DXCluster->get_exact($call)) {
     				;
     			} else {
     				if (DXCluster->get($call) || DXChannel->get($call)) {
    -- 
    2.34.1
    
    
    From 8076ca2b9ae6ee5c5fc567151b5d6a910d545bfe Mon Sep 17 00:00:00 2001
    From: djk 
    Date: Tue, 22 Dec 1998 12:56:36 +0000
    Subject: [PATCH 15/16] *** empty log message ***
    
    ---
     Changes | 1 +
     1 file changed, 1 insertion(+)
    
    diff --git a/Changes b/Changes
    index 8b4c925d..544578df 100644
    --- a/Changes
    +++ b/Changes
    @@ -1,6 +1,7 @@
     22Dec98========================================================================
     1. Added brackets round callsign if not here for prompt
     2. Added Iain's set/password routine
    +3. Fixed sh/dx problems (the xemacs indent region messed Spot.pm up!)
     21Dec98============= late! ====================================================
     1. fixed problem with missing DXDebug in DXProt.
     2. Fixed DXDebug so that it actually works as advertised with and without 
    -- 
    2.34.1
    
    
    From 5f1ef9f393b44a1e4b29b290332c386cfadcb5de Mon Sep 17 00:00:00 2001
    From: djk 
    Date: Tue, 22 Dec 1998 12:58:13 +0000
    Subject: [PATCH 16/16] issued 1.15
    
    ---
     Changes         | 1 +
     perl/cluster.pl | 2 +-
     2 files changed, 2 insertions(+), 1 deletion(-)
    
    diff --git a/Changes b/Changes
    index 544578df..8d46b7ab 100644
    --- a/Changes
    +++ b/Changes
    @@ -2,6 +2,7 @@
     1. Added brackets round callsign if not here for prompt
     2. Added Iain's set/password routine
     3. Fixed sh/dx problems (the xemacs indent region messed Spot.pm up!)
    +4. Issued 1.15
     21Dec98============= late! ====================================================
     1. fixed problem with missing DXDebug in DXProt.
     2. Fixed DXDebug so that it actually works as advertised with and without 
    diff --git a/perl/cluster.pl b/perl/cluster.pl
    index e671c5d4..f0fced78 100755
    --- a/perl/cluster.pl
    +++ b/perl/cluster.pl
    @@ -50,7 +50,7 @@ package main;
     
     @inqueue = ();					# the main input queue, an array of hashes
     $systime = 0;					# the time now (in seconds)
    -$version = "1.14";				# the version no of the software
    +$version = "1.15";				# the version no of the software
     $starttime = 0;                 # the starting time of the cluster   
      
     # handle disconnections
    -- 
    2.34.1