3 # A thing that implements dxcluster 'protocol'
5 # This is a perl module/program that sits on the end of a dxcluster
6 # 'protocol' connection and deals with anything that might come along.
8 # this program is called by ax25d or inetd and gets raw ax25 text on its input
9 # It can also be launched into the ether by the cluster program itself for outgoing
14 # client.pl [callsign] [telnet|ax25|local] [[connect] [program name and args ...]]
16 # if the callsign isn't given then the sysop callsign in DXVars.pm is assumed
18 # if there is no connection type then 'local' is assumed
20 # if there is a 'connect' keyword then it will try to launch the following program
21 # and any arguments and connect the stdin & stdout of both the program and the
24 # Copyright (c) 1998 Dirk Koopman G1TLH
30 # search local then perl directories
32 # root of directory tree for this system
34 $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
36 unshift @INC, "$root/perl"; # this IS the right way round!
37 unshift @INC, "$root/local";
48 # cease communications
52 if ($conn && $sendz) {
53 $conn->send_now("Z$call|bye...\n");
55 $stdout->flush if $stdout;
56 kill(15, $pid) if $pid;
61 # terminate program from signal
70 $SIG{CHLD} = \&sig_chld;
85 # handle incoming messages
88 my ($con, $msg, $err) = @_;
89 if (defined $err && $err) {
93 my ($sort, $call, $line) = $msg =~ /^(\w)(\S+)\|(.*)$/;
98 $snl = "" if $mode == 0;
99 if ($mode == 2 && $line =~ />$/) {
103 $line =~ s/\n/\r/og if $mode == 1;
104 #my $p = qq($line$snl);
106 if (length $outqueue >= 128) {
107 print $stdout $outqueue;
110 $outqueue .= "$savenl$line$snl";
113 print $stdout $savenl, $line, $snl;;
115 $savenl = $newsavenl;
116 } elsif ($sort eq 'M') {
117 $mode = $line; # set new mode from cluster
119 } elsif ($sort eq 'B') {
120 if ($buffered && $outqueue) {
121 print $stdout $outqueue;
124 $buffered = $line; # set buffered or unbuffered
125 } elsif ($sort eq 'Z') { # end, disconnect, go, away .....
141 $r = sysread($fh, $buf, 1024);
144 # $prbuf =~ s/\r/\\r/;
145 # $prbuf =~ s/\n/\\n/;
146 # print "sys: $r ($prbuf)\n";
149 $buf =~ s/\r/\n/og if $mode == 1;
150 $dangle = !($buf =~ /\n$/);
154 @lines = split /\n/, $buf;
156 if ($dangle) { # pull off any dangly bits
161 $first = shift @lines;
162 unshift @lines, ($lastbit . $first) if ($first);
163 foreach $first (@lines) {
164 # print "send_now $call $first\n";
165 $conn->send_now("D$call|$first");
168 $savenl = ""; # reset savenl 'cos we will have done a newline on input
170 $conn->send_now("D$call|$buf");
180 my ($sort, $line) = @_;
181 dbg('connect', "CONNECT sort: $sort command: $line");
182 if ($sort eq 'telnet') {
183 # this is a straight network connect
184 my ($host) = $line =~ /host\s+(\w+)/o;
185 my ($port) = $line =~ /port\s+(\d+)/o;
186 $port = 23 if !$port;
188 $sock = IO::Socket::INET->new(PeerAddr => "$host", PeerPort => "$port", Proto => 'tcp')
189 or die "Can't connect to $host port $port $!";
191 } elsif ($sort eq 'ax25') {
192 my @args = split /\s+/, $line;
193 $rfh = new FileHandle;
194 $wfh = new FileHandle;
195 $pid = open2($rfh, $wfh, "$line") or die "can't do $line $!";
196 dbg('connect', "got pid $pid");
199 die "invalid type of connection ($sort)";
207 dbg('connect', "abort $string");
214 dbg('connect', "timeout set to $val");
220 my ($expect, $send) = @_;
221 dbg('connect', "CHAT \"$expect\" -> \"$send\"");
227 if ($csort eq 'telnet') {
230 } elsif ($csort eq 'ax25') {
235 dbg('connect', "received \"$line\"");
236 if ($abort && $line =~ /$abort/i) {
237 dbg('connect', "aborted on /$abort/");
241 if ($send && (!$expect || $line =~ /$expect/i)) {
242 if ($csort eq 'telnet') {
243 $sock->print("$send\n");
244 } elsif ($csort eq 'ax25') {
246 $wfh->print("$send\r");
248 dbg('connect', "sent \"$send\"");
254 dbg('connect', "timed out after $timeout seconds");
263 $mode = 2; # 1 - \n = \r as EOL, 2 - \n = \n, 0 - transparent
264 $call = ""; # the callsign being used
265 @stdoutq = (); # the queue of stuff to send out to the user
266 $conn = 0; # the connection object for the cluster
267 $lastbit = ""; # the last bit of an incomplete input line
268 $mynl = "\n"; # standard terminator
269 $lasttime = time; # lasttime something happened on the interface
270 $outqueue = ""; # the output queue length
271 $buffered = 1; # buffer output
272 $savenl = ""; # an NL that has been saved from last time
273 $timeout = 30; # default timeout for connects
274 $abort = ""; # the current abort string
275 $cpath = "$root/connect"; # the basic connect directory
277 $pid = 0; # the pid of the child program
278 $csort = ""; # the connection type
279 $sock = 0; # connection socket
291 $call = uc shift @ARGV;
292 $call = uc $myalias if !$call;
293 $connsort = lc shift @ARGV;
294 $connsort = 'local' if !$connsort;
296 $mode = ($connsort =~ /^ax/o) ? 1 : 2;
299 if ($call eq $mycall) {
300 print $stdout "You cannot connect as your cluster callsign ($mycall)", $nl;
304 $stdout->autoflush(1);
306 $SIG{'INT'} = \&sig_term;
307 $SIG{'TERM'} = \&sig_term;
308 $SIG{'HUP'} = 'IGNORE';
309 $SIG{'CHLD'} = \&sig_chld;
313 # is this an out going connection?
314 if ($connsort eq "connect") {
315 my $mcall = lc $call;
317 open(IN, "$cpath/$mcall") or cease(2);
327 doconnect($1, $2) if /^\s*co\w*\s+(\w+)\s+(.*)$/io;
328 doabort($1) if /^\s*a\w*\s+(.*)/io;
329 dotimeout($1) if /^\s*t\w*\s+(\d+)/io;
330 dochat($1, $2) if /\s*\'(.*)\'\s+\'(.*)\'/io;
333 dbg('connect', "Connected to $call, starting normal protocol");
336 # if we get here we are connected
337 if ($csort eq 'ax25') {
338 # open(STDIN, "<&R");
339 # open(STDOUT, ">&W");
344 } elsif ($csort eq 'telnet') {
345 # open(STDIN, "<&$sock");
346 # open(STDOUT, ">&$sock");
354 $stdout->autoflush(1);
360 $mode = ($connsort =~ /^ax/o) ? 1 : 2;
366 $conn = Msg->connect("$clusteraddr", $clusterport, \&rec_socket);
368 if (-r "$data/offline") {
369 open IN, "$data/offline" or die;
371 s/\n/\r/og if $mode == 1;
376 print $stdout "Sorry, the cluster $mycall is currently off-line", $mynl;
381 $let = $outbound ? 'O' : 'A';
382 $conn->send_now("$let$call|$connsort");
383 Msg->set_event_handler($stdin, "read" => \&rec_stdin);
387 Msg->event_loop(1, 0.010);
389 if ($t > $lasttime) {
391 print $stdout $outqueue;