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 # $Id$
  13 #
  14
  15 BEGIN {
  16   unshift @INC, "/spider/local";
  17   unshift @INC, "/spider/perl";
  18 }
  19
  20 use Msg;
  21 use DXVars;
  22
  23 $mode = 2;                      # 1 - \n = \r as EOL, 2 - \n = \n, 0 - transparent
  24 $call = "";                     # the callsign being used
  25 @stdoutq = ();                  # the queue of stuff to send out to the user
  26 $conn = 0;                      # the connection object for the cluster
  27 $lastbit = "";                  # the last bit of an incomplete input line
  28 $mynl = "\n";                   # standard terminator
  29
  30 # cease communications
  31 sub cease
  32 {
  33   my $sendz = shift;
  34   if (defined $conn && $sendz) {
  35     $conn->send_now("Z$call|bye...\n");
  36   }
  37   exit(0);
  38 }
  39
  40 # terminate program from signal
  41 sub sig_term
  42 {
  43   cease(1);
  44 }
  45
  46 sub setmode
  47 {
  48   if ($mode == 1) {
  49     $mynl = "\r";
  50   } else {
  51         $mynl = "\n";
  52   }
  53   $/ = $mynl;
  54 }
  55
  56 # handle incoming messages
  57 sub rec_socket
  58 {
  59   my ($con, $msg, $err) = @_;
  60   if (defined $err && $err) {
  61     cease(1);
  62   }
  63   if (defined $msg) {
  64     my ($sort, $call, $line) = $msg =~ /^(\w)(\S+)\|(.*)$/;
  65
  66         if ($sort eq 'D') {
  67            my $snl = $mynl;
  68            $snl = "" if $mode == 0;
  69            $snl = ' ' if ($mode && $line =~ />$/);
  70            $line =~ s/\n/\r/og if $mode == 1;
  71            #my $p = qq($line$snl);
  72            print $line, $snl;
  73         } elsif ($sort eq 'M') {
  74           $mode = $line;               # set new mode from cluster
  75       setmode();
  76     } elsif ($sort eq 'Z') {       # end, disconnect, go, away .....
  77           cease(0);
  78     }
  79   }
  80 }
  81
  82 sub rec_stdin
  83 {
  84   my ($fh) = @_;
  85   my $buf;
  86   my @lines;
  87   my $r;
  88   my $first;
  89   my $dangle = 0;
  90
  91   $r = sysread($fh, $buf, 1024);
  92 #  print "sys: $r $buf";
  93   if ($r > 0) {
  94     if ($mode) {
  95           $buf =~ s/\r/\n/og if $mode == 1;
  96           $dangle = !($buf =~ /\n$/);
  97           @lines = split /\n/, $buf;
  98           if ($dangle) {                # pull off any dangly bits
  99             $buf = pop @lines;
 100           } else {
 101             $buf = "";
 102           }
 103           $first = shift @lines;
 104           unshift @lines, ($lastbit . $first) if ($first);
 105           foreach $first (@lines) {
 106             $conn->send_now("D$call|$first");
 107           }
 108           $lastbit = $buf;
 109         } else {
 110           $conn->send_now("D$call|$buf");
 111         }
 112   } elsif ($r == 0) {
 113     cease(1);
 114   }
 115 }
 116
 117 $call = uc shift @ARGV;
 118 $call = uc $mycall if !$call;
 119 $connsort = lc shift @ARGV;
 120 $connsort = 'local' if !$connsort;
 121 $mode = ($connsort =~ /^ax/) ? 1 : 2;
 122 setmode();
 123
 124 #select STDOUT; $| = 1;
 125 STDOUT->autoflush(1);
 126
 127 $SIG{'INT'} = \&sig_term;
 128 $SIG{'TERM'} = \&sig_term;
 129 $SIG{'HUP'} = \&sig_term;
 130
 131 $conn = Msg->connect("$clusteraddr", $clusterport, \&rec_socket);
 132 $conn->send_now("A$call|$connsort");
 133 Msg->set_event_handler(\*STDIN, "read" => \&rec_stdin);
 134 Msg->event_loop();
 135