X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;ds=sidebyside;f=perl%2Fclient.pl;h=4a4069f07313c0a6d567bbb14a90e76eb499224d;hb=cc91428ca79b3cdfdc7733505384f5983ad6c7fa;hp=8d2d683b1ac68974a80c2935c352380794766639;hpb=0565e35bbb112b94c89f693dcb74ac7efa9e424a;p=spider.git diff --git a/perl/client.pl b/perl/client.pl index 8d2d683b..4a4069f0 100755 --- a/perl/client.pl +++ b/perl/client.pl @@ -26,6 +26,7 @@ # $Id$ # +require 5.004; # search local then perl directories BEGIN { @@ -40,7 +41,6 @@ BEGIN { use Msg; use DXVars; use DXDebug; -use DXUser; use IO::File; use IO::Socket; use IPC::Open2; @@ -55,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); } @@ -71,6 +74,7 @@ sub sig_chld { $SIG{CHLD} = \&sig_chld; $waitedpid = wait; + dbg('connect', "caught $pid"); } @@ -105,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 = ""; } @@ -123,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') { @@ -201,19 +206,18 @@ sub doconnect my ($host, $port) = split /\s+/, $line; $port = 23 if !$port; - if ($port == 23) { - $sock = new Net::Telnet (Timeout => $timeout); +# 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 $!"; - - } +# } 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; @@ -282,7 +286,7 @@ sub dochat sub timeout { dbg('connect', "timed out after $timeout seconds"); - cease(10); + cease(0); } @@ -292,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 @@ -313,6 +317,7 @@ $stdout = *STDOUT; $rfh = 0; $wfh = 0; +$waitedpid = 0; # # deal with args @@ -340,6 +345,7 @@ $SIG{'INT'} = \&sig_term; $SIG{'TERM'} = \&sig_term; $SIG{'HUP'} = 'IGNORE'; $SIG{'CHLD'} = \&sig_chld; +$SIG{'ALRM'} = \&timeout; dbgadd('connect'); @@ -355,10 +361,12 @@ if ($loginreq) { close(I); $issue = s/\n/\r/og if $mode == 1; local $/ = $nl; - $stdout->print($issue) if issue; + $stdout->print($issue) if $issue; } + use DXUser; + DXUser->init($userfn); # allow a login from an existing user. I could create a user but @@ -410,8 +418,8 @@ if ($connsort eq "connect") { open(IN, "$cpath/$mcall") or cease(2); @in = ; close IN; - - # alarm($timeout); + + alarm($timeout); for (@in) { chomp; @@ -438,7 +446,7 @@ if ($connsort eq "connect") { # close W; $stdin = $rfh; $stdout = $wfh; - $csort = 'telnet' if $sort eq 'prog'; + $csort = 'telnet' if $csort eq 'prog'; } elsif ($csort eq 'telnet') { # open(STDIN, "<&$sock"); # open(STDOUT, ">&$sock");