add DXCIDR, fix version no tracking

[spider.git] / perl / winclient.pl

diff --git a/perl/winclient.pl b/perl/winclient.pl
index f7f264b9b7f1dd6d1687fb74b40266b9092da429..b11be3e910697a20a4df5b735110ce63bf021ca9 100755 (executable)
--- 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;
+