X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fwinclient.pl;h=96898000701d404f4bf75d31d617eed29c809121;hb=refs%2Fheads%2Fnewdisc;hp=cf0da0a2ffef78deeceeac86b0356e9a8e3f64e1;hpb=939f8bb6109d870978d7db849136c8a2aa945e4d;p=spider.git diff --git a/perl/winclient.pl b/perl/winclient.pl index cf0da0a2..96898000 100755 --- a/perl/winclient.pl +++ b/perl/winclient.pl @@ -1,11 +1,11 @@ -#!/usr/bin/perl -w +#!/usr/bin/env perl # The rudimentary beginnings of a Spider client which is known to run on ActiveState # Perl under Win32 # # 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 # @@ -28,7 +28,10 @@ BEGIN { use IO::Socket; use DXVars; +use SysVar; + use IO::File; +use Config; # # deal with args @@ -64,40 +67,67 @@ 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) { - my ($lastend, $end); + +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; + return; } elsif ($sort eq 'E' || $sort eq 'B') { ; } else { # newline ends all lines except a prompt $lastend = $end; $end = "\n"; - if ($line =~ /^$call de $mycall\s+\d+-\w\w\w-\d+\s+\d+Z >$/) { + if ($line =~ /^$call de $mycall\s+\d+-\w\w\w-\d+\s+\d+Z >$/o) { $end = ' '; } my $begin = ($lastend eq "\n") ? '' : "\n"; print $begin . $line . $end; } } - kill 'TERM', $childpid; -} else { - $handle->autoflush(1); - print $handle "A$call|local\n"; +} + +sub dostdin +{ while (defined (my $line = )) { print $handle "I$call|$line\n"; + if ($t && ($line =~ /^b/i || $line =~ /^q/i)) { + return; + } } } -exit 0; +