X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fclient.pl;h=c39bda4c0fbde42c8b1e3890a85773e22be5c960;hb=97d5445b1e468d9228367640421b2f90ac021224;hp=5b35ee2dc83fb98c236d9f0055766f93eaf973de;hpb=b473fa8950fc9a6b747be44434569dec254b0897;p=spider.git diff --git a/perl/client.pl b/perl/client.pl index 5b35ee2d..c39bda4c 100755 --- a/perl/client.pl +++ b/perl/client.pl @@ -26,6 +26,7 @@ # $Id$ # +require 5.004; # search local then perl directories BEGIN { @@ -40,9 +41,11 @@ BEGIN { use Msg; use DXVars; use DXDebug; +use DXUser; +use IO::File; use IO::Socket; use IPC::Open2; -use FileHandle; +use Net::Telnet qw(TELOPT_ECHO); use Carp; # cease communications @@ -53,7 +56,10 @@ 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); + } sleep(1); exit(0); } @@ -69,6 +75,7 @@ sub sig_chld { $SIG{CHLD} = \&sig_chld; $waitedpid = wait; + dbg('connect', "caught $pid"); } @@ -116,6 +123,16 @@ 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->setflag( &POSIX::ISIG ); + $term->setattr(fileno($sock), &POSIX::TCSANOW ); + } + } elsif ($sort eq 'I') { + ; # ignore echoed I frames } elsif ($sort eq 'B') { if ($buffered && $outqueue) { print $stdout $outqueue; @@ -147,6 +164,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 = (" "); @@ -162,12 +180,12 @@ 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); @@ -175,23 +193,35 @@ sub rec_stdin $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(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 $!"; dbg('connect', "got pid $pid"); $wfh->autoflush(1); @@ -221,29 +251,33 @@ 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(); + $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') { local $\ = "\r"; - $wfh->print("$send\r"); + $wfh->print("$send"); } dbg('connect', "sent \"$send\""); } @@ -252,7 +286,7 @@ sub dochat sub timeout { dbg('connect', "timed out after $timeout seconds"); - cease(10); + cease(0); } @@ -270,7 +304,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 @@ -289,11 +323,14 @@ $wfh = 0; # $call = uc shift @ARGV; -$call = uc $myalias if !$call; +$call = uc $myalias if !$call; $connsort = lc shift @ARGV; $connsort = 'local' if !$connsort; -$mode = ($connsort =~ /^ax/o) ? 1 : 2; +$loginreq = $call eq 'LOGIN'; + +# we will do this again later 'cos things may have changed +$mode = ($connsort eq 'ax25') ? 1 : 2; setmode(); if ($call eq $mycall) { @@ -310,6 +347,66 @@ $SIG{'CHLD'} = \&sig_chld; 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; + } + + + 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; @@ -318,7 +415,7 @@ if ($connsort eq "connect") { @in = ; close IN; - # alarm($timeout); + alarm($timeout); for (@in) { chomp; @@ -327,20 +424,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 $sort eq 'prog'; } elsif ($csort eq 'telnet') { # open(STDIN, "<&$sock"); # open(STDOUT, ">&$sock"); @@ -355,12 +457,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);