X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FExtMsg.pm;h=5d001ae4358ee9484a60dc70e8469a145c7cf7d8;hb=7f8810e2112b1fa4a68472c265a71906e7dcccd3;hp=8e17cfa875c251dbb2c850bc4d636bd48b2fffe0;hpb=579810d363939640538f88a9caa86e01fe9c7709;p=spider.git

diff --git a/perl/ExtMsg.pm b/perl/ExtMsg.pm
index 8e17cfa8..5d001ae4 100644
--- a/perl/ExtMsg.pm
+++ b/perl/ExtMsg.pm
@@ -23,7 +23,7 @@ use IPC::Open3;
 
 use vars qw($VERSION $BRANCH);
 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
-$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0;
+$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /^\d+\.\d+(?:\.(\d+)\.(\d+))?$/  || (0,0));
 $main::build += $VERSION;
 $main::branch += $BRANCH;
 
@@ -32,6 +32,11 @@ use vars qw(@ISA $deftimeout);
 @ISA = qw(Msg);
 $deftimeout = 60;
 
+sub login
+{
+	goto &main::login;        # save some writing, this was the default
+}
+
 sub enqueue
 {
 	my ($conn, $msg) = @_;
@@ -95,7 +100,7 @@ sub dequeue
 			dbg("connect $conn->{cnum}: $msg") if $conn->{state} ne 'C' && isdbg('connect');
 		
 			$msg =~ s/\xff\xfa.*\xff\xf0|\xff[\xf0-\xfe].//g; # remove telnet options
-			$msg =~ s/[\x00-\x08\x0a-\x19\x1b-\x1f\x80-\x9f]/./g;         # immutable CSI sequence + control characters
+#			$msg =~ s/[\x00-\x08\x0a-\x19\x1b-\x1f\x80-\x9f]/./g;         # immutable CSI sequence + control characters
 			
 			if ($conn->{state} eq 'C') {
 				&{$conn->{rproc}}($conn, "I$conn->{call}|$msg");
@@ -152,8 +157,9 @@ sub to_connected
 	delete $conn->{cmd};
 	$conn->{timeout}->del if $conn->{timeout};
 	delete $conn->{timeout};
+	$conn->nolinger;
 	&{$conn->{rproc}}($conn, "$dir$call|$sort");
-	$conn->_send_file("$main::data/connected") unless $conn->{outgoing};
+	$conn->_send_file("$main::data/connected") unless $conn->{outbound};
 }
 
 sub new_client {
@@ -162,6 +168,7 @@ sub new_client {
 	if ($sock) {
 		my $conn = $server_conn->new($server_conn->{rproc});
 		$conn->{sock} = $sock;
+		$conn->nolinger;
 		Msg::blocking($sock, 0);
 		$conn->{blocking} = 0;
 		eval {$conn->{peerhost} = $sock->peerhost};
@@ -205,12 +212,9 @@ sub start_connect
 	my $call = shift;
 	my $fn = shift;
 	my $conn = ExtMsg->new(\&main::new_channel); 
-	$conn->{outgoing} = 1;
+	$conn->{outbound} = 1;
 	$conn->conns($call);
-	
-	my $f = new IO::File $fn;
-	push @{$conn->{cmd}}, <$f>;
-	$f->close;
+	push @{$conn->{cmd}}, @_;
 	$conn->{state} = 'WC';
 	$conn->_dotimeout($deftimeout);
 	$conn->_docmd;
@@ -257,11 +261,17 @@ sub _doconnect
 	dbg("CONNECT $conn->{cnum} sort: $sort command: $line") if isdbg('connect');
 	if ($sort eq 'telnet') {
 		# this is a straight network connect
-		my ($host, $port) = split /\s+/, $line;
+		my ($host, $port, $type) = split /\s+/, $line;
+		if ($type && ref($conn) ne $type) {
+			bless $conn, $type;
+			$conn->set_newchannel_rproc;
+			dbg("$conn->{cnum} to $host $port reblessed as $type") if isdbg('connect');
+		}
 		$port = 23 if !$port;
 		$r = $conn->connect($host, $port);
 		if ($r) {
 			dbg("Connected $conn->{cnum} to $host $port") if isdbg('connect');
+
 		} else {
 			dbg("***Connect $conn->{cnum} Failed to $host $port $!") if isdbg('connect');
 		}
@@ -270,49 +280,7 @@ sub _doconnect
 		bless $conn, 'AGWMsg';
 		$r = $conn->connect($line);
 	} elsif ($sort eq 'ax25' || $sort eq 'prog') {
-		local $^F = 10000;		# make sure it ain't closed on exec
-		my ($a, $b) = IO::Socket->socketpair(AF_UNIX, SOCK_STREAM, PF_UNSPEC);
-		if ($a && $b) {
-			$r = 1;
-			$a->autoflush(1);
-			$b->autoflush(1);
-			my $pid = fork;
-			if (defined $pid) {
-				if ($pid) {
-					close $b;
-					$conn->{sock} = $a;
-					$conn->{csort} = $sort;
-					$conn->{lineend} = "\cM" if $sort eq 'ax25';
-					$conn->{pid} = $pid;
-					if ($conn->{rproc}) {
-						my $callback = sub {$conn->_rcv};
-						Msg::set_event_handler ($a, read => $callback);
-					}
-					dbg("connect $conn->{cnum}: started pid: $conn->{pid} as $line") if isdbg('connect');
-				} else {
-					$^W = 0;
-					dbgclose();
-					STDIN->close;
-					STDOUT->close;
-					STDOUT->close;
-					*STDIN = IO::File->new_from_fd($b, 'r') or die;
-					*STDOUT = IO::File->new_from_fd($b, 'w') or die;
-					*STDERR = IO::File->new_from_fd($b, 'w') or die;
-					close $a;
-					unless ($main::is_win) {
-#						$SIG{HUP} = 'IGNORE';
-						$SIG{HUP} = $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = 'DEFAULT';
-						alarm(0);
-					}
-					exec "$line" or dbg("exec '$line' failed $!");
-				} 
-			} else {
-				dbg("cannot fork");
-				$r = undef;
-			}
-		} else {
-			dbg("no socket pair $!");
-		}
+		$r = $conn->start_program($line, $sort);
 	} else {
 		dbg("invalid type of connection ($sort)");
 	}