X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fwinclient.pl;h=b11be3e910697a20a4df5b735110ce63bf021ca9;hb=f63d598af3f797b56b8d5e23ec4ff5254192eee9;hp=f7f264b9b7f1dd6d1687fb74b40266b9092da429;hpb=f84fd5080778da7e676552f8b8641fa0bb2852bb;p=spider.git

diff --git a/perl/winclient.pl b/perl/winclient.pl
index f7f264b9..b11be3e9 100755
--- a/perl/winclient.pl
+++ b/perl/winclient.pl
@@ -5,7 +5,7 @@
 # It's very scrappy, but it *does* do enough to allow SysOp console access. It also
 # means that since it's perl, Dirk might pretty it up a bit :-)
 #
-# $Id$
+#
 #
 # Iain Philipps, G0RDI	03-Mar-01
 #
@@ -29,6 +29,7 @@ BEGIN {
 use IO::Socket;
 use DXVars;
 use IO::File;
+use Config;
 
 #
 # deal with args
@@ -64,20 +65,43 @@ unless ($handle) {
 	exit(0);
 }
 
-# Fork one in / one out .....
+STDOUT->autoflush(1);
+$handle->autoflush(1);
+print $handle "A$call|local\n";
+
+# Fork or thread one in / one out .....
 my $childpid;
-die "can't fork: $!" unless defined($childpid = fork());
+my $t;
+if ($Config{usethreads}) {
+	require Thread;
+#	print "Using Thread Method\n";
+	$t = Thread->new(\&dostdin);
+	donetwork();
+	$t->join;
+	kill(-1, $$);
+} else {
+#	print "Using Fork Method\n";
+	die "can't fork: $!" unless defined($childpid = fork());	
+	if ($childpid) {
+		donetwork();
+		kill 'TERM', $childpid;
+	} else {
+		dostdin();
+	}
+}
+exit 0;
 
-# the communication .....
-if ($childpid) {
+
+sub donetwork
+{
 	my ($lastend, $end) = ("\n", "\n");
 	
-	STDOUT->autoflush(1);
     while (defined (my $msg = <$handle>)) {
 		my ($sort, $call, $line) = $msg =~ /^(\w)([^\|]+)\|(.*)$/;
+		next unless defined $sort;
+		$line =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg;
 		if ($sort eq 'Z') {
-			kill 'TERM', $childpid;
-			exit(0);
+			return;
 		} elsif ($sort eq 'E' || $sort eq 'B') {
 			;
 		} else {
@@ -91,14 +115,17 @@ if ($childpid) {
 			print $begin . $line . $end;
 		}
     }
-    kill 'TERM', $childpid;
-} else {
-	$handle->autoflush(1);
-	print $handle "A$call|local\n";
+}
+
+sub dostdin
+{
     while (defined (my $line = <STDIN>)) {
         print $handle "I$call|$line\n";
+		if ($t && ($line =~ /^b/i || $line =~ /^q/i)) {
+			return;
+		}
     }
 }
 
-exit 0;
+