2 # This class is the internal subclass that deals with the external port
3 # communications for Msg.pm
5 # This is where the cluster handles direct connections coming both in
9 # Copyright (c) 2001 - Dirk Koopman G1TLH
11 # Modified Jan 2006 by John Wiseman G8BPQ to support connections to BPQ32 node,
12 # and fix pattern matching on 'chat' abort handling
28 use vars qw(@ISA $deftimeout);
35 goto &main::login; # save some writing, this was the default
40 my ($conn, $msg) = @_;
41 unless ($msg =~ /^[ABZ]/) {
42 if ($msg =~ m{^E[-\w\/]+\|([01])} && $conn->{csort} eq 'telnet') {
45 # $conn->send_raw("\xFF\xFC\x01");
47 # $conn->send_raw("\xFF\xFB\x01");
50 $msg =~ s{^[-\w\/]+\|}{};
51 push (@{$conn->{outqueue}}, $msg . $conn->{lineend});
58 my ($conn, $msg) = @_;
59 dbg((ref $conn) . " connect $conn->{cnum}: $msg") if $conn->{state} ne 'C' && isdbg('connect');
60 $conn->SUPER::send_raw($msg);
66 $conn->{echo} = shift;
71 my $conn = shift; # $rcv_now complement of $flush
73 my $sock = $conn->{sock};
74 return unless defined($sock);
75 return if $conn->{disconnecting};
77 if ($conn->{state} eq 'WL' && $conn->{sort} =~ /^I/ && $msg =~ /^PROXY/) {
78 my $echo = $conn->{echo};
80 $conn->SUPER::_rcv($msg);
81 $conn->{echo} = $echo;
83 $conn->SUPER::_rcv($msg);
92 if ($conn->ax25 && exists $conn->{msg}) {
93 $conn->{msg} =~ s/\cM/\cJ/g;
95 if ($conn->{state} eq 'WC') {
96 if (exists $conn->{cmd}) {
97 if (@{$conn->{cmd}}) {
98 dbg("connect $conn->{cnum}: $conn->{msg}") if isdbg('connect');
99 $conn->_docmd($conn->{msg});
102 if ($conn->{state} eq 'WC' && exists $conn->{cmd} && @{$conn->{cmd}} == 0) {
103 $conn->to_connected($conn->{call}, 'O', $conn->{csort});
105 } elsif ($conn->{msg} =~ /\cJ/) {
106 my @lines = $conn->{msg} =~ /([^\cM\cJ]*)\cM?\cJ/g;
107 if ($conn->{msg} =~ /\cJ$/) {
110 $conn->{msg} =~ s/([^\cM\cJ]*)\cM?\cJ//g;
112 $conn->{linesin} += @lines;
113 $Msg::total_lines_in += @lines;
114 while (defined ($msg = shift @lines)) {
115 dbg("connect $conn->{cnum}: $msg") if $conn->{state} ne 'C' && isdbg('connect');
117 $msg =~ s/\xff\xfa.*\xff\xf0|\xff[\xf0-\xfe].//g; # remove telnet options
118 # $msg =~ s/[\x00-\x08\x0a-\x19\x1b-\x1f\x80-\x9f]/./g; # immutable CSI sequence + control characters
120 if ($conn->{state} eq 'C') {
121 &{$conn->{rproc}}($conn, "I$conn->{call}|$msg");
122 } elsif ($conn->{state} eq 'WL' ) {
124 if ($conn->{sort} =~ /^I/ && (my ($ip, $from) = $msg =~ /^PROXY TCP[46] ([\da-fA-F:\.]+) ([\da-fA-F:\.]+)/) ) {
125 # SOMEONE appears to have affixed an HA Proxy to my connection
126 $ip =~ s|^::ffff:||; # chop off leading pseudo IPV6 stuff on dual stack listeners
127 $from =~ s|^::ffff:||;
128 if ($from eq $conn->{peerhost}) {
129 dbg("ExtMsg: connect - PROXY IP change from '$conn->{peerhost}' -> '$ip'");
130 $conn->{peerhost} = $ip;
132 dbg("ExtMsg: connect - PROXY someone ($from) is trying to spoof '$ip'");
133 $conn->send_now("Sorry $msg is an invalid callsign");
136 } elsif (is_callsign($msg)) {
137 my $call = normalise_call($msg);
138 if ($main::allowslashcall || $msg !~ m|/|) {
139 my $sort = $conn->{csort};
140 $sort = 'local' if $conn->{peerhost} =~ /127\.\d+\.\d+\.\d+$/ || $conn->{peerhost} eq '::1';
142 if ($main::passwdreq || ($uref = DXUser::get_current($call)) && $uref->passwd ) {
144 $conn->{state} = 'WP';
145 $conn->{decho} = $conn->{echo};
147 $conn->send_raw('password: ');
149 $conn->to_connected($msg, 'A', $sort);
152 $conn->send_now("Sorry $msg is an invalid callsign");
156 $conn->send_now("Sorry $msg is an invalid callsign");
159 } elsif ($conn->{state} eq 'WP' ) {
160 my $uref = DXUser::get_current($conn->{call});
161 $msg =~ s/[\r\n]+$//;
162 if ($uref && $msg eq $uref->passwd) {
163 my $sort = $conn->{csort};
164 $conn->{echo} = $conn->{decho};
165 delete $conn->{decho};
166 $sort = 'local' if $conn->{peerhost} =~ /127\.\d+\.\d+\.\d+$/ || $conn->{peerhost} eq '::1';
167 $conn->{usedpasswd} = 1;
168 $conn->to_connected($conn->{call}, 'A', $sort);
170 $conn->send_now("Sorry");
173 } elsif ($conn->{state} eq 'WC') {
174 if (exists $conn->{cmd} && @{$conn->{cmd}}) {
176 if ($conn->{state} eq 'WC' && exists $conn->{cmd} && @{$conn->{cmd}} == 0) {
177 $conn->to_connected($conn->{call}, 'O', $conn->{csort});
187 my ($conn, $call, $dir, $sort) = @_;
188 $conn->{state} = 'C';
191 $conn->{timeout}->del if $conn->{timeout};
192 delete $conn->{timeout};
193 $conn->{csort} = $sort;
194 &{$conn->{rproc}}($conn, "$dir$call|$sort");
195 $conn->_send_file(localdata("connected")) unless $conn->{outgoing};
200 my $server_conn = shift;
202 my $conn = $server_conn->SUPER::new_client($client);
204 $conn->{state} = 'WL';
205 $conn->_send_file(localdata("issue"));
206 $conn->send_raw("login: ");
207 $conn->_dotimeout(60);
215 my $conn = ExtMsg->new(\&main::new_channel);
216 $conn->{outgoing} = 1;
219 my $f = new IO::File $fn;
220 push @{$conn->{cmd}}, <$f>;
222 $conn->{state} = 'WC';
223 $conn->_dotimeout($deftimeout);
233 while ($cmd = shift @{$conn->{cmd}}) {
235 next if $cmd =~ /^\s*\#/o;
236 next if $cmd =~ /^\s*$/o;
237 $conn->_doabort($1) if $cmd =~ /^\s*a\w*\s+(.*)/i;
238 $conn->_dotimeout($1) if $cmd =~ /^\s*t\w*\s+(\d+)/i;
239 $conn->_dolineend($1) if $cmd =~ /^\s*[Ll]\w*\s+\'((?:\\[rn])+)\'/i;
240 if ($cmd =~ /^\s*co\w*\s+(\w+)\s+(.*)$/i) {
241 unless ($conn->_doconnect($1, $2)) {
243 @{$conn->{cmd}} = []; # empty any further commands
247 if ($cmd =~ /^\s*\'([^\']*)\'\s+\'([^\']*)\'/) {
248 $conn->_dochat($cmd, $msg, $1, $2);
251 if ($cmd =~ /^\s*cl\w+\s+(.*)/i) {
252 $conn->_doclient($1);
255 last if $conn->{state} eq 'E';
261 my ($conn, $sort, $line) = @_;
265 dbg("CONNECT $conn->{cnum} sort: $sort command: $line") if isdbg('connect');
266 if ($sort eq 'telnet') {
267 # this is a straight network connect
268 my ($host, $port) = split /\s+/, $line;
269 $port = 23 if !$port;
270 $r = $conn->connect($host, $port);
272 dbg("Connected $conn->{cnum} to $host $port") if isdbg('connect');
274 dbg("***Connect $conn->{cnum} Failed to $host $port $!") if isdbg('connect');
276 } elsif ($sort eq 'agw') {
277 # turn it into an AGW object
278 bless $conn, 'AGWMsg';
279 $r = $conn->connect($line);
280 } elsif ($sort eq 'bpq') {
281 # turn it into an BPQ object
282 bless $conn, 'BPQMsg';
283 $r = $conn->connect($line);
284 } elsif ($sort eq 'ax25' || $sort eq 'prog') {
285 $r = $conn->start_program($line, $sort);
287 dbg("invalid type of connection ($sort)");
289 $conn->disconnect unless $r;
297 dbg("connect $conn->{cnum}: abort $string") if isdbg('connect');
298 $conn->{abort} = $string;
305 dbg("connect $conn->{cnum}: timeout set to $val") if isdbg('connect');
306 $conn->{timeout}->del if $conn->{timeout};
307 $conn->{timeval} = $val;
308 $conn->{timeout} = DXTimer->new($val, sub{ &_timedout($conn) });
315 dbg("connect $conn->{cnum}: lineend set to $val ") if isdbg('connect');
318 $conn->{lineend} = $val;
331 dbg("connect $conn->{cnum}: expecting: \"$expect\" received: \"$line\"") if isdbg('connect');
332 if ($conn->{abort} && $line =~ /$conn->{abort}/i) {
333 dbg("connect $conn->{cnum}: aborted on /$conn->{abort}/") if isdbg('connect');
338 if ($line =~ /\Q$expect/i) {
340 dbg("connect $conn->{cnum}: got: \"$expect\" sending: \"$send\"") if isdbg('connect');
341 $conn->send_later("D$conn->{call}|$send");
343 delete $conn->{msg}; # get rid any input if a match
348 $conn->{state} = 'WC';
349 unshift @{$conn->{cmd}}, $cmd;
355 dbg("connect $conn->{cnum}: timed out after $conn->{timeval} seconds") if isdbg('connect');
359 # handle callsign and connection type firtling
364 my @f = split /\s+/, $line;
365 my $call = uc $f[0] if $f[0];
367 $conn->{csort} = $f[1] if $f[1];
368 $conn->{state} = 'C';
369 eval {$conn->{peerhost} = $conn->{sock}->handle->peerhost} unless $conn->ax25;
370 &{$conn->{rproc}}($conn, "O$call|$conn->{csort}");
372 $conn->{timeout}->del if $conn->{timeout};
381 my $f = new IO::File $fn;
386 dbg("connect $conn->{cnum}: $l") if isdbg('connll');
387 $conn->send_raw($l . $conn->{lineend});