2 # The rudimentary beginnings of a Spider client which is known to run on ActiveState
5 # It's very scrappy, but it *does* do enough to allow SysOp console access. It also
6 # means that since it's perl, Dirk might pretty it up a bit :-)
10 # Iain Philipps, G0RDI 03-Mar-01
17 # search local then perl directories
19 use vars qw($root $myalias $mycall $clusteraddr $clusterport $data);
21 # root of directory tree for this system
23 $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
25 unshift @INC, "$root/perl"; # this IS the right way round!
26 unshift @INC, "$root/local";
37 my $call = uc shift @ARGV if @ARGV;
38 $call = uc $myalias if !$call;
39 my ($scall, $ssid) = split /-/, $call;
40 $ssid = undef unless $ssid && $ssid =~ /^\d+$/;
42 $ssid = 15 if $ssid > 15;
43 $call = "$scall-$ssid";
45 if ($call eq $mycall) {
46 print "You cannot connect as your cluster callsign ($mycall)\n";
51 my $handle = IO::Socket::INET->new(Proto => "tcp",
52 PeerAddr => $clusteraddr,
53 PeerPort => $clusterport);
55 if (-r "$data/offline") {
56 open IN, "$data/offline" or die;
62 print "Sorry, the cluster $mycall is currently off-line\n";
67 # Fork one in / one out .....
69 die "can't fork: $!" unless defined($childpid = fork());
71 # the communication .....
74 while (defined (my $msg = <$handle>)) {
75 my ($sort, $call, $line) = $msg =~ /^(\w)([^\|]+)\|(.*)$/;
77 kill 'TERM', $childpid;
78 } elsif ($sort eq 'E' || $sort eq 'B') {
81 # newline ends all lines except a prompt
83 if ($line =~ /^$call de $mycall\s+\d+-\w\w\w-\d+\s+\d+Z >$/) {
89 kill 'TERM', $childpid;
91 $handle->autoflush(1);
92 print $handle "A$call|local\n";
93 while (defined (my $line = <STDIN>)) {
94 print $handle "I$call|$line\n";