perl/DXProt.pm

   1 #!/usr/bin/perl
   2 #
   3 # This module impliments the protocal mode for a dx cluster
   4 #
   5 # Copyright (c) 1998 Dirk Koopman G1TLH
   6 #
   7 # $Id$
   8 #
   9
  10 package DXProt;
  11
  12 @ISA = qw(DXChannel);
  13
  14 use DXUtil;
  15 use DXChannel;
  16 use DXUser;
  17 use DXM;
  18 use DXCluster;
  19 use DXProtVars;
  20 use DXCommandmode;
  21
  22 use strict;
  23
  24 #
  25 # obtain a new connection this is derived from dxchannel
  26 #
  27
  28 sub new
  29 {
  30   my $self = DXChannel::alloc(@_);
  31   $self->{sort} = 'A';   # in absence of how to find out what sort of an object I am
  32   return $self;
  33 }
  34
  35 # this is how a pc connection starts (for an incoming connection)
  36 # issue a PC38 followed by a PC18, then wait for a PC20 (remembering
  37 # all the crap that comes between).
  38 sub start
  39 {
  40   my ($self, $line) = shift;
  41   my $call = $self->call;
  42
  43   # remember type of connection
  44   $self->{consort} = $line;
  45
  46   # set unbuffered
  47   $self->send_now('B',"0");
  48
  49   # send initialisation string
  50   $self->send($self->pc38()) if DXNode->get_all();
  51   $self->send($self->pc18());
  52   $self->{state} = 'incoming';
  53 }
  54
  55 #
  56 # This is the normal pcxx despatcher
  57 #
  58 sub normal
  59 {
  60   my ($self, $line) = @_;
  61   my @field = split /[\^\~]/, $line;
  62
  63   # ignore any lines that don't start with PC
  64   return if !$field[0] =~ /^PC/;
  65
  66   # process PC frames
  67   my ($pcno) = $field[0] =~ /^PC(\d\d)/;          # just get the number
  68   return if $pcno < 10 || $pcno > 51;
  69
  70   SWITCH: {
  71     if ($pcno == 10) {last SWITCH;}
  72     if ($pcno == 11) {last SWITCH;}
  73     if ($pcno == 12) {last SWITCH;}
  74     if ($pcno == 13) {last SWITCH;}
  75     if ($pcno == 14) {last SWITCH;}
  76     if ($pcno == 15) {last SWITCH;}
  77     if ($pcno == 16) {last SWITCH;}
  78     if ($pcno == 17) {last SWITCH;}
  79     if ($pcno == 18) {last SWITCH;}
  80     if ($pcno == 19) {last SWITCH;}
  81     if ($pcno == 20) {              # send local configuration
  82
  83       # set our data (manually 'cos we only have a psuedo channel [at the moment])
  84           my $hops = $self->get_hops();
  85           $self->send("PC19^1^$main::mycall^0^$DXProt::myprot_version^$hops^");
  86
  87       # get all the local users and send them out
  88       my @list;
  89           for (@list = DXCommandmode::get_all(); @list; ) {
  90             @list = $self->pc16(@list);
  91             my $out = shift @list;
  92                 $self->send($out);
  93           }
  94           $self->send($self->pc22());
  95           last SWITCH;
  96         }
  97     if ($pcno == 21) {last SWITCH;}
  98     if ($pcno == 22) {last SWITCH;}
  99     if ($pcno == 23) {last SWITCH;}
 100     if ($pcno == 24) {last SWITCH;}
 101     if ($pcno == 25) {last SWITCH;}
 102     if ($pcno == 26) {last SWITCH;}
 103     if ($pcno == 27) {last SWITCH;}
 104     if ($pcno == 28) {last SWITCH;}
 105     if ($pcno == 29) {last SWITCH;}
 106     if ($pcno == 30) {last SWITCH;}
 107     if ($pcno == 31) {last SWITCH;}
 108     if ($pcno == 32) {last SWITCH;}
 109     if ($pcno == 33) {last SWITCH;}
 110     if ($pcno == 34) {last SWITCH;}
 111     if ($pcno == 35) {last SWITCH;}
 112     if ($pcno == 36) {last SWITCH;}
 113     if ($pcno == 37) {last SWITCH;}
 114     if ($pcno == 38) {last SWITCH;}
 115     if ($pcno == 39) {last SWITCH;}
 116     if ($pcno == 40) {last SWITCH;}
 117     if ($pcno == 41) {last SWITCH;}
 118     if ($pcno == 42) {last SWITCH;}
 119     if ($pcno == 43) {last SWITCH;}
 120     if ($pcno == 44) {last SWITCH;}
 121     if ($pcno == 45) {last SWITCH;}
 122     if ($pcno == 46) {last SWITCH;}
 123     if ($pcno == 47) {last SWITCH;}
 124     if ($pcno == 48) {last SWITCH;}
 125     if ($pcno == 49) {last SWITCH;}
 126     if ($pcno == 50) {last SWITCH;}
 127     if ($pcno == 51) {last SWITCH;}
 128   }
 129
 130   # if get here then rebroadcast the thing with its Hop count decremented (if
 131   # the is one). If it has a hop count and it decrements to zero then don't
 132   # rebroadcast it.
 133   #
 134   # NOTE - don't arrive here UNLESS YOU WANT this lump of protocol to be
 135   #        REBROADCAST!!!!
 136   #
 137
 138   my $hopfield = pop @field;
 139   push @field, $hopfield;
 140
 141   if ($hopfield =~ /H\d\d./o) {
 142     my ($hops) = $hopfield =~ /H(\d+)/o;
 143         $hops--;
 144         if ($hops > 0) {
 145           $line =~ s/\^H\d+(\^\~.)$/\^H$hops$1/;       # change the hop count
 146           DXProt->broadcast($line, $self);             # send it to everyone but me
 147         }
 148   }
 149 }
 150
 151 #
 152 # This is called from inside the main cluster processing loop and is used
 153 # for despatching commands that are doing some long processing job
 154 #
 155 sub process
 156 {
 157   my $t = time;
 158   my @chan = DXChannel->get_all();
 159   my $chan;
 160
 161   foreach $chan (@chan) {
 162     next if !$chan->is_ak1a();
 163
 164     # send a pc50 out on this channel
 165     if ($t >= $chan->t + $DXProt::pc50_interval) {
 166       $chan->send(pc50());
 167           $chan->t($t);
 168         }
 169   }
 170 }
 171
 172 #
 173 # finish up a pc context
 174 #
 175 sub finish
 176 {
 177
 178 }
 179
 180 #
 181 # add a (local) user to the cluster
 182 #
 183
 184 sub adduser
 185 {
 186
 187 }
 188
 189 #
 190 # delete a (local) user to the cluster
 191 #
 192
 193 sub deluser
 194 {
 195
 196 }
 197
 198 #
 199 # add a (locally connected) node to the cluster
 200 #
 201
 202 sub addnode
 203 {
 204
 205 }
 206
 207 #
 208 # delete a (locally connected) node to the cluster
 209 #
 210 sub delnode
 211 {
 212
 213 }
 214
 215 #
 216 # some active measures
 217 #
 218
 219 # broadcast a message to all clusters [except those mentioned after buffer]
 220 sub broadcast
 221 {
 222   my $pkg = shift;                # ignored
 223   my $s = shift;                  # the line to be rebroadcast
 224   my @except = @_;                # to all channels EXCEPT these (dxchannel refs)
 225   my @chan = DXChannel->get_all();
 226   my ($chan, $except);
 227
 228 L: foreach $chan (@chan) {
 229      next if !$chan->sort eq 'A';  # only interested in ak1a channels
 230          foreach $except (@except) {
 231            next L if $except == $chan;  # ignore channels in the 'except' list
 232          }
 233          chan->send($s);              # send it
 234   }
 235 }
 236
 237 #
 238 # gimme all the ak1a nodes
 239 #
 240 sub get_all
 241 {
 242   my @list = DXChannel->get_all();
 243   my $ref;
 244   my @out;
 245   foreach $ref (@list) {
 246     push @out, $ref if $ref->sort eq 'A';
 247   }
 248   return @out;
 249 }
 250
 251 #
 252 # obtain the hops from the list for this callsign and pc no
 253 #
 254
 255 sub get_hops
 256 {
 257   my ($self, $pcno) = @_;
 258   return "H$DXProt::def_hopcount";       # for now
 259 }
 260
 261 #
 262 # All the PCxx generation routines
 263 #
 264
 265 #
 266 # add one or more users (I am expecting references that have 'call',
 267 # 'confmode' & 'here' method)
 268 #
 269 # NOTE this sends back a list containing the PC string (first element)
 270 # and the rest of the users not yet processed
 271 #
 272 sub pc16
 273 {
 274   my $self = shift;
 275   my @list = @_;       # list of users
 276   my @out = ('PC16', $main::mycall);
 277   my $i;
 278
 279   for ($i = 0; @list && $i < $DXProt::pc16_max_users; $i++) {
 280     my $ref = shift @list;
 281         my $call = $ref->call;
 282         my $s = sprintf "%s %s %d", $call, $ref->confmode ? '*' : '-', $ref->here;
 283         push @out, $s;
 284   }
 285   push @out, $self->get_hops();
 286   my $str = join '^', @out;
 287   $str .= '^';
 288   return ($str, @list);
 289 }
 290
 291 # Request init string
 292 sub pc18
 293 {
 294   return "PC18^wot a load of twaddle^$DXProt::myprot_version^~";
 295 }
 296
 297 #
 298 # add one or more nodes
 299 #
 300 # NOTE this sends back a list containing the PC string (first element)
 301 # and the rest of the nodes not yet processed (as PC16)
 302 #
 303 sub pc19
 304 {
 305   my $self = shift;
 306   my @list = @_;       # list of users
 307   my @out = ('PC19', $main::mycall);
 308   my $i;
 309
 310   for ($i = 0; @list && $i < $DXProt::pc19_max_nodes; $i++) {
 311     my $ref = shift @list;
 312         push @out, $ref->here, $ref->call, $ref->confmode, $ref->pcversion;
 313   }
 314   push @out, $self->get_hops();
 315   my $str = join '^', @out;
 316   $str .= '^';
 317   return ($str, @list);
 318 }
 319
 320 # end of Rinit phase
 321 sub pc20
 322 {
 323   return 'PC20^';
 324 }
 325
 326 # delete a node
 327 sub pc21
 328 {
 329   my ($self, $ref, $reason) = @_;
 330   my $call = $ref->call;
 331   my $hops = $self->get_hops();
 332   return "PC21^$call^$reason^$hops^";
 333 }
 334
 335 # end of init phase
 336 sub pc22
 337 {
 338   return 'PC22^';
 339 }
 340
 341 # send all the DX clusters I reckon are connected
 342 sub pc38
 343 {
 344   my @list = DXNode->get_all();
 345   my $list;
 346   my @nodes;
 347
 348   foreach $list (@list) {
 349     push @nodes, $list->call;
 350   }
 351   return "PC38^" . join(',', @nodes) . "^~";
 352 }
 353
 354 sub pc50
 355 {
 356   my $n = DXNodeuser->count;
 357   return "PC50^$main::mycall^$n^H99^";
 358 }
 359
 360 1;
 361 __END__