From: minima <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://dxcluster.org/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 = <I>;
-		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 = <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 (<IN>) {
-			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);