X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FExtMsg.pm;h=ffa16bb711e92257ba185aef822b95b00236a480;hb=refs%2Fheads%2Fnewdisc;hp=8602da3d59c638d663777c549bb9c148cae6b86b;hpb=7b9256ceade8b18b48f848c9ac659c2de7322b0b;p=spider.git diff --git a/perl/ExtMsg.pm b/perl/ExtMsg.pm index 8602da3d..ffa16bb7 100644 --- a/perl/ExtMsg.pm +++ b/perl/ExtMsg.pm @@ -5,10 +5,12 @@ # This is where the cluster handles direct connections coming both in # and out # -# $Id$ # # Copyright (c) 2001 - Dirk Koopman G1TLH # +# Modified Jan 2006 by John Wiseman G8BPQ to support connections to BPQ32 node, +# and fix pattern matching on 'chat' abort handling +# package ExtMsg; @@ -52,11 +54,8 @@ sub enqueue sub send_raw { my ($conn, $msg) = @_; - my $sock = $conn->{sock}; - return unless defined($sock); - push (@{$conn->{outqueue}}, $msg); - dbg("connect $conn->{cnum}: $msg") if $conn->{state} ne 'C' && isdbg('connect'); - Msg::set_event_handler ($sock, "write" => sub {$conn->_send(0)}); + dbg((ref $conn) . " connect $conn->{cnum}: $msg") if $conn->{state} ne 'C' && isdbg('connect'); + $conn->SUPER::send_raw($msg); } sub echo @@ -70,7 +69,7 @@ sub dequeue my $conn = shift; my $msg; - if ($conn->{csort} eq 'ax25' && exists $conn->{msg}) { + if ($conn->ax25 && exists $conn->{msg}) { $conn->{msg} =~ s/\cM/\cJ/g; } if ($conn->{state} eq 'WC') { @@ -102,9 +101,9 @@ sub dequeue $msg = uc $msg; if (is_callsign($msg) && $msg !~ m|/| ) { my $sort = $conn->{csort}; - $sort = 'local' if $conn->{peerhost} eq "127.0.0.1"; + $sort = 'local' if $conn->{peerhost} =~ /127\.\d+\.\d+\.\d+$/ || $conn->{peerhost} eq '::1'; my $uref; - if ($main::passwdreq || ($uref = DXUser->get_current($msg)) && $uref->passwd ) { + if ($main::passwdreq || ($uref = DXUser::get_current($msg)) && $uref->passwd ) { $conn->conns($msg); $conn->{state} = 'WP'; $conn->{decho} = $conn->{echo}; @@ -118,13 +117,13 @@ sub dequeue $conn->disconnect; } } elsif ($conn->{state} eq 'WP' ) { - my $uref = DXUser->get_current($conn->{call}); + my $uref = DXUser::get_current($conn->{call}); $msg =~ s/[\r\n]+$//; if ($uref && $msg eq $uref->passwd) { my $sort = $conn->{csort}; $conn->{echo} = $conn->{decho}; delete $conn->{decho}; - $sort = 'local' if $conn->{peerhost} eq "127.0.0.1"; + $sort = 'local' if $conn->{peerhost} =~ /127\.\d+\.\d+\.\d+$/ || $conn->{peerhost} eq '::1'; $conn->{usedpasswd} = 1; $conn->to_connected($conn->{call}, 'A', $sort); } else { @@ -151,54 +150,22 @@ sub to_connected delete $conn->{cmd}; $conn->{timeout}->del if $conn->{timeout}; delete $conn->{timeout}; - $conn->nolinger; + $conn->{csort} = $sort; &{$conn->{rproc}}($conn, "$dir$call|$sort"); - $conn->_send_file("$main::data/connected") unless $conn->{outgoing}; + $conn->_send_file(localdata("connected")) unless $conn->{outgoing}; } sub new_client { + my $server_conn = shift; - my $sock = $server_conn->{sock}->accept(); - if ($sock) { - my $conn = $server_conn->new($server_conn->{rproc}); - $conn->{sock} = $sock; - $conn->nolinger; - Msg::blocking($sock, 0); - $conn->{blocking} = 0; - eval {$conn->{peerhost} = $sock->peerhost}; - if ($@) { - dbg($@) if isdbg('connll'); - $conn->disconnect; - } else { - eval {$conn->{peerport} = $sock->peerport}; - $conn->{peerport} = 0 if $@; - my ($rproc, $eproc) = &{$server_conn->{rproc}} ($conn, $conn->{peerhost}, $conn->{peerport}); - dbg("accept $conn->{cnum} from $conn->{peerhost} $conn->{peerport}") if isdbg('connll'); - if ($eproc) { - $conn->{eproc} = $eproc; - Msg::set_event_handler ($sock, "error" => $eproc); - } - if ($rproc) { - $conn->{rproc} = $rproc; - my $callback = sub {$conn->_rcv}; - Msg::set_event_handler ($sock, "read" => $callback); - # send login prompt - $conn->{state} = 'WL'; - # $conn->send_raw("\xff\xfe\x01\xff\xfc\x01\ff\fd\x22"); - # $conn->send_raw("\xff\xfa\x22\x01\x01\xff\xf0"); - # $conn->send_raw("\xFF\xFC\x01"); - $conn->_send_file("$main::data/issue"); - $conn->send_raw("login: "); - $conn->_dotimeout(60); - $conn->{echo} = 1; - } else { - &{$conn->{eproc}}() if $conn->{eproc}; - $conn->disconnect(); - } - } - } else { - dbg("ExtMsg: error on accept ($!)") if isdbg('err'); - } + my $client = shift; + my $conn = $server_conn->SUPER::new_client($client); + # send login prompt + $conn->{state} = 'WL'; + $conn->_send_file(localdata("issue")); + $conn->send_raw("login: "); + $conn->_dotimeout(60); + $conn->{echo} = 1; } sub start_connect @@ -270,6 +237,10 @@ sub _doconnect # turn it into an AGW object bless $conn, 'AGWMsg'; $r = $conn->connect($line); + } elsif ($sort eq 'bpq') { + # turn it into an BPQ object + bless $conn, 'BPQMsg'; + $r = $conn->connect($line); } elsif ($sort eq 'ax25' || $sort eq 'prog') { $r = $conn->start_program($line, $sort); } else { @@ -318,7 +289,7 @@ sub _dochat if ($line) { if ($expect) { dbg("connect $conn->{cnum}: expecting: \"$expect\" received: \"$line\"") if isdbg('connect'); - if ($conn->{abort} && $line =~ /\Q$conn->{abort}/i) { + if ($conn->{abort} && $line =~ /$conn->{abort}/i) { dbg("connect $conn->{cnum}: aborted on /$conn->{abort}/") if isdbg('connect'); $conn->disconnect; delete $conn->{cmd}; @@ -355,6 +326,7 @@ sub _doclient $conn->conns($call); $conn->{csort} = $f[1] if $f[1]; $conn->{state} = 'C'; + eval {$conn->{peerhost} = $conn->{sock}->handle->peerhost} unless $conn->ax25; &{$conn->{rproc}}($conn, "O$call|$conn->{csort}"); delete $conn->{cmd}; $conn->{timeout}->del if $conn->{timeout};