a real telnetd on port 23.
2. Allowed network logins on client by specifying login instead of call.
3. made msg handling more robust (PC30 with unknown streams cause PC42), queueing
is only done on channels that are in state 'normal'.
4. Added pc command which takes a callsign and some text and sends it without
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
+14Dec98========================================================================
+1. Made the telnet thing work a bit better. It still will not work reliably to
+a real telnetd on port 23.
+2. Allowed network logins on client by specifying login instead of call.
+3. made msg handling more robust (PC30 with unknown streams cause PC42), queueing
+is only done on channels that are in state 'normal'.
+4. Added pc command which takes a callsign and some text and sends it without
+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
13Dec98========================================================================
1. Fixed VS6 lat/long in prefix_data and wpxloc.raw
2. Sorted out last in times for remote users
Reload the /spider/data/prefix_data.pl file if you have changed it manually whilst
the cluster is running.
+=== 8^PC <call> <text>^Send text (eg PC Protocol) to <call>
+Send some arbitrary text to a locally connected callsign. No processing is done on
+the text. This command allows you to send PC Protocol to unstick things if problems
+arise (messages get stuck etc). eg:-
+ pc gb7djk PC33^GB7TLH^GB7DJK^400^
+or
+ pc G1TLH Try doing that properly!!!
+
=== 1^PING <node>^Send a ping command to another cluster
This command is used to estimate the quality of the link to another cluster.
The time returned is the length of time taken for a PC51 to go to another
--- /dev/null
+#
+# send a manual PC protocol (or other) message to the callsign
+#
+# Copyright (c) 1998 Dirk Koopman G1TLH
+#
+# $Id$
+#
+my $self = shift;
+my $line = shift;
+my @f = split /\s+/, $line;
+
+return (1, $self->msg('e5')) if $self->priv < 8;
+
+my $call = uc shift @f;
+my $dxchan = DXChannel->get($call);
+return (1, $self->msg('e10', $call)) if !$dxchan;
+return (1, $self->msg('e8')) if @f <= 0;
+
+$line =~ s/$call\s+//i; # remove callsign and space
+$dxchan->send($line);
+
+return (1);
+++ /dev/null
-timeout 45
-connect net gb7baa.tubby.org
-client /spider/perl/client.pl gb7baa
+++ /dev/null
-timeout 60
-# don't forget to chmod 4775 netrom_call!
-connect ax25 /usr/sbin/netrom_call bbs gb7djk g1tlh
-'Connect' ''
-'Connect' 'c np7'
-'Connect' 'c gb7dxm'
-'Connect' ''
-client /usr/bin/perl /spider/perl/client.pl gb7dxm ax25
<p>
<!-- Created: Sun Dec 13 20:25:14 GMT 1998 -->
<!-- hhmts start -->
-Last modified: Sun Dec 13 22:31:33 GMT 1998
+Last modified: Mon Dec 14 00:29:00 GMT 1998
<!-- hhmts end -->
<p>At the moment, anybody can connect inwards at any time from outside, either by ax25 or by
telnet (assuming you have followed the instructions in <a href="install.html">installation</a>
connection.
</ul>
<hr>
- <h5>$Id</h5>
+ <h5>$Id$</h5>
</body>
</html>
if ($pcno == 30) { # this is a incoming subject ack
my $ref = $work{$f[2]}; # note no stream at this stage
- delete $work{$f[2]};
- $ref->{stream} = $f[3];
- $ref->{count} = 0;
- $ref->{linesreq} = 5;
- $work{"$f[2]$f[3]"} = $ref; # new ref
- dbg('msg', "incoming subject ack stream $f[3]\n");
- $busy{$f[2]} = $ref; # interlock
- $ref->{lines} = [];
- push @{$ref->{lines}}, ($ref->read_msg_body);
- $ref->send_tranche($self);
+ if ($ref) {
+ delete $work{$f[2]};
+ $ref->{stream} = $f[3];
+ $ref->{count} = 0;
+ $ref->{linesreq} = 5;
+ $work{"$f[2]$f[3]"} = $ref; # new ref
+ dbg('msg', "incoming subject ack stream $f[3]\n");
+ $busy{$f[2]} = $ref; # interlock
+ $ref->{lines} = [];
+ push @{$ref->{lines}}, ($ref->read_msg_body);
+ $ref->send_tranche($self);
+ } else {
+ $self->send(DXProt::pc42($f[2], $f[1], $f[3])); # unknown stream
+ }
last SWITCH;
}
if ($ref->{file}) {
$ref->store($ref->{lines});
} else {
+
+ # does an identical message already exist?
+ my $m;
+ for $m (@msg) {
+ if ($ref->{subject} eq $m->{subject} && $ref->{t} == $m->{t} && $ref->{from} eq $m->{from}) {
+ $ref->stop_msg($self);
+ my $msgno = $m->{msgno};
+ dbg('msg', "duplicate message to $msgno\n");
+ Log('msg', "duplicate message to $msgno");
+ return;
+ }
+ }
+
$ref->{msgno} = next_transno("Msgno");
push @{$ref->{gotit}}, $f[2]; # mark this up as being received
$ref->store($ref->{lines});
last SWITCH;
}
+
+ if ($pcno == 49) { # global delete on subject
+ for (@msg) {
+ if ($_->{subject} eq $f[2]) {
+ $_->del_msg();
+ Log('msg', "Message $_->{msgno} fully deleted by $f[1]");
+ }
+ }
+ }
}
-
- clean_old() if $main::systime - $last_clean > 3600 ; # clean the message queue
+
+ clean_old() if $main::systime - $last_clean > 3600 ; # clean the message queue
}
confess "can't open file $ref->{to} $!";
}
} else { # a normal message
-
+
# attempt to open the message file
my $fn = filename($ref->{msgno});
my $to = $self->{tonode};
my $from = $self->{fromnode};
my $stream = $self->{stream};
- my $i;
+ my $lines = $self->{lines};
+ my ($c, $i);
- for ($i = 0; $i < $self->{linesreq} && $self->{count} < @{$self->{lines}}; $i++, $self->{count}++) {
- push @out, DXProt::pc29($to, $from, $stream, ${$self->{lines}}[$self->{count}]);
-}
-push @out, DXProt::pc32($to, $from, $stream) if $i < $self->{linesreq};
-$dxchan->send(@out);
+ for ($i = 0, $c = $self->{count}; $i < $self->{linesreq} && $c < @$lines; $i++, $c++) {
+ push @out, DXProt::pc29($to, $from, $stream, $lines->[$c]);
+ }
+ $self->{count} = $c;
+
+ push @out, DXProt::pc32($to, $from, $stream) if $i < $self->{linesreq};
+ $dxchan->send(@out);
}
- # find a message to send out and start the ball rolling
- sub queue_msg
+# find a message to send out and start the ball rolling
+sub queue_msg
{
my $sort = shift;
+ my $call = shift;
my @nodelist = DXProt::get_all_ak1a();
my $ref;
my $clref;
$clref = DXCluster->get($ref->{to});
if ($clref && !grep { $clref->{dxchan} == $_ } DXCommandmode::get_all) {
$dxchan = $clref->{dxchan};
- $ref->start_msg($dxchan) if $clref && !get_busy($dxchan->call);
+ $ref->start_msg($dxchan) if $clref && !get_busy($dxchan->call) && $dxchan->state eq 'normal';
}
}
} elsif ($sort == undef) {
next if grep { $_ eq $noderef->call } @{$ref->{gotit}};
# if we are here we have a node that doesn't have this message
- $ref->start_msg($noderef) if !get_busy($noderef->call);
+ $ref->start_msg($noderef) if !get_busy($noderef->call) && $noderef->state eq 'normal';
last;
- }
+ }
}
# if all the available nodes are busy then stop
} else {
# i.e. it ain't and end or abort, therefore store the line
- push @{$loc->{lines}}, $line;
+ push @{$loc->{lines}}, length($line) > 0 ? $line : " ";
}
}
return (1, @out);
last SWITCH;
}
- if (($pcno >= 28 && $pcno <= 33) || $pcno == 40 || $pcno == 42) { # mail/file handling
+ if (($pcno >= 28 && $pcno <= 33) || $pcno == 40 || $pcno == 42 || $pcno == 49) { # mail/file handling
DXMsg::process($self, $line);
return;
}
if ($pcno == 48) {
last SWITCH;
}
- if ($pcno == 49) {
- last SWITCH;
- }
if ($pcno == 50) { # keep alive/user list
my $ref = DXCluster->get_exact($field[1]);
#!/usr/bin/perl
#
# The geomagnetic information and calculation module
+# a chanfe
#
# Copyright (c) 1998 - Dirk Koopman G1TLH
#
close $fh;
# log it
- $fp->writeunix($date, "$from^$date^$sfi^$a^$k^$forecast^$node\n");
+ $fp->writeunix($date, "$from^$date^$sfi^$a^$k^$forecast^$node");
}
# update WWV info in one go (usually from a PC23)
use Msg;
use DXVars;
use DXDebug;
+use DXUser;
use IO::File;
use IO::Socket;
use IPC::Open2;
if ($r > 0) {
if ($mode) {
$buf =~ s/\r/\n/og if $mode == 1;
+ $buf =~ s/\r\n/\n/og if $mode == 2;
$dangle = !($buf =~ /\n$/);
if ($buf eq "\n") {
@lines = (" ");
unshift @lines, ($lastbit . $first) if ($first);
foreach $first (@lines) {
# print "send_now $call $first\n";
- $conn->send_now("I$call|$first");
+ $conn->send_later("I$call|$first");
}
$lastbit = $buf;
$savenl = ""; # reset savenl 'cos we will have done a newline on input
} else {
- $conn->send_now("I$call|$buf");
+ $conn->send_later("I$call|$buf");
}
} elsif ($r == 0) {
cease(1);
$lasttime = time;
}
+sub optioncb
+{
+}
+
sub doconnect
{
my ($sort, $line) = @_;
$port = 23 if !$port;
if ($port == 23) {
- $sock = new Net::Telnet (Timeout => $timeout, BinMode => 1);
- $sock->option_accept(Dont => TELOPT_ECHO, Wont => TELOPT_ECHO);
+ $sock = new Net::Telnet (Timeout => $timeout);
+ $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 $!";
}
- } elsif ($sort eq 'ax25') {
+ } elsif ($sort eq 'ax25' || $sort eq 'prog') {
my @args = split /\s+/, $line;
$rfh = new IO::File;
$wfh = new IO::File;
for (;;) {
if ($csort eq 'telnet') {
$line = $sock->get();
+ $line =~ s/\r\n/\n/og;
chomp;
- } elsif ($csort eq 'ax25') {
+ } elsif ($csort eq 'ax25' || $csort eq 'prog') {
local $/ = "\r";
$line = <$rfh>;
$line =~ s/\r//og;
#
$call = uc shift @ARGV;
-$call = uc $myalias if !$call;
+$call = uc $myalias if !$call;
$connsort = lc shift @ARGV;
$connsort = 'local' if !$connsort;
-#
-# strip off any SSID if it is a telnet connection
-#
-# SSID's are a problem, basically we don't allow them EXCEPT for the special case
-# of local users. i.e. you can have a cluster call with an SSID and a usercall with
-# an SSID and they are different to the system to those without SSIDs
-#
+$loginreq = $call eq 'LOGIN';
-$call =~ s/-\d+$//o if $mode eq 'telnet';
+# we will do this again later 'cos things may have changed
$mode = ($connsort eq 'ax25') ? 1 : 2;
setmode();
dbgadd('connect');
+# do we need to do a login and password job?
+if ($loginreq) {
+ my $user;
+ my $s;
+
+ DXUser->init($userfn);
+
+ for ($state = 0; $state < 2; ) {
+ alarm($timeout);
+
+ if ($state == 0) {
+ $stdout->print('login: ');
+ $stdout->flush();
+ local $/ = $mode == 1 ? "\r" : "\n";
+ $s = $stdin->getline();
+ chomp $s;
+ $call = uc $s;
+ $user = DXUser->get($call);
+ $state = 1;
+ } elsif ($state == 1) {
+ $stdout->print('password: ');
+ $stdout->flush();
+ local $/ = $mode == 1 ? "\r" : "\n";
+ $s = $stdin->getline();
+ chomp $s;
+ $state = 2;
+ cease(0) if !$user || ($user->passwd && $user->passwd ne $s);
+ }
+ }
+}
+
# is this an out going connection?
if ($connsort eq "connect") {
my $mcall = lc $call;
dbgsub('connect');
# if we get here we are connected
- if ($csort eq 'ax25') {
+ if ($csort eq 'ax25' || $csort eq 'prog') {
# open(STDIN, "<&R");
# open(STDOUT, ">&W");
# close R;
# close W;
$stdin = $rfh;
$stdout = $wfh;
+ $csort = 'telnet' if $sort eq 'prog';
} elsif ($csort eq 'telnet') {
# open(STDIN, "<&$sock");
# open(STDOUT, ">&$sock");
close STDIN;
close STDOUT;
close STDERR;
-
-
- $mode = ($connsort =~ /^ax/o) ? 1 : 2;
- setmode();
}
+$mode = ($connsort eq 'ax25') ? 1 : 2;
setmode();
$conn = Msg->connect("$clusteraddr", $clusterport, \&rec_socket);
@inqueue = (); # the main input queue, an array of hashes
$systime = 0; # the time now (in seconds)
-$version = "1.11"; # the version no of the software
+$version = "1.12"; # the version no of the software
$starttime = 0; # the starting time of the cluster
# handle disconnections
$dxchan->disconnect();
}
+# send a message to call on conn and disconnect
+sub already_conn
+{
+ my ($conn, $call, $mess) = @_;
+
+ dbg('chan', "-> D $call $mess\n");
+ $conn->send_now("D$call|$mess");
+ sleep(1);
+ dbg('chan', "-> Z $call bye\n");
+ $conn->send_now("Z$call|bye"); # this will cause 'client' to disconnect
+}
+
# handle incoming messages
sub rec
{
if (!defined $dxchan) {
my ($sort, $call, $line) = $msg =~ /^(\w)(\S+)\|(.*)$/;
- # is there one already connected?
- if (DXChannel->get($call)) {
- my $mess = DXM::msg($lang, 'conother', $call);
- dbg('chan', "-> D $call $mess\n");
- $conn->send_now("D$call|$mess");
- sleep(1);
- dbg('chan', "-> Z $call bye\n");
- $conn->send_now("Z$call|bye"); # this will cause 'client' to disconnect
- return;
- }
-
# is there one already connected elsewhere in the cluster (and not a cluster)
my $user = DXUser->get($call);
- if ($user && $user->sort eq 'A' && !DXCluster->get_exact($call)) {
- ;
- } elsif (($call eq $main::myalias && DXCluster->get_exact($call)) ||
- DXCluster->get($call)) {
- my $mess = DXM::msg($lang, 'concluster', $call);
- dbg('chan', "-> D $call $mess\n");
- $conn->send_now("D$call|$mess");
- sleep(1);
- dbg('chan', "-> Z $call bye\n");
- $conn->send_now("Z$call|bye"); # this will cause 'client' to disconnect
- return;
+ if ($user) {
+ if ($user->sort eq 'A' && !DXCluster->get_exact($call)) {
+ ;
+ } elsif ($user->sort eq 'U' && $call eq $main::myalias && !DXCluster->get_exact($call)) {
+ ;
+ } else {
+ if (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)) {
+ 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
my $user = DXUser->get($call);
projects / spider.git / commitdiff