From 7a64dbf69ead057f2fd3fef1df05e30cef339485 Mon Sep 17 00:00:00 2001 From: djk Date: Tue, 15 Dec 1998 14:38:20 +0000 Subject: [PATCH] 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 --- Changes | 11 +++++++ cmd/Commands_en.hlp | 8 +++++ cmd/pc.pl | 22 +++++++++++++ connect/gb7baa | 3 -- connect/gb7dxm | 8 ----- html/connect.html | 4 +-- perl/DXMsg.pm | 80 +++++++++++++++++++++++++++++++-------------- perl/DXProt.pm | 5 +-- perl/Geomag.pm | 3 +- perl/client.pl | 72 ++++++++++++++++++++++++++++------------ perl/cluster.pl | 55 ++++++++++++++++++------------- 11 files changed, 185 insertions(+), 86 deletions(-) create mode 100644 cmd/pc.pl delete mode 100644 connect/gb7baa delete mode 100644 connect/gb7dxm diff --git a/Changes b/Changes index d066335f..2b81d77a 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,14 @@ +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 diff --git a/cmd/Commands_en.hlp b/cmd/Commands_en.hlp index 179c73cc..95a36b8b 100644 --- a/cmd/Commands_en.hlp +++ b/cmd/Commands_en.hlp @@ -109,6 +109,14 @@ unknown message 'xxxx' in lang 'en' Reload the /spider/data/prefix_data.pl file if you have changed it manually whilst the cluster is running. +=== 8^PC ^Send text (eg PC Protocol) to +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 ^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 diff --git a/cmd/pc.pl b/cmd/pc.pl new file mode 100644 index 00000000..cfb8f9e9 --- /dev/null +++ b/cmd/pc.pl @@ -0,0 +1,22 @@ +# +# 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); diff --git a/connect/gb7baa b/connect/gb7baa deleted file mode 100644 index 995b1eaf..00000000 --- a/connect/gb7baa +++ /dev/null @@ -1,3 +0,0 @@ -timeout 45 -connect net gb7baa.tubby.org -client /spider/perl/client.pl gb7baa diff --git a/connect/gb7dxm b/connect/gb7dxm deleted file mode 100644 index 9d04833d..00000000 --- a/connect/gb7dxm +++ /dev/null @@ -1,8 +0,0 @@ -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 diff --git a/html/connect.html b/html/connect.html index b5a067b0..ebc9ce88 100644 --- a/html/connect.html +++ b/html/connect.html @@ -12,7 +12,7 @@

-Last modified: Sun Dec 13 22:31:33 GMT 1998 +Last modified: Mon Dec 14 00:29:00 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 @@ -108,6 +108,6 @@ Last modified: Sun Dec 13 22:31:33 GMT 1998 connection.

-
$Id
+
$Id$
diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index eacbf6fe..c4d895b2 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -135,16 +135,20 @@ sub process 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; } @@ -174,6 +178,19 @@ sub process 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}); @@ -256,9 +273,18 @@ sub process 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 } @@ -291,7 +317,7 @@ sub store confess "can't open file $ref->{to} $!"; } } else { # a normal message - + # attempt to open the message file my $fn = filename($ref->{msgno}); @@ -433,20 +459,24 @@ sub send_tranche 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; @@ -464,7 +494,7 @@ $dxchan->send(@out); $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) { @@ -478,9 +508,9 @@ $dxchan->send(@out); 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 @@ -700,7 +730,7 @@ sub do_send_stuff } 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); diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 9831e396..7bccfcb9 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -325,7 +325,7 @@ sub normal 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; } @@ -419,9 +419,6 @@ sub normal if ($pcno == 48) { last SWITCH; } - if ($pcno == 49) { - last SWITCH; - } if ($pcno == 50) { # keep alive/user list my $ref = DXCluster->get_exact($field[1]); diff --git a/perl/Geomag.pm b/perl/Geomag.pm index f06cbbc6..0fc16d06 100644 --- a/perl/Geomag.pm +++ b/perl/Geomag.pm @@ -1,6 +1,7 @@ #!/usr/bin/perl # # The geomagnetic information and calculation module +# a chanfe # # Copyright (c) 1998 - Dirk Koopman G1TLH # @@ -57,7 +58,7 @@ sub store 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) diff --git a/perl/client.pl b/perl/client.pl index ce0085de..a2a690ca 100755 --- a/perl/client.pl +++ b/perl/client.pl @@ -40,6 +40,7 @@ BEGIN { use Msg; use DXVars; use DXDebug; +use DXUser; use IO::File; use IO::Socket; use IPC::Open2; @@ -158,6 +159,7 @@ sub rec_stdin 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 = (" "); @@ -173,12 +175,12 @@ sub rec_stdin 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); @@ -186,6 +188,10 @@ sub rec_stdin $lasttime = time; } +sub optioncb +{ +} + sub doconnect { my ($sort, $line) = @_; @@ -196,17 +202,19 @@ sub doconnect $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; @@ -245,8 +253,9 @@ sub dochat 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; @@ -310,19 +319,13 @@ $wfh = 0; # $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(); @@ -340,6 +343,37 @@ $SIG{'CHLD'} = \&sig_chld; 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; @@ -364,13 +398,14 @@ if ($connsort eq "connect") { 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"); @@ -385,12 +420,9 @@ if ($connsort eq "connect") { 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); diff --git a/perl/cluster.pl b/perl/cluster.pl index b4cb11c0..73cb401a 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.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 @@ -59,6 +59,18 @@ sub disconnect $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 { @@ -74,31 +86,28 @@ 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); -- 2.34.1