perl/client.pl

   1 #!/usr/bin/perl
   2 #
   3 # A thing that implements dxcluster 'protocol'
   4 #
   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.
   7 #
   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
  10 # connections
  11 #
  12 # Calling syntax is:-
  13 #
  14 # client.pl [callsign] [telnet|ax25|local] [[connect] [program name and args ...]]
  15 #
  16 # if the callsign isn't given then the sysop callsign in DXVars.pm is assumed
  17 #
  18 # if there is no connection type then 'local' is assumed
  19 #
  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
  22 # client together.
  23 #
  24 # Copyright (c) 1998 Dirk Koopman G1TLH
  25 #
  26 # $Id$
  27 #
  28
  29
  30 # search local then perl directories
  31 BEGIN {
  32   # root of directory tree for this system
  33   $root = "/spider";
  34   $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
  35
  36   unshift @INC, "$root/perl";   # this IS the right way round!
  37   unshift @INC, "$root/local";
  38 }
  39
  40 use Msg;
  41 use DXVars;
  42 use Carp;
  43
  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
  54
  55 # cease communications
  56 sub cease
  57 {
  58   my $sendz = shift;
  59   if (defined $conn && $sendz) {
  60     $conn->send_now("Z$call|bye...\n");
  61   }
  62   STDOUT->flush;
  63   sleep(2);
  64   exit(0);
  65 }
  66
  67 # terminate program from signal
  68 sub sig_term
  69 {
  70   cease(1);
  71 }
  72
  73 # terminate a child
  74 sub sig_chld
  75 {
  76   $SIG{CHLD} = \&sig_chld;
  77   $waitedpid = wait;
  78 }
  79
  80
  81 sub setmode
  82 {
  83   if ($mode == 1) {
  84     $mynl = "\r";
  85   } else {
  86         $mynl = "\n";
  87   }
  88   $/ = $mynl;
  89 }
  90
  91 # handle incoming messages
  92 sub rec_socket
  93 {
  94   my ($con, $msg, $err) = @_;
  95   if (defined $err && $err) {
  96     cease(1);
  97   }
  98   if (defined $msg) {
  99     my ($sort, $call, $line) = $msg =~ /^(\w)(\S+)\|(.*)$/;
 100
 101         if ($sort eq 'D') {
 102            my $snl = $mynl;
 103            my $newsavenl = "";
 104            $snl = "" if $mode == 0;
 105            if ($mode == 2 && $line =~ />$/) {
 106              $newsavenl = $snl;
 107                  $snl = ' ';
 108            }
 109            $line =~ s/\n/\r/og if $mode == 1;
 110            #my $p = qq($line$snl);
 111            if ($buffered) {
 112              if (length $outqueue >= 128) {
 113                print $outqueue;
 114                    $outqueue = "";
 115              }
 116              $outqueue .= "$savenl$line$snl";
 117                  $lasttime = time;
 118            } else {
 119              print $savenl, $line, $snl;;
 120            }
 121            $savenl = $newsavenl;
 122         } elsif ($sort eq 'M') {
 123           $mode = $line;               # set new mode from cluster
 124       setmode();
 125         } elsif ($sort eq 'B') {
 126           if ($buffered && $outqueue) {
 127             print $outqueue;
 128                 $outqueue = "";
 129           }
 130           $buffered = $line;           # set buffered or unbuffered
 131     } elsif ($sort eq 'Z') {       # end, disconnect, go, away .....
 132           cease(0);
 133     }
 134   }
 135   $lasttime = time;
 136 }
 137
 138 sub rec_stdin
 139 {
 140   my ($fh) = @_;
 141   my $buf;
 142   my @lines;
 143   my $r;
 144   my $first;
 145   my $dangle = 0;
 146
 147   $r = sysread($fh, $buf, 1024);
 148 #  print "sys: $r $buf";
 149   if ($r > 0) {
 150     if ($mode) {
 151           $buf =~ s/\r/\n/og if $mode == 1;
 152           $dangle = !($buf =~ /\n$/);
 153           if ($buf eq "\n") {
 154             @lines = (" ");
 155           } else {
 156             @lines = split /\n/, $buf;
 157           }
 158           if ($dangle) {                # pull off any dangly bits
 159             $buf = pop @lines;
 160           } else {
 161             $buf = "";
 162           }
 163           $first = shift @lines;
 164           unshift @lines, ($lastbit . $first) if ($first);
 165           foreach $first (@lines) {
 166             $conn->send_now("D$call|$first");
 167           }
 168           $lastbit = $buf;
 169           $savenl = "";     # reset savenl 'cos we will have done a newline on input
 170         } else {
 171           $conn->send_now("D$call|$buf");
 172         }
 173   } elsif ($r == 0) {
 174     cease(1);
 175   }
 176   $lasttime = time;
 177 }
 178
 179 $call = uc shift @ARGV;
 180 $call = uc $myalias if !$call;
 181 $connsort = lc shift @ARGV;
 182 $connsort = 'local' if !$connsort;
 183 $mode = ($connsort =~ /^ax/o) ? 1 : 2;
 184
 185 # is this an out going connection?
 186 if ($ARGV[0] eq "connect") {
 187   shift @ARGV;          # lose the keyword
 188
 189 }
 190
 191 setmode();
 192 if ($call eq $mycall) {
 193   print "You cannot connect as your cluster callsign ($mycall)", $nl;
 194   cease(0);
 195 }
 196
 197 #select STDOUT; $| = 1;
 198 STDOUT->autoflush(1);
 199
 200 $SIG{'INT'} = \&sig_term;
 201 $SIG{'TERM'} = \&sig_term;
 202 $SIG{'HUP'} = \&sig_term;
 203 $SIG{'CHLD'} = \&sig_chld;
 204
 205 $conn = Msg->connect("$clusteraddr", $clusterport, \&rec_socket);
 206 if (! $conn) {
 207   if (-r "$data/offline") {
 208     open IN, "$data/offline" or die;
 209     while (<IN>) {
 210           s/\n/\r/og if $mode == 1;
 211           print;
 212         }
 213         close IN;
 214   } else {
 215     print "Sorry, the cluster $mycall is currently off-line", $mynl;
 216   }
 217   cease(0);
 218 }
 219
 220 $conn->send_now("A$call|$connsort");
 221 Msg->set_event_handler(\*STDIN, "read" => \&rec_stdin);
 222
 223 for (;;) {
 224   my $t;
 225   Msg->event_loop(1, 0.010);
 226   $t = time;
 227   if ($t > $lasttime) {
 228     if ($outqueue) {
 229           print $outqueue;
 230           $outqueue = "";
 231         }
 232         $lasttime = $t;
 233   }
 234 }
 235