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