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 IO::File;
  22 use IO::Socket;
  23 use IPC::Open3;
  24
  25 use vars qw(@ISA $deftimeout);
  26
  27 @ISA = qw(Msg);
  28 $deftimeout = 60;
  29
  30
  31 sub new
  32 {
  33
  34 }
  35
  36 # we probably won't use the normal format
  37 sub enqueue
  38 {
  39         my ($conn, $msg) = @_;
  40         push (@{$conn->{outqueue}}, $msg . $conn->{lineend});
  41 }
  42
  43 sub dequeue
  44 {
  45         my $conn = shift;
  46         my $msg;
  47
  48         if ($conn->{csort} eq 'ax25' && exists $conn->{msg}) {
  49                 $conn->{msg} =~ s/\cM/\cJ/g;
  50         }
  51
  52         if ($conn->{state} eq 'WC') {
  53                 $conn->to_connected($conn->{call}, 'O', $conn->{csort});
  54         }
  55
  56         if ($conn->{msg} =~ /\cJ/) {
  57                 my @lines =  $conn->{msg} =~ /([^\cM\cJ]*)\cM?\cJ/g;
  58                 if ($conn->{msg} =~ /\cJ$/) {
  59                         delete $conn->{msg};
  60                 } else {
  61                         $conn->{msg} =~ s/([^\cM\cJ]*)\cM?\cJ//g;
  62                 }
  63
  64                 while (defined ($msg = shift @lines)) {
  65                         dbg("connect $conn->{cnum}: $msg") if $conn->{state} ne 'C' && isdbg('connect');
  66
  67                         $msg =~ s/\xff\xfa.*\xff\xf0|\xff[\xf0-\xfe].//g; # remove telnet options
  68
  69                         &{$conn->{rproc}}($conn, $msg);
  70                 }
  71         }
  72 }
  73
  74 sub to_connected
  75 {
  76         my ($conn, $call, $dir, $sort) = @_;
  77         $conn->{state} = 'C';
  78         $conn->conns($call);
  79         delete $conn->{cmd};
  80         $conn->{timeout}->del if $conn->{timeout};
  81         delete $conn->{timeout};
  82         $conn->nolinger;
  83         &{$conn->{rproc}}($conn, "$dir$call|$sort");
  84 }
  85
  86
  87 sub start_connect
  88 {
  89         my $call = shift;
  90         my $fn = shift;
  91         my $conn = ExtMsg->new(\&main::new_channel);
  92         $conn->{outgoing} = 1;
  93         $conn->conns($call);
  94
  95         my $f = new IO::File $fn;
  96         push @{$conn->{cmd}}, <$f>;
  97         $f->close;
  98         $conn->{state} = 'WC';
  99         $conn->_dotimeout($deftimeout);
 100 }
 101
 102 sub _doconnect
 103 {
 104         my ($conn, $sort, $line) = @_;
 105         my $r;
 106
 107         $sort = lc $sort;                       # in this case telnet, ax25 or prog
 108         dbg("CONNECT $conn->{cnum} sort: $sort command: $line") if isdbg('connect');
 109         if ($sort eq 'telnet') {
 110                 # this is a straight network connect
 111                 my ($host, $port) = split /\s+/, $line;
 112                 $port = 23 if !$port;
 113                 $r = $conn->connect($host, $port);
 114                 if ($r) {
 115                         dbg("Connected $conn->{cnum} to $host $port") if isdbg('connect');
 116                 } else {
 117                         dbg("***Connect $conn->{cnum} Failed to $host $port $!") if isdbg('connect');
 118                 }
 119         } elsif ($sort eq 'prog') {
 120                 $r = $conn->start_program($line, $sort);
 121         } else {
 122                 dbg("invalid type of connection ($sort)");
 123         }
 124         $conn->disconnect unless $r;
 125         return $r;
 126 }
 127
 128 sub _doabort
 129 {
 130         my $conn = shift;
 131         my $string = shift;
 132         dbg("connect $conn->{cnum}: abort $string") if isdbg('connect');
 133         $conn->{abort} = $string;
 134 }
 135
 136 sub _dotimeout
 137 {
 138         my $conn = shift;
 139         my $val = shift;
 140         dbg("connect $conn->{cnum}: timeout set to $val") if isdbg('connect');
 141         $conn->{timeout}->del if $conn->{timeout};
 142         $conn->{timeval} = $val;
 143         $conn->{timeout} = Timer->new($val, sub{ &_timedout($conn) });
 144 }
 145
 146
 147 sub _timedout
 148 {
 149         my $conn = shift;
 150         dbg("connect $conn->{cnum}: timed out after $conn->{timeval} seconds") if isdbg('connect');
 151         $conn->disconnect;
 152 }
 153
 154 # handle callsign and connection type firtling
 155 sub _doclient
 156 {
 157         my $conn = shift;
 158         my $line = shift;
 159         my @f = split /\s+/, $line;
 160         my $call = uc $f[0] if $f[0];
 161         $conn->conns($call);
 162         $conn->{csort} = $f[1] if $f[1];
 163         $conn->{state} = 'C';
 164         &{$conn->{rproc}}($conn, "O$call|$conn->{csort}");
 165         delete $conn->{cmd};
 166         $conn->{timeout}->del if $conn->{timeout};
 167 }
 168
 169 sub _send_file
 170 {
 171         my $conn = shift;
 172         my $fn = shift;
 173
 174         if (-e $fn) {
 175                 my $f = new IO::File $fn;
 176                 if ($f) {
 177                         while (<$f>) {
 178                                 chomp;
 179                                 my $l = $_;
 180                                 dbg("connect $conn->{cnum}: $l") if isdbg('connll');
 181                                 $conn->send_raw($l . $conn->{lineend});
 182                         }
 183                         $f->close;
 184                 }
 185         }
 186 }