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";
43 $mode = 2; # 1 - \n = \r as EOL, 2 - \n = \n, 0 - transparent
44 $call = ""; # the callsign being used
45 @stdoutq = (); # the queue of stuff to send out to the user
46 $conn = 0; # the connection object for the cluster
47 $lastbit = ""; # the last bit of an incomplete input line
48 $mynl = "\n"; # standard terminator
49 $lasttime = time; # lasttime something happened on the interface
50 $outqueue = ""; # the output queue length
51 $buffered = 1; # buffer output
52 $savenl = ""; # an NL that has been saved from last time
54 # cease communications
58 if (defined $conn && $sendz) {
59 $conn->send_now("Z$call|bye...\n");
64 # terminate program from signal
73 $SIG{CHLD} = \&sig_chld;
88 # handle incoming messages
91 my ($con, $msg, $err) = @_;
92 if (defined $err && $err) {
96 my ($sort, $call, $line) = $msg =~ /^(\w)(\S+)\|(.*)$/;
101 $snl = "" if $mode == 0;
102 if ($mode && $line =~ />$/) {
106 $line =~ s/\n/\r/og if $mode == 1;
107 #my $p = qq($line$snl);
109 if (length $outqueue >= 128) {
113 $outqueue .= "$savenl$line$snl";
116 print $savenl, $line, $snl;;
118 $savenl = $newsavenl;
119 } elsif ($sort eq 'M') {
120 $mode = $line; # set new mode from cluster
122 } elsif ($sort eq 'B') {
123 if ($buffered && $outqueue) {
127 $buffered = $line; # set buffered or unbuffered
128 } elsif ($sort eq 'Z') { # end, disconnect, go, away .....
144 $r = sysread($fh, $buf, 1024);
145 # print "sys: $r $buf";
148 $buf =~ s/\r/\n/og if $mode == 1;
149 $dangle = !($buf =~ /\n$/);
150 @lines = split /\n/, $buf;
151 if ($dangle) { # pull off any dangly bits
156 $first = shift @lines;
157 unshift @lines, ($lastbit . $first) if ($first);
158 foreach $first (@lines) {
159 $conn->send_now("D$call|$first");
162 $savenl = ""; # reset savenl 'cos we will have done a newline on input
164 $conn->send_now("D$call|$buf");
172 $call = uc shift @ARGV;
173 $call = uc $myalias if !$call;
174 $connsort = lc shift @ARGV;
175 $connsort = 'local' if !$connsort;
176 $mode = ($connsort =~ /^ax/o) ? 1 : 2;
178 # is this an out going connection?
179 if ($ARGV[0] eq "connect") {
180 shift @ARGV; # lose the keyword
185 if ($call eq $mycall) {
186 print "You cannot connect as your cluster callsign ($mycall)", $nl;
190 #select STDOUT; $| = 1;
191 STDOUT->autoflush(1);
193 $SIG{'INT'} = \&sig_term;
194 $SIG{'TERM'} = \&sig_term;
195 $SIG{'HUP'} = \&sig_term;
196 $SIG{'CHLD'} = \&sig_chld;
198 $conn = Msg->connect("$clusteraddr", $clusterport, \&rec_socket);
199 $conn->send_now("A$call|$connsort");
200 Msg->set_event_handler(\*STDIN, "read" => \&rec_stdin);
204 Msg->event_loop(1, 0.010);
206 if ($t > $lasttime) {