X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fclient.pl;h=4a4069f07313c0a6d567bbb14a90e76eb499224d;hb=cc91428ca79b3cdfdc7733505384f5983ad6c7fa;hp=ce0085dedd10e1c52ee40850c51dc0cff14f18b5;hpb=9e6f237bf04fc102b519085e171d81b28d418ccb;p=spider.git diff --git a/perl/client.pl b/perl/client.pl index ce0085de..4a4069f0 100755 --- a/perl/client.pl +++ b/perl/client.pl @@ -26,6 +26,7 @@ # $Id$ # +require 5.004; # search local then perl directories BEGIN { @@ -54,7 +55,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); } @@ -70,6 +74,7 @@ sub sig_chld { $SIG{CHLD} = \&sig_chld; $waitedpid = wait; + dbg('connect', "caught $pid"); } @@ -104,7 +109,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 = ""; } @@ -122,7 +127,8 @@ sub rec_socket $mode = $line; # set echo mode from cluster my $term = POSIX::Termios->new; $term->getattr(fileno($sock)); - $term->setflag( &POSIX::ISIG ); + $term->setiflag( 0 ); + $term->setoflag( 0 ); $term->setattr(fileno($sock), &POSIX::TCSANOW ); } } elsif ($sort eq 'I') { @@ -158,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 = (" "); @@ -173,12 +180,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 +193,10 @@ sub rec_stdin $lasttime = time; } +sub optioncb +{ +} + sub doconnect { my ($sort, $line) = @_; @@ -195,18 +206,19 @@ sub doconnect my ($host, $port) = split /\s+/, $line; $port = 23 if !$port; - if ($port == 23) { - $sock = new Net::Telnet (Timeout => $timeout, BinMode => 1); - $sock->option_accept(Dont => TELOPT_ECHO, Wont => TELOPT_ECHO); +# 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') { +# } 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 IO::File; $wfh = new IO::File; @@ -245,8 +257,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; @@ -273,7 +286,7 @@ sub dochat sub timeout { dbg('connect', "timed out after $timeout seconds"); - cease(10); + cease(0); } @@ -283,12 +296,12 @@ 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 = 60; # default timeout for connects @@ -304,25 +317,20 @@ $stdout = *STDOUT; $rfh = 0; $wfh = 0; +$waitedpid = 0; # # deal with args # $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(); @@ -337,9 +345,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; @@ -347,8 +418,8 @@ if ($connsort eq "connect") { open(IN, "$cpath/$mcall") or cease(2); @in = ; close IN; - - # alarm($timeout); + + alarm($timeout); for (@in) { chomp; @@ -357,20 +428,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"); @@ -385,12 +461,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);