added more help

[spider.git] / perl / client.pl

diff --git a/perl/client.pl b/perl/client.pl
index 3227195747d5dcfd347cbd800bc40c957ebe71f3..d431a0d12430a982516919eea23f9f23ac9ec10b 100755 (executable)
--- a/perl/client.pl
+++ b/perl/client.pl
@@ -40,9 +40,10 @@ BEGIN {
 use Msg;
 use DXVars;
 use DXDebug;
+use IO::File;
 use IO::Socket;
 use IPC::Open2;
-use FileHandle;
+use Net::Telnet qw(TELOPT_ECHO);
 use Carp;
 
 # cease communications
@@ -52,7 +53,7 @@ sub cease
        if ($conn && $sendz) {
                $conn->send_now("Z$call|bye...\n");
        }
-       $stdout->flush;
+       $stdout->flush if $stdout;
        kill(15, $pid) if $pid;
        sleep(1);
        exit(0);        
@@ -181,17 +182,24 @@ sub doconnect
        dbg('connect', "CONNECT sort: $sort command: $line");
        if ($sort eq 'telnet') {
                # this is a straight network connect
-               my ($host) = $line =~ /host\s+(\w+)/o;
-               my ($port) = $line =~ /port\s+(\d+)/o;
+               my ($host, $port) = split /\s+/, $line;
                $port = 23 if !$port;
                
-               $sock = IO::Socket::INET->new(PeerAddr => "$host", PeerPort => "$port", Proto => 'tcp')
-                       or die "Can't connect to $host port $port $!";
-               
+               if ($port == 23) {
+                       $sock = new Net::Telnet (Timeout => $timeout, BinMode => 1);
+                       $sock->option_accept(Dont => TELOPT_ECHO, Wont => TELOPT_ECHO);
+                       #$sock->option_log('option_log');
+                       $sock->dump_log('dump');
+                       $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') {
                my @args = split /\s+/, $line;
-               $rfh = new FileHandle;
-               $wfh = new FileHandle;
+               $rfh = new IO::File;
+               $wfh = new IO::File;
                $pid = open2($rfh, $wfh, "$line") or die "can't do $line $!";
                dbg('connect', "got pid $pid");
                $wfh->autoflush(1);
@@ -221,29 +229,32 @@ sub dochat
        dbg('connect', "CHAT \"$expect\" -> \"$send\"");
     my $line;
        
-       #       alarm($timeout);
+       alarm($timeout);
        
     if ($expect) {
-               if ($csort eq 'telnet') {
-                       $line = <$sock>;
-                       chomp;
-               } elsif ($csort eq 'ax25') {
-                       local $/ = "\r";
-                       $line = <$rfh>;
-                       $line =~ s/\r//og;
-               }
-               dbg('connect', "received \"$line\"");
-               if ($abort && $line =~ /$abort/i) {
-                       dbg('connect', "aborted on /$abort/");
-                       cease(11);
+               for (;;) {
+                       if ($csort eq 'telnet') {
+                               $line = $sock->get();
+                               chomp;
+                       } elsif ($csort eq 'ax25') {
+                               local $/ = "\r";
+                               $line = <$rfh>;
+                               $line =~ s/\r//og;
+                       }
+                       dbg('connect', "received \"$line\"");
+                       if ($abort && $line =~ /$abort/i) {
+                               dbg('connect', "aborted on /$abort/");
+                               cease(11);
+                       }
+                       last if $line =~ /$expect/i;
                }
        }
-       if ($send && (!$expect || $line =~ /$expect/i)) {
+       if ($send) {
                if ($csort eq 'telnet') {
                        $sock->print("$send\n");
                } elsif ($csort eq 'ax25') {
                        local $\ = "\r";
-                       $wfh->print("$send\r");
+                       $wfh->print("$send");
                }
                dbg('connect', "sent \"$send\"");
        }
@@ -270,7 +281,7 @@ $lasttime = time;               # lasttime something happened on the interface
 $outqueue = "";                 # the output queue length
 $buffered = 1;                  # buffer output
 $savenl = "";                   # an NL that has been saved from last time
-$timeout = 30;                  # default timeout for connects
+$timeout = 60;                  # default timeout for connects
 $abort = "";                    # the current abort string
 $cpath = "$root/connect";              # the basic connect directory
 
@@ -293,7 +304,16 @@ $call = uc $myalias if !$call;
 $connsort = lc shift @ARGV;
 $connsort = 'local' if !$connsort;
 
-$mode = ($connsort =~ /^ax/o) ? 1 : 2;
+#
+# 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
+#
+
+$call =~ s/-\d+$//o if $mode eq 'telnet';
+$mode = ($connsort eq 'ax25') ? 1 : 2;
 setmode();
 
 if ($call eq $mycall) {
@@ -395,3 +415,4 @@ for (;;) {
        }
 }
 
+exit(0);