From: minima Date: Tue, 13 Mar 2001 21:57:48 +0000 (+0000) Subject: removed client.pl X-Git-Tag: R_1_47~130 X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=commitdiff_plain;h=0f516cc02156132d67bce4b98ba6f1c8ce60eb3c;p=spider.git removed client.pl --- diff --git a/Changes b/Changes index e657a569..21e2e2c2 100644 --- a/Changes +++ b/Changes @@ -3,6 +3,7 @@ 2. removed memory leakage in connects 3. add link IP address if available on who 4. made the \r\n work correctly +5. removed client.pl 10Mar01======================================================================= 1. minor changes to the admin manual to reflect differences in distibutions thanks to pa3ezl (g0vgs) diff --git a/perl/client.pl b/perl/client.pl deleted file mode 100755 index f159ee79..00000000 --- a/perl/client.pl +++ /dev/null @@ -1,559 +0,0 @@ -#!/usr/bin/perl -w -# -# A thing that implements dxcluster 'protocol' -# -# This is a perl module/program that sits on the end of a dxcluster -# 'protocol' connection and deals with anything that might come along. -# -# this program is called by ax25d or inetd and gets raw ax25 text on its input -# It can also be launched into the ether by the cluster program itself for outgoing -# connections -# -# Calling syntax is:- -# -# client.pl [callsign] [telnet|ax25|local] [[connect] [program name and args ...]] -# -# if the callsign isn't given then the sysop callsign in DXVars.pm is assumed -# -# if there is no connection type then 'local' is assumed -# -# if there is a 'connect' keyword then it will try to launch the following program -# and any arguments and connect the stdin & stdout of both the program and the -# client together. -# -# Copyright (c) 1998 Dirk Koopman G1TLH -# -# $Id$ -# - -require 5.004; - -# search local then perl directories -BEGIN { - # root of directory tree for this system - $root = "/spider"; - $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'}; - - unshift @INC, "$root/perl"; # this IS the right way round! - unshift @INC, "$root/local"; -} - -use Msg; -use IntMsg; -use DXVars; -use DXDebug; -use DXUtil; -use Net::Telnet qw(TELOPT_ECHO TELOPT_BINARY); -use IO::File; -use IO::Socket; -use IPC::Open2; - -# cease communications -sub cease -{ - my $sendz = shift; -# if ($conn && $sendz) { -# $conn->send_now("Z$call|bye..."); -# sleep(1); -# } - $stdout->flush if $stdout; - if ($pid) { - dbg('connect', "killing $pid"); - kill(9, $pid); - } - dbgclose(); -# $SIG{__WARN__} = sub {my $a = shift; cluck($a); }; - sleep(1); - - # do we need this ? - $conn->disconnect if $conn; - exit(0); -} - -# terminate program from signal -sub sig_term -{ - cease(1); -} - -# terminate a child -sub sig_chld -{ - unless ($^O =~ /^MS/i) { - $SIG{CHLD} = \&sig_chld; - $waitedpid = wait; - dbg('connect', "caught $waitedpid"); - } -} - - -sub setmode -{ - if ($mode == 1) { - $mynl = "\r"; - $out_lineend = "\r"; - } else { - $mynl = "\n"; - $out_lineend = "\r\n"; - } - $/ = $mynl; - $out_lineend = $mynl; -} - -# handle incoming messages -sub rec_socket -{ - my ($con, $msg, $err) = @_; - if (defined $err && $err) { - cease(0); - } - if (defined $msg) { - my ($sort, $call, $line) = $msg =~ /^(\w)([^\|]+)\|(.*)$/; - - if ($sort eq 'D') { - my $snl = $mynl; - my $newsavenl = ""; - $snl = "" if $mode == 0; - $snl = "\r\n" if $mode == 3; - $snl = "\n" if $mode == 2; - if ($mode == 2 && $line =~ />$/) { - $newsavenl = $snl; - $snl = ' '; - } - $line =~ s/\n/\r/og if $mode == 1; - #my $p = qq($line$snl); - if ($buffered) { - if (length $outqueue >= $client_buffer_lth) { - print $stdout $outqueue; - pop @echo while (@echo > $maxecho); - push @echo, $outqueue; - $outqueue = ""; - } - $outqueue .= "$savenl$line$snl"; - $lasttime = time; - } else { - print $stdout $savenl, $line, $snl;; - } - $savenl = $newsavenl; - } 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; - pop @echo while(@echo > $maxecho); - push @echo, $outqueue; - $outqueue = ""; - } - $buffered = $line; # set buffered or unbuffered - } elsif ($sort eq 'Z') { # end, disconnect, go, away ..... - cease(0); - } - - # ****************************************************** - # ****************************************************** - # any other sorts that might happen are silently ignored. - # ****************************************************** - # ****************************************************** - } else { - cease(0); - } - $lasttime = time; -} - -sub rec_stdin -{ - my ($fh) = @_; - my $buf; - my @lines; - my $r; - my $first; - my $dangle = 0; - - $r = sysread($fh, $buf, 1024); - # my $prbuf; - # $prbuf = $buf; - # $prbuf =~ s/\r/\\r/; - # $prbuf =~ s/\n/\\n/; - # print "sys: $r ($prbuf)\n"; - if (!defined $r || $r == 0) { - cease(1); - } elsif ($r > 0) { - if ($mode) { - $buf =~ s/\r/\n/g if $mode == 1; - $buf =~ s/[\r\x00]//g if $mode == 2 || $mode == 3; - - $dangle = !($buf =~ /\n$/); - if ($buf eq "\n") { - @lines = (" "); - } else { - @lines = split /\n/, $buf; - } - if ($dangle) { # pull off any dangly bits - $buf = pop @lines; - } else { - $buf = ""; - } - $first = shift @lines; - 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; - $savenl = ""; # reset savenl 'cos we will have done a newline on input - } else { - $conn->send_later("I$call|$buf"); - } - } - $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, $port) = split /\s+/, $line; - $port = 23 if !$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 $!"; - if ($port == 23) { - $sock->telnetmode(1); - $sock->option_send(Dont => TELOPT_ECHO, Wont => TELOPT_ECHO) if $port == 23; - } else { - $sock->telnetmode(0); - } - $sock->binmode(0); - $mode = 3; - } elsif ($sort eq 'ax25' || $sort eq 'prog') { - my @args = split /\s+/, $line; - $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); - $mode = 1; - } else { - die "invalid type of connection ($sort)"; - } - $csort = $sort; -} - -sub doabort -{ - my $string = shift; - dbg('connect', "abort $string"); - $abort = $string; -} - -sub dotimeout -{ - my $val = shift; - dbg('connect', "timeout set to $val"); - $timeout = $val; -} - -sub dolineend -{ - my $val = shift; - $out_lineend = $val; - $out_lineend =~ s/\\r/\r/g; - $out_lineend =~ s/\\n/\n/g; - dbg('connect', "lineend set to $val "); - $out_lineend = $mynl unless $out_lineend; -} - -sub dochat -{ - my ($expect, $send) = @_; - dbg('connect', "CHAT \"$expect\" -> \"$send\""); - my $line; - - alarm($timeout); - - if ($expect) { - for (;;) { - if ($csort eq 'telnet') { - $line = $sock->get(); - cease(11) unless $line; # the socket has gone away? - if (length $line == 0) { - dbg('connect', "received 0 length line, aborting..."); - cease(11); - } - $line =~ s/\r//g; - chomp; - } elsif ($csort eq 'ax25' || $csort eq 'prog') { - local $/ = "\r"; - $line = <$rfh>; - if (length $line == 0) { - dbg('connect', "received 0 length line, aborting..."); - cease(11); - } - $line =~ s/\r/\n/g; - chomp; - } - dbg('connect', map { "received \"$_\"" } split /\n/, $line); - if ($abort && $line =~ /$abort/i) { - dbg('connect', "aborted on /$abort/"); - cease(11); - } - last if $line =~ /$expect/i; - } - } - if ($send) { - if ($csort eq 'telnet') { -# local $\ = $out_lineend; - $sock->print("$send\n"); - } elsif ($csort eq 'ax25') { - local $\ = $out_lineend; - $wfh->print("$send"); - } - dbg('connect', "sent \"$send\""); - } -} - -sub timeout -{ - dbg('connect', "timed out after $timeout seconds"); - 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]; -} - -# -# initialisation -# - -$mode = 2; # 1 - \n = \r as EOL, 2 - \n = \n, 0 - transparent -$call = ""; # the callsign being used -$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 -$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 -$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 -$sock = 0; # connection socket -$out_lineend = $mynl; # connection lineending (used for outgoing connects) - -$stdin = *STDIN; -$stdout = *STDOUT; -$rfh = 0; -$wfh = 0; - -$waitedpid = 0; - -# -# deal with args -# - -$call = uc shift @ARGV if @ARGV; -$call = uc $myalias if !$call; -$connsort = lc shift @ARGV if @ARGV; -$connsort = 'local' if !$connsort; - -$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) { - print $stdout "You cannot connect as your cluster callsign ($mycall)", $nl; - cease(0); -} - -$stdout->autoflush(1); - -unless ($^O =~ /^MS/i) { - $SIG{'INT'} = \&sig_term; - $SIG{'TERM'} = \&sig_term; - $SIG{'HUP'} = \&sig_term; - $SIG{'CHLD'} = \&sig_chld; -} - -dbgadd('connect'); - -# do we need to do a login and password job? -if ($loginreq) { - my $user; - my $s; - - $connsort = 'telnet' if $connsort eq 'local'; - setmode(); - - 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; - } - - # 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 - alarm($timeout); - - $stdout->print('login: '); - $stdout->flush(); - local $\ = $mynl; - $s = $stdin->getline(); - chomp $s; - $s =~ s/\s+//og; - $s =~ s/-\d+$//o; # no ssids! - cease(0) unless $s && $s gt ' '; - unless (is_callsign($s)) { - $stdout->print("Sorry, $s is an invalid callsign"); - cease(0); - } - $call = uc $s; - alarm(0); -} - -# is this an out going connection? -if ($connsort eq "connect") { - my $mcall = lc $call; - - open(IN, "$cpath/$mcall") or cease(2); - @in = ; - close IN; - - alarm($timeout); - - for (@in) { - chomp; - next if /^\s*\#/o; - next if /^\s*$/o; - 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; - dolineend($1) if /^\s*[Ll]\w*\s+\'((?:\\[rn])+)\'/; - dochat($1, $2) if /^\s*\'(.*)\'\s+\'(.*)\'/io; - - if (/^\s*cl\w+\s+(.*)/io) { - doclient($1); - last; - } - } - - dbg('connect', "Connected to $call ($csort), starting normal protocol"); - dbgsub('connect'); - - # if we get here we are connected - 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"); - # close $sock; - $stdin = $sock; - $stdout = $sock; - } - alarm(0); - $outbound = 1; - $connsort = $csort; - $stdout->autoflush(1); - $mode = ($connsort eq 'ax25') ? 1 : $mode; - close STDIN; - close STDOUT; - close STDERR; -} - -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) { - $ssid = 15 if $ssid > 15; - if ($connsort eq 'ax25') { - if ($ssid > 8) { - $ssid = 15 - $ssid; - } - } - $call = "$scall-$ssid"; -} - - -$conn = IntMsg->connect("$clusteraddr", $clusterport, \&rec_socket); -if (! $conn) { - if (-r "$data/offline") { - open IN, "$data/offline" or die; - while () { - s/\n/\r/og if $mode == 1; - print $stdout $_; - } - close IN; - } else { - print $stdout "Sorry, the cluster $mycall is currently off-line", $mynl; - } - cease(0); -} - -$let = $outbound ? 'O' : 'A'; -$conn->send_now("$let$call|$connsort"); -Msg->set_event_handler($stdin, "read" => \&rec_stdin); - -for (;;) { - my $t; - Msg->event_loop(1, 0.1); - $t = time; - if ($t > $lasttime) { - if ($outqueue) { - print $stdout $outqueue; - $outqueue = ""; - } - $lasttime = $t; - } -} - -exit(0);