perl/connect.pl

   1 #!/usr/bin/perl
   2 #
   3 # connect to an external entity
   4 #
   5 # This is the routine that is called by the cluster to manage
   6 # an outgoing connection to the point where it is 'connected'.
   7 # From there the client program is forked and execed over the top of
   8 # this program and that connects back to the cluster as though
   9 # it were an incoming connection.
  10 #
  11 # Essentially this porgram does the same as chat in that there
  12 # are 'expect', 'send' pairs of strings. The 'expect' string is
  13 # a pattern. You can include timeout and abort string statements
  14 # at any time.
  15 #
  16 # Commands are:-
  17 #
  18 # connect <type> <destination>|<program>
  19 # timeout <secs>
  20 # abort <regexp>
  21 # client <client name> <parameters>
  22 # '<regexp>' '<send string>'
  23 #
  24 # Copyright (c) Dirk Koopman G1TLH
  25 #
  26 # $Id$
  27 #
  28
  29 # search local then perl directories
  30 BEGIN {
  31   # root of directory tree for this system
  32   $root = "/spider";
  33   $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
  34
  35   unshift @INC, "$root/perl";   # this IS the right way round!
  36   unshift @INC, "$root/local";
  37 }
  38
  39 use DXVars;
  40 use IO::Socket;
  41 use POSIX;
  42 use Carp;
  43
  44 $timeout = 30;         # default timeout for each stage of the connect
  45 $abort = '';           # default connection abort string
  46 $path = "$root/connect";    # the basic connect directory
  47 $client = "$root/perl/client.pl";   # default client
  48
  49 $connected = 0;        # we have successfully connected or started an interface program
  50
  51 exit(1) if !$ARGV[0];       # bang out if no callsign
  52 open(IN, "$path/$ARGV[0]") or exit(2);
  53
  54 while (<IN>) {
  55   chomp;
  56   next if /^\s*#/o;
  57   next if /^\s*$/o;
  58   doconnect($1, $2) if /^\s*co\w*\s+(.*)$/io;
  59   doclient($1) if /^\s*cl\w*\s+(.*)$/io;
  60   doabort($1) if /^\s*a\w*\s+(.*)/io;
  61   dotimeout($1) if /^\s*t\w*\s+(\d+)/io;
  62   dochat($1, $2) if /\s*\'(.*)\'\s+\'(.*)'/io;
  63 }
  64
  65 sub doconnect
  66 {
  67   my ($sort, $name) = @_;
  68   print "connect $sort $name\n";
  69 }
  70
  71 sub doabort
  72 {
  73   my $string = shift;
  74   print "abort $string\n";
  75 }
  76
  77 sub dotimeout
  78 {
  79   my $val = shift;
  80   print "timeout $val\n";
  81 }
  82
  83 sub dochat
  84 {
  85   my ($expect, $send) = @_;
  86   print "chat '$expect' '$send'\n";
  87 }
  88
  89 sub doclient
  90 {
  91   my $cl = shift;
  92   print "client $cl\n";
  93 }