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 and gets raw ax25 text on its input
   9 #
  10 # Copyright (c) 1998 Dirk Koopman G1TLH
  11 #
  12 #
  13
  14 use Msg;
  15 use DXVars;
  16
  17 $mode = 1;                      # 1 - \n = \r as EOL, 2 - \n = \n, 0 - transparent
  18 $call = "";                     # the callsign being used
  19 @stdoutq = ();                  # the queue of stuff to send out to the user
  20 $conn = 0;                      # the connection object for the cluster
  21 $lastbit = "";                  # the last bit of an incomplete input line
  22
  23 # cease communications
  24 sub cease
  25 {
  26   my $sendz = shift;
  27   if (defined $conn && $sendz) {
  28     $conn->send_now("Z$call|bye...\n");
  29   }
  30   exit(0);
  31 }
  32
  33 # terminate program from signal
  34 sub sig_term
  35 {
  36   cease(1);
  37 }
  38
  39 # handle incoming messages
  40 sub rec_socket
  41 {
  42   my ($con, $msg, $err) = @_;
  43   if (defined $err && $err) {
  44     cease(1);
  45   }
  46   if (defined $msg) {
  47     my ($sort, $call, $line) = $msg =~ /^(\w)(\S+)|(.*)$/;
  48
  49         if ($sort eq 'D') {
  50            my $nl = ($mode == 1) ? "\r" : "\n";
  51            $nl = "" if $mode == 0;
  52            $line =~ s/\n/\r/o if $mode == 1;
  53            print $line, $nl;
  54         } elsif ($sort eq 'M') {
  55           $mode = $line;               # set new mode from cluster
  56         } elsif ($sort eq 'Z') {       # end, disconnect, go, away .....
  57           cease(0);
  58     }
  59   }
  60 }
  61
  62 sub rec_stdin
  63 {
  64   my ($fh) = @_;
  65   my $buf;
  66   my @lines;
  67   my $r;
  68   my $first;
  69   my $dangle = 0;
  70
  71   $r = sysread($fh, $buf, 1024);
  72 #  print "sys: $r $buf";
  73   if ($r > 0) {
  74     if ($mode) {
  75           $buf =~ s/\r/\n/o if $mode == 1;
  76           $dangle = !($buf =~ /\n$/);
  77           @lines = split /\n/, $buf;
  78           if ($dangle) {                # pull off any dangly bits
  79             $buf = pop @lines;
  80           } else {
  81             $buf = "";
  82           }
  83           $first = shift @lines;
  84           unshift @lines, ($lastbit . $first) if ($first);
  85           foreach $first (@lines) {
  86             $conn->send_now("D$call|$first");
  87           }
  88           $lastbit = $buf;
  89         } else {
  90           $conn->send_now("D$call|$buf");
  91         }
  92   } elsif ($r == 0) {
  93     cease(1);
  94   }
  95 }
  96
  97 $call = uc $ARGV[0];
  98 die "client.pl <call> [<mode>]\r\n" if (!$call);
  99 $mode = $ARGV[1] if (@ARGV > 1);
 100
 101 select STDOUT; $| = 1;
 102
 103 $SIG{'INT'} = \&sig_term;
 104 $SIG{'TERM'} = \&sig_term;
 105 $SIG{'HUP'} = \&sig_term;
 106
 107 $conn = Msg->connect("$clusteraddr", $clusterport, \&rec_socket);
 108 $conn->send_now("A$call|start");
 109 Msg->set_event_handler(\*STDIN, "read" => \&rec_stdin);
 110 Msg->event_loop();
 111