X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fconnect.pl;h=3068bbe7feb017a6bf46df88db530bba6e5a0964;hb=refs%2Fheads%2Fip_address;hp=f50c89dd2cd9ee89eee7b86032a9d2cf369e4dcd;hpb=27854d917fc31b9f2dd184c24e6f38265a3a09e8;p=spider.git

diff --git a/perl/connect.pl b/perl/connect.pl
index f50c89dd..3068bbe7 100755
--- a/perl/connect.pl
+++ b/perl/connect.pl
@@ -23,71 +23,187 @@
 #
 # Copyright (c) Dirk Koopman G1TLH
 #
-# $Id$
+#
 #
 
 # 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";
+	# 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 DXVars;
 use IO::Socket;
-use POSIX;
+use IO::File;
+use Open2;
+use DXDebug;
+use POSIX qw(dup);
 use Carp;
 
-$timeout = 30;         # default timeout for each stage of the connect
-$abort = '';           # default connection abort string
-$path = "$root/connect";    # the basic connect directory
-$client = "$root/perl/client.pl";   # default client
+$timeout = 30;					# default timeout for each stage of the connect
+$abort = '';					# default connection abort string
+$path = "$root/connect";		# the basic connect directory
+$client = "$root/perl/client.pl"; # default client
+
+$connected = 0;					# we have successfully connected or started an interface program
+$pid = 0;                       # the pid of the child program
+$csort = "";                    # the connection type
+$sock = 0;                      # connection socket
+
+sub timeout;
+sub term;
+sub reap;
 
-$connected = 0;        # we have successfully connected or started an interface program
+$SIG{ALRM} = \&timeout;
+$SIG{TERM} = \&term;
+$SIG{INT} = \&term;
+$SIG{REAP} = \&reap;
+$SIG{HUP} = 'IGNORE';
 
-exit(1) if !$ARGV[0];       # bang out if no callsign
+exit(1) if !$ARGV[0];			# bang out if no callsign
 open(IN, "$path/$ARGV[0]") or exit(2);
+@in = <IN>;
+close IN;
+STDOUT->autoflush(1);
+dbgadd('connect');
 
-while (<IN>) {
-  chomp;
-  next if /^\s*#/o;
-  next if /^\s*$/o;
-  doconnect($1, $2) if /^\s*co\w*\s+(.*)$/io;
-  doclient($1) if /^\s*cl\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;
+alarm($timeout);
+
+for (@in) {
+	chomp;
+	next if /^\s*\#/o;
+	next if /^\s*$/o;
+	doconnect($1, $2) if /^\s*co\w*\s+(\w+)\s+(.*)$/io;
+	doclient($1) if /^\s*cl\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;          
 }
 
 sub doconnect
 {
-  my ($sort, $name) = @_;
-  print "connect $sort $name\n";
+	my ($sort, $line) = @_;
+	dbg("CONNECT sort: $sort command: $line") if isdbg('connect');
+	if ($sort eq 'net') {
+		# this is a straight network connect
+		my ($host) = $line =~ /host\s+(\w+)/o;
+		my ($port) = $line =~ /port\s+(\d+)/o;
+		$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') {
+		my @args = split /\s+/, $line;
+		$pid = open2(\*R, \*W, "$line") or die "can't do $line $!";
+		dbg("got pid $pid") if isdbg('connect');
+		W->autoflush(1);
+	} else {
+		die "can't get here";
+	}
+	$csort = $sort;
 }
 
 sub doabort
 {
-  my $string = shift;
-  print "abort $string\n";
+	my $string = shift;
+	dbg("abort $string") if isdbg('connect');
+	$abort = $string;
 }
 
 sub dotimeout
 {
-  my $val = shift;
-  print "timeout $val\n";
+	my $val = shift;
+	dbg("timeout set to $val") if isdbg('connect');
+	alarm($timeout = $val);
 }
 
 sub dochat
 {
-  my ($expect, $send) = @_;
-  print "chat '$expect' '$send'\n";
+	my ($expect, $send) = @_;
+	dbg("CHAT \"$expect\" -> \"$send\"") if isdbg('connect');
+    my $line;
+
+	alarm($timeout);
+	
+    if ($expect) {
+		if ($csort eq 'net') {
+			$line = <$sock>;
+			chomp;
+		} elsif ($csort eq 'ax25') {
+			local $/ = "\r";
+			$line = <R>;
+			$line =~ s/\r//og;
+		}
+		dbg("received \"$line\"") if isdbg('connect');
+		if ($abort && $line =~ /$abort/i) {
+			dbg("aborted on /$abort/") if isdbg('connect');
+			exit(11);
+		}
+	}
+	if ($send && (!$expect || $line =~ /$expect/i)) {
+		if ($csort eq 'net') {
+			$sock->print("$send\n");
+		} elsif ($csort eq 'ax25') {
+			local $\ = "\r";
+			W->print("$send\r");
+		}
+		dbg("sent \"$send\"") if isdbg('connect');
+	}
 }
 
 sub doclient
 {
-  my $cl = shift;
-  print "client $cl\n";
+	my ($cl, $args) = @_;
+	dbg("client: $cl args: $args") if isdbg('connect');
+    my @args = split /\s+/, $args;
+
+#	if (!defined ($pid = fork())) {
+#		dbg("can't fork") if isdbg('connect');
+#		exit(13);
+#	}
+#	if ($pid) {
+#		sleep(1);
+#		exit(0);
+#	} else {
+		
+		close(STDIN);
+		close(STDOUT);
+		if ($csort eq 'net') {
+			open STDIN, "<&$sock";
+			open STDOUT, ">&$sock";
+			exec $cl, @args;
+		} elsif ($csort eq 'ax25') {
+			open STDIN, "<&R";
+			open STDOUT, ">&W";
+			exec $cl, @args;
+		} else {
+			dbg("client can't get here") if isdbg('connect');
+			exit(13);
+		}
+#    }
+}
+
+sub timeout
+{
+	dbg("timed out after $timeout seconds") if isdbg('connect');
+	exit(10);
+}
+
+sub term
+{
+	dbg("caught INT or TERM signal") if isdbg('connect');
+	kill $pid if $pid;
+	sleep(2);
+	exit(12);
+}
+
+sub reap
+{
+    my $wpid = wait;
+	dbg("pid $wpid has died") if isdbg('connect');
 }