perl/EphMsg.pm

   1 #
   2 # This class is the internal subclass that deals with 'Ephmeral'
   3 # communications like: querying http servers and other network
   4 # connected data services and using Msg.pm
   5 #
   6 # An instance of this is setup by a command together with a load
   7 # of callbacks and then runs with a state machine until completion
   8 #
   9 #
  10 #
  11 # Copyright (c) 2001 - Dirk Koopman G1TLH
  12 #
  13
  14 package EphMsg;
  15
  16 use strict;
  17 use Msg;
  18 use DXVars;
  19 use DXUtil;
  20 use DXDebug;
  21 use DXTimer;
  22
  23 use IO::File;
  24 use IO::Socket;
  25 use IPC::Open3;
  26
  27 use vars qw(@ISA $deftimeout);
  28
  29 @ISA = qw(Msg);
  30 $deftimeout = 60;
  31
  32
  33 sub new
  34 {
  35
  36 }
  37
  38 # we probably won't use the normal format
  39 sub enqueue
  40 {
  41         my ($conn, $msg) = @_;
  42         push (@{$conn->{outqueue}}, $msg . $conn->{lineend});
  43 }
  44
  45 sub dequeue
  46 {
  47         my $conn = shift;
  48         my $msg;
  49
  50         if ($conn->ax25 && exists $conn->{msg}) {
  51                 $conn->{msg} =~ s/\cM/\cJ/g;
  52         }
  53
  54         if ($conn->{state} eq 'WC') {
  55                 $conn->to_connected($conn->{call}, 'O', $conn->{csort});
  56         }
  57
  58         if ($conn->{msg} =~ /\cJ/) {
  59                 my @lines =  $conn->{msg} =~ /([^\cM\cJ]*)\cM?\cJ/g;
  60                 if ($conn->{msg} =~ /\cJ$/) {
  61                         delete $conn->{msg};
  62                 } else {
  63                         $conn->{msg} =~ s/([^\cM\cJ]*)\cM?\cJ//g;
  64                 }
  65
  66                 $conn->{linesin} += @lines;
  67                 $Msg::total_lines_in += @lines;
  68                 while (defined ($msg = shift @lines)) {
  69                         dbg("connect $conn->{cnum}: $msg") if $conn->{state} ne 'C' && isdbg('connect');
  70
  71                         $msg =~ s/\xff\xfa.*\xff\xf0|\xff[\xf0-\xfe].//g; # remove telnet options
  72
  73                         &{$conn->{rproc}}($conn, $msg);
  74                 }
  75         }
  76 }
  77
  78 sub start_connect
  79 {
  80         my $call = shift;
  81         my $fn = shift;
  82         my $conn = ExtMsg->new(\&main::new_channel);
  83         $conn->{outgoing} = 1;
  84         $conn->conns($call);
  85
  86         my $f = new IO::File $fn;
  87         push @{$conn->{cmd}}, <$f>;
  88         $f->close;
  89         $conn->{state} = 'WC';
  90         $conn->_dotimeout($deftimeout);
  91 }
  92
  93 sub _doconnect
  94 {
  95         my ($conn, $sort, $line) = @_;
  96         my $r;
  97
  98         $sort = lc $sort;                       # in this case telnet, ax25 or prog
  99         dbg("CONNECT $conn->{cnum} sort: $sort command: $line") if isdbg('connect');
 100         if ($sort eq 'telnet') {
 101                 # this is a straight network connect
 102                 my ($host, $port) = split /\s+/, $line;
 103                 $port = 23 if !$port;
 104                 $r = $conn->connect($host, $port);
 105                 if ($r) {
 106                         dbg("Connected $conn->{cnum} to $host $port") if isdbg('connect');
 107                 } else {
 108                         dbg("***Connect $conn->{cnum} Failed to $host $port $!") if isdbg('connect');
 109                 }
 110         } elsif ($sort eq 'prog') {
 111                 $r = $conn->start_program($line, $sort);
 112         } else {
 113                 dbg("invalid type of connection ($sort)");
 114         }
 115         $conn->disconnect unless $r;
 116         return $r;
 117 }
 118
 119 sub _doabort
 120 {
 121         my $conn = shift;
 122         my $string = shift;
 123         dbg("connect $conn->{cnum}: abort $string") if isdbg('connect');
 124         $conn->{abort} = $string;
 125 }
 126
 127 sub _dotimeout
 128 {
 129         my $conn = shift;
 130         my $val = shift;
 131         dbg("connect $conn->{cnum}: timeout set to $val") if isdbg('connect');
 132         $conn->{timeout}->del if $conn->{timeout};
 133         $conn->{timeval} = $val;
 134         $conn->{timeout} = DXTimer->new($val, sub{ &_timedout($conn) });
 135 }
 136
 137
 138 sub _timedout
 139 {
 140         my $conn = shift;
 141         dbg("connect $conn->{cnum}: timed out after $conn->{timeval} seconds") if isdbg('connect');
 142         $conn->disconnect;
 143 }
 144
 145 # handle callsign and connection type firtling
 146 sub _doclient
 147 {
 148         my $conn = shift;
 149         my $line = shift;
 150         my @f = split /\s+/, $line;
 151         my $call = uc $f[0] if $f[0];
 152         $conn->conns($call);
 153         $conn->{csort} = $f[1] if $f[1];
 154         $conn->{state} = 'C';
 155         &{$conn->{rproc}}($conn, "O$call|$conn->{csort}");
 156         delete $conn->{cmd};
 157         $conn->{timeout}->del if $conn->{timeout};
 158 }
 159
 160 sub _send_file
 161 {
 162         my $conn = shift;
 163         my $fn = shift;
 164
 165         if (-e $fn) {
 166                 my $f = new IO::File $fn;
 167                 if ($f) {
 168                         while (<$f>) {
 169                                 chomp;
 170                                 my $l = $_;
 171                                 dbg("connect $conn->{cnum}: $l") if isdbg('connll');
 172                                 $conn->send_raw($l . $conn->{lineend});
 173                         }
 174                         $f->close;
 175                 }
 176         }
 177 }