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
  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
  53
  54 # cease communications
  55 sub cease
  56 {
  57   my $sendz = shift;
  58   if (defined $conn && $sendz) {
  59     $conn->send_now("Z$call|bye...\n");
  60   }
  61   exit(0);
  62 }
  63
  64 # terminate program from signal
  65 sub sig_term
  66 {
  67   cease(1);
  68 }
  69
  70 # terminate a child
  71 sub sig_chld
  72 {
  73   $SIG{CHLD} = \&sig_chld;
  74   $waitedpid = wait;
  75 }
  76
  77
  78 sub setmode
  79 {
  80   if ($mode == 1) {
  81     $mynl = "\r";
  82   } else {
  83         $mynl = "\n";
  84   }
  85   $/ = $mynl;
  86 }
  87
  88 # handle incoming messages
  89 sub rec_socket
  90 {
  91   my ($con, $msg, $err) = @_;
  92   if (defined $err && $err) {
  93     cease(1);
  94   }
  95   if (defined $msg) {
  96     my ($sort, $call, $line) = $msg =~ /^(\w)(\S+)\|(.*)$/;
  97
  98         if ($sort eq 'D') {
  99            my $snl = $mynl;
 100            my $newsavenl = "";
 101            $snl = "" if $mode == 0;
 102            if ($mode && $line =~ />$/) {
 103              $newsavenl = $snl;
 104                  $snl = ' ';
 105            }
 106            $line =~ s/\n/\r/og if $mode == 1;
 107            #my $p = qq($line$snl);
 108            if ($buffered) {
 109              if (length $outqueue >= 128) {
 110                print $outqueue;
 111                    $outqueue = "";
 112              }
 113              $outqueue .= "$savenl$line$snl";
 114                  $lasttime = time;
 115            } else {
 116              print $savenl, $line, $snl;;
 117            }
 118            $savenl = $newsavenl;
 119         } elsif ($sort eq 'M') {
 120           $mode = $line;               # set new mode from cluster
 121       setmode();
 122         } elsif ($sort eq 'B') {
 123           if ($buffered && $outqueue) {
 124             print $outqueue;
 125                 $outqueue = "";
 126           }
 127           $buffered = $line;           # set buffered or unbuffered
 128     } elsif ($sort eq 'Z') {       # end, disconnect, go, away .....
 129           cease(0);
 130     }
 131   }
 132   $lasttime = time;
 133 }
 134
 135 sub rec_stdin
 136 {
 137   my ($fh) = @_;
 138   my $buf;
 139   my @lines;
 140   my $r;
 141   my $first;
 142   my $dangle = 0;
 143
 144   $r = sysread($fh, $buf, 1024);
 145 #  print "sys: $r $buf";
 146   if ($r > 0) {
 147     if ($mode) {
 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
 152             $buf = pop @lines;
 153           } else {
 154             $buf = "";
 155           }
 156           $first = shift @lines;
 157           unshift @lines, ($lastbit . $first) if ($first);
 158           foreach $first (@lines) {
 159             $conn->send_now("D$call|$first");
 160           }
 161           $lastbit = $buf;
 162           $savenl = "";     # reset savenl 'cos we will have done a newline on input
 163         } else {
 164           $conn->send_now("D$call|$buf");
 165         }
 166   } elsif ($r == 0) {
 167     cease(1);
 168   }
 169   $lasttime = time;
 170 }
 171
 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;
 177
 178 # is this an out going connection?
 179 if ($ARGV[0] eq "connect") {
 180   shift @ARGV;          # lose the keyword
 181
 182 }
 183
 184 setmode();
 185 if ($call eq $mycall) {
 186   print "You cannot connect as your cluster callsign ($mycall)", $nl;
 187   cease(0);
 188 }
 189
 190 #select STDOUT; $| = 1;
 191 STDOUT->autoflush(1);
 192
 193 $SIG{'INT'} = \&sig_term;
 194 $SIG{'TERM'} = \&sig_term;
 195 $SIG{'HUP'} = \&sig_term;
 196 $SIG{'CHLD'} = \&sig_chld;
 197
 198 $conn = Msg->connect("$clusteraddr", $clusterport, \&rec_socket);
 199 $conn->send_now("A$call|$connsort");
 200 Msg->set_event_handler(\*STDIN, "read" => \&rec_stdin);
 201
 202 for (;;) {
 203   my $t;
 204   Msg->event_loop(1, 0.010);
 205   $t = time;
 206   if ($t > $lasttime) {
 207     if ($outqueue) {
 208           print $outqueue;
 209           $outqueue = "";
 210         }
 211         $lasttime = $t;
 212   }
 213 }
 214