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
  21 package main;
  22
  23 @inqueue = undef;                # the main input queue, an array of hashes
  24
  25 # handle out going messages
  26 sub send_now
  27 {
  28   my ($conn, $sort, $call, $line) = @_;
  29
  30   print DEBUG "$t > $sort $call $line\n" if defined DEBUG;
  31   print "> $sort $call $line\n";
  32   $conn->send_now("$sort$call|$line");
  33 }
  34
  35 sub send_later
  36 {
  37   my ($conn, $sort, $call, $line) = @_;
  38
  39   print DEBUG "$t > $sort $call $line\n" if defined DEBUG;
  40   print "> $sort $call $line\n";
  41   $conn->send_later("$sort$call|$line");
  42 }
  43
  44 # handle disconnections
  45 sub disconnect
  46 {
  47   my $dxconn = shift;
  48   my ($user) = $dxconn->{user};
  49   my ($conn) = $dxconn->{conn};
  50   $user->close() if defined $user;
  51   $conn->disconnect();
  52   $dxconn->del();
  53 }
  54
  55 # handle incoming messages
  56 sub rec
  57 {
  58   my ($conn, $msg, $err) = @_;
  59   my $dxconn = DXChannel->get_by_cnum($conn);      # get the dxconnnect object for this message
  60
  61   if (defined $err && $err) {
  62     disconnect($dxconn);
  63         return;
  64   }
  65   if (defined $msg) {
  66     my $self = bless {}, "inqueue";
  67     $self->{dxconn} = $dxconn;
  68     $self->{data} = $msg;
  69         push @inqueue, $self;
  70   }
  71 }
  72
  73 sub login
  74 {
  75   return \&rec;
  76 }
  77
  78 # cease running this program, close down all the connections nicely
  79 sub cease
  80 {
  81   my $dxconn;
  82   foreach $dxconn (DXChannel->get_all()) {
  83     disconnect($dxconn);
  84   }
  85 }
  86
  87 # this is where the input queue is dealt with and things are dispatched off to other parts of
  88 # the cluster
  89 sub process_inqueue
  90 {
  91   my $self = shift @inqueue;
  92   return if !$self;
  93
  94   my $data = $self->{data};
  95   my $dxconn = $self->{dxconn};
  96   my ($sort, $call, $line) = $data =~ /^(\w)(\S+)|(.*)$/;
  97
  98   # do the really sexy console interface bit! (Who is going to do the TK interface then?)
  99   print DEBUG atime, " < $sort $call $line\n" if defined DEBUG;
 100   print "< $sort $call $line\n";
 101
 102   # handle A records
 103   if ($sort eq 'A') {
 104     if ($dxconn) {                         # there should not be one of these, disconnect
 105
 106         }
 107     my $user = DXUser->get($call);         # see if we have one of these
 108   }
 109
 110 }
 111
 112 #############################################################
 113 #
 114 # The start of the main line of code
 115 #
 116 #############################################################
 117
 118 # open the debug file, set various FHs to be unbuffered
 119 open(DEBUG, ">>$debugfn") or die "can't open $debugfn($!)\n";
 120 select DEBUG; $| = 1;
 121 select STDOUT; $| = 1;
 122
 123 # initialise User file system
 124 DXUser->init($userfn);
 125
 126 # start listening for incoming messages/connects
 127 Msg->new_server("$clusteraddr", $clusterport, \&login);
 128
 129 # prime some signals
 130 $SIG{'INT'} = \&cease;
 131 $SIG{'TERM'} = \&cease;
 132 $SIG{'HUP'} = 'IGNORE';
 133
 134 # this, such as it is, is the main loop!
 135 for (;;) {
 136   Msg->event_loop(1, 0.001);
 137   process_inqueue();
 138 }
 139