]> dxcluster.org Git - spider.git/commitdiff
1. Made the telnet thing work a bit better. It still will not work reliably to
authordjk <djk>
Tue, 15 Dec 1998 14:38:20 +0000 (14:38 +0000)
committerdjk <djk>
Tue, 15 Dec 1998 14:38:20 +0000 (14:38 +0000)
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
cmd/Commands_en.hlp
cmd/pc.pl [new file with mode: 0644]
connect/gb7baa [deleted file]
connect/gb7dxm [deleted file]
html/connect.html
perl/DXMsg.pm
perl/DXProt.pm
perl/Geomag.pm
perl/client.pl
perl/cluster.pl

diff --git a/Changes b/Changes
index d066335f7dcb5c2e319628b6c7e583212b31cd1e..2b81d77a34bdbc5ca4b5898ea9cef3b5ceb956fb 100644 (file)
--- 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
index 179c73cc716a11dc9cc729082866768db5103fec..95a36b8b3e225f7f2e2bc34a98229381b56cc0f5 100644 (file)
@@ -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 <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 
diff --git a/cmd/pc.pl b/cmd/pc.pl
new file mode 100644 (file)
index 0000000..cfb8f9e
--- /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 (file)
index 995b1ea..0000000
+++ /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 (file)
index 9d04833..0000000
+++ /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
index b5a067b0147ee62226c3b152f1e6ef1c84846504..ebc9ce88e3624f89f02652e42622cb3720d64911 100644 (file)
@@ -12,7 +12,7 @@
        <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>
@@ -108,6 +108,6 @@ Last modified: Sun Dec 13 22:31:33 GMT 1998
                connection.
        </ul>
     <hr>
-       <h5>$Id</h5>
+       <h5>$Id$</h5>
   </body>
 </html>
index eacbf6fe5984bc5cbfafae12fe9370de1b06ef70..c4d895b2e8681d2497f325ce6104b0550b5049f5 100644 (file)
@@ -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);
index 9831e3965c4d47ee17797b550772ee1d6cf5d9ee..7bccfcb9acb3dfebd1f12760c4168aa51cc79b5f 100644 (file)
@@ -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]);
index f06cbbc640bd05cfb81b97d650b52f0bc5d0d92c..0fc16d06a83f934b913d291b6e8805c62c32e536 100644 (file)
@@ -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)
index ce0085dedd10e1c52ee40850c51dc0cff14f18b5..a2a690cad22a1bd362c7b1cb5b6818b5687d7344 100755 (executable)
@@ -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);
index b4cb11c0a898700d842a072e0c0d218e40ee1eac..73cb401a63150b29d854f688ff5defe64e30a96a 100755 (executable)
@@ -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);