X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fclient.pl;h=5e975c157bf18d903e8a11b3acdef0838cc6340a;hb=575db552c5a635ce2eb431de07f568113374735f;hp=66c7b0927337d88443097fb62b2c1daa1cc5dce9;hpb=502f900651a46b96008028945616a3b610d6cc7a;p=spider.git diff --git a/perl/client.pl b/perl/client.pl index 66c7b092..5e975c15 100755 --- a/perl/client.pl +++ b/perl/client.pl @@ -42,7 +42,7 @@ use Msg; use DXVars; use DXDebug; use DXUtil; -use Net::Telnet qw(TELOPT_ECHO); +use Net::Telnet qw(TELOPT_ECHO TELOPT_BINARY); use IO::File; use IO::Socket; use IPC::Open2; @@ -108,7 +108,8 @@ sub rec_socket my $snl = $mynl; my $newsavenl = ""; $snl = "" if $mode == 0; - $snl = "\r\n" if $mode == 2; + $snl = "\r\n" if $mode == 3; + $snl = "\n" if $mode == 2; if ($mode == 2 && $line =~ />$/) { $newsavenl = $snl; $snl = ' '; @@ -118,6 +119,8 @@ sub rec_socket if ($buffered) { if (length $outqueue >= $client_buffer_lth) { print $stdout $outqueue; + pop @echo while (@echo > $maxecho); + push @echo, $outqueue; $outqueue = ""; } $outqueue .= "$savenl$line$snl"; @@ -143,6 +146,8 @@ sub rec_socket } elsif ($sort eq 'B') { if ($buffered && $outqueue) { print $stdout $outqueue; + pop @echo while(@echo > $maxecho); + push @echo, $outqueue; $outqueue = ""; } $buffered = $line; # set buffered or unbuffered @@ -181,7 +186,7 @@ sub rec_stdin } elsif ($r > 0) { if ($mode) { $buf =~ s/\r/\n/g if $mode == 1; - $buf =~ s/[\r\x00]//g if $mode == 2; + $buf =~ s/[\r\x00]//g if $mode == 2 || $mode == 3; $dangle = !($buf =~ /\n$/); if ($buf eq "\n") { @@ -198,6 +203,7 @@ sub rec_stdin unshift @lines, ($lastbit . $first) if ($first); foreach $first (@lines) { # print "send_now $call $first\n"; + next if grep {$_ eq $first } @echo; $conn->send_later("I$call|$first"); } $lastbit = $buf; @@ -222,19 +228,13 @@ sub doconnect my ($host, $port) = split /\s+/, $line; $port = 23 if !$port; -# 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(Dont => TELOPT_ECHO, 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 $!"; -# } + $sock = new Net::Telnet (Timeout => $timeout, Port => $port); + $sock->option_callback(\&optioncb); + $sock->output_record_separator(''); + $sock->option_accept(Dont => TELOPT_ECHO, Wont => TELOPT_ECHO); + $sock->open($host) or die "Can't connect to $host port $port $!"; + $sock->binmode(1); + $mode = 3; } elsif ($sort eq 'ax25' || $sort eq 'prog') { my @args = split /\s+/, $line; $rfh = new IO::File; @@ -244,6 +244,7 @@ sub doconnect die "no transmit channel $!" unless $wfh; dbg('connect', "got pid $pid"); $wfh->autoflush(1); + $mode = 1; } else { die "invalid type of connection ($sort)"; } @@ -293,7 +294,7 @@ sub dochat $line =~ s/\r/\n/g; chomp; } - dbg('connect', "received \"$line\""); + dbg('connect', map { "received \"$_\"" } split /\n/, $line); if ($abort && $line =~ /$abort/i) { dbg('connect', "aborted on /$abort/"); cease(11); @@ -344,6 +345,7 @@ $savenl = ""; # an NL that has been saved from last time $timeout = 60; # default timeout for connects $abort = ""; # the current abort string $cpath = "$root/connect"; # the basic connect directory +$maxecho = 5; # length of max echo queue $pid = 0; # the pid of the child program $csort = ""; # the connection type @@ -417,7 +419,7 @@ if ($loginreq) { $s =~ s/\s+//og; $s =~ s/-\d+$//o; # no ssids! cease(0) unless $s && $s gt ' '; - unless (iscallsign($s)) { + unless (is_callsign($s)) { $stdout->print("Sorry, $s is an invalid callsign"); cease(0); } @@ -472,15 +474,16 @@ if ($connsort eq "connect") { $outbound = 1; $connsort = $csort; $stdout->autoflush(1); + $mode = ($connsort eq 'ax25') ? 1 : $mode; close STDIN; close STDOUT; close STDERR; } -$mode = ($connsort eq 'ax25') ? 1 : 2; setmode(); # adjust the callsign if it has an SSID, SSID <= 8 are legal > 8 are netrom connections +$call =~ s/-0$//; # strip off -0 as this is equiv to just call on its own my ($scall, $ssid) = split /-/, $call; $ssid = undef unless $ssid && $ssid =~ /^\d+$/; if ($ssid) {