]> scm.dxcluster.org Git - spider.git/blob - perl/EphMsg.pm
restore talk "<call> not visible on cluster" message
[spider.git] / 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 }