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";
44 $mode = 2; # 1 - \n = \r as EOL, 2 - \n = \n, 0 - transparent
45 $call = ""; # the callsign being used
46 @stdoutq = (); # the queue of stuff to send out to the user
47 $conn = 0; # the connection object for the cluster
48 $lastbit = ""; # the last bit of an incomplete input line
49 $mynl = "\n"; # standard terminator
50 $lasttime = time; # lasttime something happened on the interface
51 $outqueue = ""; # the output queue length
52 $buffered = 1; # buffer output
53 $savenl = ""; # an NL that has been saved from last time
55 # cease communications
59 if (defined $conn && $sendz) {
60 $conn->send_now("Z$call|bye...\n");
65 # terminate program from signal
74 $SIG{CHLD} = \&sig_chld;
89 # handle incoming messages
92 my ($con, $msg, $err) = @_;
93 if (defined $err && $err) {
97 my ($sort, $call, $line) = $msg =~ /^(\w)(\S+)\|(.*)$/;
102 $snl = "" if $mode == 0;
103 if ($mode && $line =~ />$/) {
107 $line =~ s/\n/\r/og if $mode == 1;
108 #my $p = qq($line$snl);
110 if (length $outqueue >= 128) {
114 $outqueue .= "$savenl$line$snl";
117 print $savenl, $line, $snl;;
119 $savenl = $newsavenl;
120 } elsif ($sort eq 'M') {
121 $mode = $line; # set new mode from cluster
123 } elsif ($sort eq 'B') {
124 if ($buffered && $outqueue) {
128 $buffered = $line; # set buffered or unbuffered
129 } elsif ($sort eq 'Z') { # end, disconnect, go, away .....
145 $r = sysread($fh, $buf, 1024);
146 # print "sys: $r $buf";
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 $conn->send_now("D$call|$first");
167 $savenl = ""; # reset savenl 'cos we will have done a newline on input
169 $conn->send_now("D$call|$buf");
177 $call = uc shift @ARGV;
178 $call = uc $myalias if !$call;
179 $connsort = lc shift @ARGV;
180 $connsort = 'local' if !$connsort;
181 $mode = ($connsort =~ /^ax/o) ? 1 : 2;
183 # is this an out going connection?
184 if ($ARGV[0] eq "connect") {
185 shift @ARGV; # lose the keyword
190 if ($call eq $mycall) {
191 print "You cannot connect as your cluster callsign ($mycall)", $nl;
195 #select STDOUT; $| = 1;
196 STDOUT->autoflush(1);
198 $SIG{'INT'} = \&sig_term;
199 $SIG{'TERM'} = \&sig_term;
200 $SIG{'HUP'} = \&sig_term;
201 $SIG{'CHLD'} = \&sig_chld;
203 $conn = Msg->connect("$clusteraddr", $clusterport, \&rec_socket);
204 $conn->send_now("A$call|$connsort");
205 Msg->set_event_handler(\*STDIN, "read" => \&rec_stdin);
209 Msg->event_loop(1, 0.010);
211 if ($t > $lasttime) {