X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fclient.pl;h=376587645c8599abb15b2bb43ac82238afad2722;hb=918827ec5a9023edeb2ce0140692566591af0af8;hp=b7bb5452f684becf01bc12273b1e89d37dd0ccef;hpb=4d3067793942b3f4518615906dde50db5b76464a;p=spider.git diff --git a/perl/client.pl b/perl/client.pl index b7bb5452..37658764 100755 --- a/perl/client.pl +++ b/perl/client.pl @@ -1,4 +1,4 @@ -#!/usr/bin/perl +#!/usr/bin/perl -w # # A thing that implements dxcluster 'protocol' # @@ -26,6 +26,7 @@ # $Id$ # +require 5.004; # search local then perl directories BEGIN { @@ -40,10 +41,11 @@ BEGIN { use Msg; use DXVars; use DXDebug; +use Net::Telnet qw(TELOPT_ECHO); +use IO::File; use IO::Socket; use IPC::Open2; -use FileHandle; -use Carp; +use Carp qw{cluck}; # cease communications sub cease @@ -53,7 +55,12 @@ sub cease $conn->send_now("Z$call|bye...\n"); } $stdout->flush if $stdout; - kill(15, $pid) if $pid; + if ($pid) { + dbg('connect', "killing $pid"); + kill(9, $pid); + } + dbgclose(); +# $SIG{__WARN__} = sub {my $a = shift; cluck($a); }; sleep(1); exit(0); } @@ -69,6 +76,7 @@ sub sig_chld { $SIG{CHLD} = \&sig_chld; $waitedpid = wait; + dbg('connect', "caught $pid"); } @@ -90,7 +98,7 @@ sub rec_socket cease(1); } if (defined $msg) { - my ($sort, $call, $line) = $msg =~ /^(\w)(\S+)\|(.*)$/; + my ($sort, $call, $line) = $msg =~ /^(\w)([A-Z0-9\-]+)\|(.*)$/; if ($sort eq 'D') { my $snl = $mynl; @@ -103,7 +111,7 @@ sub rec_socket $line =~ s/\n/\r/og if $mode == 1; #my $p = qq($line$snl); if ($buffered) { - if (length $outqueue >= 128) { + if (length $outqueue >= $client_buffer_lth) { print $stdout $outqueue; $outqueue = ""; } @@ -116,6 +124,17 @@ sub rec_socket } elsif ($sort eq 'M') { $mode = $line; # set new mode from cluster setmode(); + } elsif ($sort eq 'E') { + if ($sort eq 'telnet') { + $mode = $line; # set echo mode from cluster + my $term = POSIX::Termios->new; + $term->getattr(fileno($sock)); + $term->setiflag( 0 ); + $term->setoflag( 0 ); + $term->setattr(fileno($sock), &POSIX::TCSANOW ); + } + } elsif ($sort eq 'I') { + ; # ignore echoed I frames } elsif ($sort eq 'B') { if ($buffered && $outqueue) { print $stdout $outqueue; @@ -144,9 +163,12 @@ sub rec_stdin # $prbuf =~ s/\r/\\r/; # $prbuf =~ s/\n/\\n/; # print "sys: $r ($prbuf)\n"; - if ($r > 0) { + if (!defined $r || $r == 0) { + cease(1); + } elsif ($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 = (" "); @@ -162,37 +184,50 @@ sub rec_stdin unshift @lines, ($lastbit . $first) if ($first); foreach $first (@lines) { # print "send_now $call $first\n"; - $conn->send_now("D$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("D$call|$buf"); + $conn->send_later("I$call|$buf"); } - } elsif ($r == 0) { - cease(1); - } + } $lasttime = time; } +sub optioncb +{ +} + sub doconnect { my ($sort, $line) = @_; 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 $!"; - - } elsif ($sort eq 'ax25') { +# 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 $!"; +# } + } elsif ($sort eq 'ax25' || $sort eq 'prog') { 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 $!"; + die "no receive channel $!" unless $rfh; + die "no transmit channel $!" unless $wfh; dbg('connect', "got pid $pid"); $wfh->autoflush(1); } else { @@ -224,21 +259,26 @@ sub dochat 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(); + cease(11) unless $line; # the socket has gone away? + $line =~ s/\r\n/\n/og; + chomp; + } elsif ($csort eq 'ax25' || $csort eq 'prog') { + 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') { @@ -252,7 +292,7 @@ sub dochat sub timeout { dbg('connect', "timed out after $timeout seconds"); - cease(10); + cease(0); } @@ -262,15 +302,15 @@ sub timeout $mode = 2; # 1 - \n = \r as EOL, 2 - \n = \n, 0 - transparent $call = ""; # the callsign being used -@stdoutq = (); # the queue of stuff to send out to the user $conn = 0; # the connection object for the cluster $lastbit = ""; # the last bit of an incomplete input line $mynl = "\n"; # standard terminator $lasttime = time; # lasttime something happened on the interface -$outqueue = ""; # the output queue length +$outqueue = ""; # the output queue +$client_buffer_lth = 200; # how many characters are buffered up on outqueue $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 @@ -283,25 +323,20 @@ $stdout = *STDOUT; $rfh = 0; $wfh = 0; +$waitedpid = 0; # # deal with args # -$call = uc shift @ARGV; -$call = uc $myalias if !$call; -$connsort = lc shift @ARGV; +$call = uc shift @ARGV if @ARGV; +$call = uc $myalias if !$call; +$connsort = lc shift @ARGV if @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(); @@ -316,9 +351,72 @@ $SIG{'INT'} = \&sig_term; $SIG{'TERM'} = \&sig_term; $SIG{'HUP'} = 'IGNORE'; $SIG{'CHLD'} = \&sig_chld; +$SIG{'ALRM'} = \&timeout; dbgadd('connect'); +# do we need to do a login and password job? +if ($loginreq) { + my $user; + my $s; + + if (-e "$data/issue") { + open(I, "$data/issue") or die; + local $/ = undef; + $issue = ; + close(I); + $issue = s/\n/\r/og if $mode == 1; + local $/ = $nl; + $stdout->print($issue) if $issue; + } + + + use DXUser; + + DXUser->init($userfn); + + # allow a login from an existing user. I could create a user but + # I want to check for valid callsigns and I don't have the + # necessary info / regular expression yet + for ($state = 0; $state < 2; ) { + alarm($timeout); + + if ($state == 0) { + $stdout->print('login: '); + $stdout->flush(); + local $\ = $nl; + $s = $stdin->getline(); + chomp $s; + $s =~ s/\s+//og; + $s =~ s/-\d+$//o; # no ssids! + cease(0) unless $s gt ' '; + $call = uc $s; + $user = DXUser->get($call); + $state = 1; + } elsif ($state == 1) { + $stdout->print('password: '); + $stdout->flush(); + local $\ = $nl; + $s = $stdin->getline(); + chomp $s; + $state = 2; + if (!$user || ($user->passwd && $user->passwd ne $s)) { + $stdout->print("sorry...$nl"); + cease(0); + } + } + } +} + +# handle callsign and connection type firtling +sub doclient +{ + my $line = shift; + my @f = split /\s+/, $line; + $call = uc $f[0] if $f[0]; + $csort = $f[1] if $f[1]; +} + # is this an out going connection? if ($connsort eq "connect") { my $mcall = lc $call; @@ -326,8 +424,8 @@ if ($connsort eq "connect") { open(IN, "$cpath/$mcall") or cease(2); @in = ; close IN; - - # alarm($timeout); + + alarm($timeout); for (@in) { chomp; @@ -336,20 +434,25 @@ if ($connsort eq "connect") { doconnect($1, $2) if /^\s*co\w*\s+(\w+)\s+(.*)$/io; doabort($1) if /^\s*a\w*\s+(.*)/io; dotimeout($1) if /^\s*t\w*\s+(\d+)/io; - dochat($1, $2) if /\s*\'(.*)\'\s+\'(.*)\'/io; + dochat($1, $2) if /\s*\'(.*)\'\s+\'(.*)\'/io; + if (/\s*cl\w+\s+(.*)/io) { + doclient($1); + last; + } } - dbg('connect', "Connected to $call, starting normal protocol"); + dbg('connect', "Connected to $call ($csort), starting normal protocol"); 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 $csort eq 'prog'; } elsif ($csort eq 'telnet') { # open(STDIN, "<&$sock"); # open(STDOUT, ">&$sock"); @@ -364,12 +467,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); @@ -378,7 +478,7 @@ if (! $conn) { open IN, "$data/offline" or die; while () { s/\n/\r/og if $mode == 1; - print $stdout; + print $stdout $_; } close IN; } else {