-#!/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
#
use IO::Socket;
use DXVars;
use IO::File;
+use Config;
#
# deal with args
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 = <STDIN>)) {
print $handle "I$call|$line\n";
+ if ($t && ($line =~ /^b/i || $line =~ /^q/i)) {
+ return;
+ }
}
}
-exit 0;
+