X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FExtMsg.pm;h=0ca2de83c6f5d367a67fbb4dc87d0267372b84f0;hb=ab811a0c902225075a9bd69749f65594079433a9;hp=146604169096a658270ec2e2681024f04911c00e;hpb=2b58ccdf81685a1167a43c38705a0d84b9d8d661;p=spider.git diff --git a/perl/ExtMsg.pm b/perl/ExtMsg.pm index 14660416..0ca2de83 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; @@ -21,17 +23,16 @@ use IO::File; use IO::Socket; use IPC::Open3; -use vars qw($VERSION $BRANCH); -$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); -$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0; -$main::build += $VERSION; -$main::branch += $BRANCH; - use vars qw(@ISA $deftimeout); @ISA = qw(Msg); $deftimeout = 60; +sub login +{ + goto &main::login; # save some writing, this was the default +} + sub enqueue { my ($conn, $msg) = @_; @@ -60,6 +61,12 @@ sub send_raw Msg::set_event_handler ($sock, "write" => sub {$conn->_send(0)}); } +sub echo +{ + my $conn = shift; + $conn->{echo} = shift; +} + sub dequeue { my $conn = shift; @@ -83,26 +90,49 @@ sub dequeue if ($conn->{msg} =~ /\cJ$/) { delete $conn->{msg}; } else { - $conn->{msg} = pop @lines; + $conn->{msg} =~ s/([^\cM\cJ]*)\cM?\cJ//g; } while (defined ($msg = shift @lines)) { dbg("connect $conn->{cnum}: $msg") if $conn->{state} ne 'C' && isdbg('connect'); $msg =~ s/\xff\xfa.*\xff\xf0|\xff[\xf0-\xfe].//g; # remove telnet options - $msg =~ s/[\x00-\x08\x0a-\x19\x1b-\x1f\x80-\x9f]/./g; # immutable CSI sequence + control characters +# $msg =~ s/[\x00-\x08\x0a-\x19\x1b-\x1f\x80-\x9f]/./g; # immutable CSI sequence + control characters if ($conn->{state} eq 'C') { &{$conn->{rproc}}($conn, "I$conn->{call}|$msg"); } elsif ($conn->{state} eq 'WL' ) { $msg = uc $msg; - if (is_callsign($msg)) { + if (is_callsign($msg) && $msg !~ m|/| ) { my $sort = $conn->{csort}; - $sort = 'local' if $conn->{peerhost} eq "127.0.0.1"; - $conn->to_connected($msg, 'A', $sort); + $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 ) { + $conn->conns($msg); + $conn->{state} = 'WP'; + $conn->{decho} = $conn->{echo}; + $conn->{echo} = 0; + $conn->send_raw('password: '); + } else { + $conn->to_connected($msg, 'A', $sort); + } } else { $conn->send_now("Sorry $msg is an invalid callsign"); $conn->disconnect; } + } elsif ($conn->{state} eq 'WP' ) { + 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} =~ /127\.\d+\.\d+\.\d+$/ || $conn->{peerhost} eq '::1'; + $conn->{usedpasswd} = 1; + $conn->to_connected($conn->{call}, 'A', $sort); + } else { + $conn->send_now("Sorry"); + $conn->disconnect; + } } elsif ($conn->{state} eq 'WC') { if (exists $conn->{cmd} && @{$conn->{cmd}}) { $conn->_docmd($msg); @@ -123,6 +153,7 @@ sub to_connected delete $conn->{cmd}; $conn->{timeout}->del if $conn->{timeout}; delete $conn->{timeout}; + $conn->nolinger unless $conn->isa('AGWMsg') || $conn->isa('BPQMsg'); &{$conn->{rproc}}($conn, "$dir$call|$sort"); $conn->_send_file("$main::data/connected") unless $conn->{outgoing}; } @@ -133,6 +164,7 @@ sub new_client { 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}; @@ -160,6 +192,7 @@ sub new_client { $conn->_send_file("$main::data/issue"); $conn->send_raw("login: "); $conn->_dotimeout(60); + $conn->{echo} = 1; } else { &{$conn->{eproc}}() if $conn->{eproc}; $conn->disconnect(); @@ -239,50 +272,12 @@ 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') { - local $^F = 10000; # make sure it ain't closed on exec - my ($a, $b) = IO::Socket->socketpair(AF_UNIX, SOCK_STREAM, PF_UNSPEC); - if ($a && $b) { - $r = 1; - $a->autoflush(1); - $b->autoflush(1); - my $pid = fork; - if (defined $pid) { - if ($pid) { - close $b; - $conn->{sock} = $a; - $conn->{csort} = $sort; - $conn->{lineend} = "\cM" if $sort eq 'ax25'; - $conn->{pid} = $pid; - if ($conn->{rproc}) { - my $callback = sub {$conn->_rcv}; - Msg::set_event_handler ($a, read => $callback); - } - dbg("connect $conn->{cnum}: started pid: $conn->{pid} as $line") if isdbg('connect'); - } else { - $^W = 0; - dbgclose(); - STDIN->close; - STDOUT->close; - STDOUT->close; - *STDIN = IO::File->new_from_fd($b, 'r') or die; - *STDOUT = IO::File->new_from_fd($b, 'w') or die; - *STDERR = IO::File->new_from_fd($b, 'w') or die; - close $a; - unless ($main::is_win) { -# $SIG{HUP} = 'IGNORE'; - $SIG{HUP} = $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = 'DEFAULT'; - alarm(0); - } - exec "$line" or dbg("exec '$line' failed $!"); - } - } else { - dbg("cannot fork"); - $r = undef; - } - } else { - dbg("no socket pair $!"); - } + $r = $conn->start_program($line, $sort); } else { dbg("invalid type of connection ($sort)"); } @@ -329,7 +324,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};