perl/cluster.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 use Msg;
  16 use DXVars;
  17 use DXUtil;
  18 use DXChannel;
  19 use DXUser;
  20 use DXM;
  21 use DXCommandmode;
  22 use DXProt;
  23 use DXCluster;
  24 use DXDebug;
  25
  26 package main;
  27
  28 @inqueue = ();                # the main input queue, an array of hashes
  29 $systime = 0;                 # the time now (in seconds)
  30
  31 # handle disconnections
  32 sub disconnect
  33 {
  34   my $dxchan = shift;
  35   return if !defined $dxchan;
  36   my $user = $dxchan->{user};
  37   my $conn = $dxchan->{conn};
  38   $dxchan->finish();
  39   $user->close() if defined $user;
  40   $conn->disconnect() if defined $conn;
  41   $dxchan->del();
  42 }
  43
  44 # handle incoming messages
  45 sub rec
  46 {
  47   my ($conn, $msg, $err) = @_;
  48   my $dxchan = DXChannel->get_by_cnum($conn);      # get the dxconnnect object for this message
  49
  50   if (defined $err && $err) {
  51     disconnect($dxchan) if defined $dxchan;
  52         return;
  53   }
  54
  55   # set up the basic channel info - this needs a bit more thought - there is duplication here
  56   if (!defined $dxchan) {
  57      my ($sort, $call, $line) = $msg =~ /^(\w)(\S+)\|(.*)$/;
  58      my $user = DXUser->get($call);
  59          $user = DXUser->new($call) if !defined $user;
  60          $user->sort('U') if (!$user->sort());
  61          my $sort = $user->sort();
  62
  63          # is there one already connected?
  64          if (DXChannel->get($call)) {
  65            my $mess = DXM::msg('conother', $call);
  66            dbg('chan', "-> D $call $mess\n");
  67        $conn->send_now("D$call|$mess");
  68            dbg('chan', "-> Z $call bye\n");
  69        $conn->send_now("Z$call|bye");          # this will cause 'client' to disconnect
  70            return;
  71      }
  72
  73          # is there one already connected elsewhere in the cluster?
  74          if (DXCluster->get($call)) {
  75            my $mess = DXM::msg('concluster', $call);
  76            dbg('chan', "-> D $call $mess\n");
  77        $conn->send_now("D$call|$mess");
  78            dbg('chan', "-> Z $call bye\n");
  79        $conn->send_now("Z$call|bye");          # this will cause 'client' to disconnect
  80            return;
  81      }
  82
  83          # create the channel
  84      $dxchan = DXCommandmode->new($call, $conn, $user) if ($sort eq 'U');
  85      $dxchan = DXProt->new($call, $conn, $user) if ($sort eq 'A');
  86          die "Invalid sort of user on $call = $sort" if !$dxchan;
  87   }
  88
  89   # queue the message and the channel object for later processing
  90   if (defined $msg) {
  91     my $self = bless {}, "inqueue";
  92     $self->{dxchan} = $dxchan;
  93     $self->{data} = $msg;
  94         push @inqueue, $self;
  95   }
  96 }
  97
  98 sub login
  99 {
 100   return \&rec;
 101 }
 102
 103 # cease running this program, close down all the connections nicely
 104 sub cease
 105 {
 106   my $dxchan;
 107   foreach $dxchan (DXChannel->get_all()) {
 108     disconnect($dxchan);
 109   }
 110   exit(0);
 111 }
 112
 113 # this is where the input queue is dealt with and things are dispatched off to other parts of
 114 # the cluster
 115 sub process_inqueue
 116 {
 117   my $self = shift @inqueue;
 118   return if !$self;
 119
 120   my $data = $self->{data};
 121   my $dxchan = $self->{dxchan};
 122   my ($sort, $call, $line) = $data =~ /^(\w)(\S+)\|(.*)$/;
 123
 124   # do the really sexy console interface bit! (Who is going to do the TK interface then?)
 125   dbg('chan', "<- $sort $call $line\n");
 126
 127   # handle A records
 128   my $user = $dxchan->user;
 129   if ($sort eq 'A') {
 130     $dxchan->start($line);
 131   } elsif ($sort eq 'D') {
 132     die "\$user not defined for $call" if !defined $user;
 133         $dxchan->normal($line);
 134     disconnect($dxchan) if ($dxchan->{state} eq 'bye');
 135   } elsif ($sort eq 'Z') {
 136     disconnect($dxchan);
 137   } else {
 138     print STDERR atime, " Unknown command letter ($sort) received from $call\n";
 139   }
 140 }
 141
 142 #############################################################
 143 #
 144 # The start of the main line of code
 145 #
 146 #############################################################
 147
 148 # open the debug file, set various FHs to be unbuffered
 149 dbginit($debugfn);
 150 foreach(@debug) {
 151   dbgadd($_);
 152 }
 153 STDOUT->autoflush(1);
 154
 155 # initialise User file system
 156 DXUser->init($userfn);
 157
 158 # start listening for incoming messages/connects
 159 Msg->new_server("$clusteraddr", $clusterport, \&login);
 160
 161 # prime some signals
 162 $SIG{'INT'} = \&cease;
 163 $SIG{'TERM'} = \&cease;
 164 $SIG{'HUP'} = 'IGNORE';
 165
 166 # this, such as it is, is the main loop!
 167 for (;;) {
 168   my $timenow;
 169   Msg->event_loop(1, 0.001);
 170   $timenow = time;
 171   if ($timenow != $systime) {
 172     $systime = $timenow;
 173         $cldate = &cldate();
 174         $ztime = &ztime();
 175   }
 176   process_inqueue();                 # read in lines from the input queue and despatch them
 177   DXCommandmode::process();     # process ongoing command mode stuff
 178   DXProt::process();              # process ongoing ak1a pcxx stuff
 179 }
 180