X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FExtMsg.pm;h=838c74e122460dfae490b6737727dec32590be99;hb=5405fc43af4410805160aed50df04bc5fc9df869;hp=8772955350f78c72381c37a3d2b4dcf95210c74e;hpb=586cbb347e7639f5575b48572e75140501a109c0;p=spider.git diff --git a/perl/ExtMsg.pm b/perl/ExtMsg.pm index 87729553..838c74e1 100644 --- a/perl/ExtMsg.pm +++ b/perl/ExtMsg.pm @@ -19,6 +19,7 @@ use DXUtil; use DXDebug; use IO::File; use IO::Socket; +use IPC::Open3; use vars qw(@ISA $deftimeout); @@ -58,6 +59,9 @@ sub dequeue my $conn = shift; my $msg; + if ($conn->{csort} eq 'ax25' && exists $conn->{msg}) { + $conn->{msg} =~ s/\cM/\cJ/g; + } if ($conn->{state} eq 'WC') { if (exists $conn->{cmd}) { if (@{$conn->{cmd}}) { @@ -66,14 +70,11 @@ sub dequeue } } if ($conn->{state} eq 'WC' && exists $conn->{cmd} && @{$conn->{cmd}} == 0) { - $conn->{state} = 'C'; - &{$conn->{rproc}}($conn, "O$conn->{call}|telnet"); - delete $conn->{cmd}; - $conn->{timeout}->del if $conn->{timeout}; + $conn->to_connected($conn->{call}, 'O', $conn->{csort}); } - } elsif ($conn->{msg} =~ /\n/) { - my @lines = split /\r?\n/, $conn->{msg}; - if ($conn->{msg} =~ /\n$/) { + } elsif ($conn->{msg} =~ /\cJ/) { + my @lines = $conn->{msg} =~ /([^\cM\cJ]*)\cM?\cJ/g; + if ($conn->{msg} =~ /\cJ$/) { delete $conn->{msg}; } else { $conn->{msg} = pop @lines; @@ -82,16 +83,14 @@ sub dequeue dbg('connect', $msg) unless $conn->{state} eq 'C'; $msg =~ s/\xff\xfa.*\xff\xf0|\xff[\xf0-\xfe].//g; # remove telnet options - $msg =~ s/[\x00-\x08\x0a-\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)) { - &{$conn->{rproc}}($conn, "A$msg|telnet"); - _send_file($conn, "$main::data/connected"); - $conn->{state} = 'C'; + $conn->to_connected($msg, 'A', $conn->{csort}); } else { $conn->send_now("Sorry $msg is an invalid callsign"); $conn->disconnect; @@ -100,10 +99,7 @@ sub dequeue if (exists $conn->{cmd} && @{$conn->{cmd}}) { $conn->_docmd($msg); if ($conn->{state} eq 'WC' && exists $conn->{cmd} && @{$conn->{cmd}} == 0) { - $conn->{state} = 'C'; - &{$conn->{rproc}}($conn, "O$conn->{call}|telnet"); - delete $conn->{cmd}; - $conn->{timeout}->del if $conn->{timeout}; + $conn->to_connected($conn->{call}, 'O', $conn->{csort}); } } } @@ -111,6 +107,18 @@ sub dequeue } } +sub to_connected +{ + my ($conn, $call, $dir, $sort) = @_; + $conn->{state} = 'C'; + $conn->conns($call); + delete $conn->{cmd}; + $conn->{timeout}->del if $conn->{timeout}; + delete $conn->{timeout}; + $conn->_send_file("$main::data/connected"); + &{$conn->{rproc}}($conn, "$dir$call|$sort"); +} + sub new_client { my $server_conn = shift; my $sock = $server_conn->{sock}->accept(); @@ -120,7 +128,7 @@ sub new_client { my ($rproc, $eproc) = &{$server_conn->{rproc}} ($conn, $conn->{peerhost} = $sock->peerhost(), $conn->{peerport} = $sock->peerport()); if ($eproc) { $conn->{eproc} = $eproc; - set_event_handler ($sock, "error" => $eproc); + Msg::set_event_handler ($sock, "error" => $eproc); } if ($rproc) { $conn->{rproc} = $rproc; @@ -131,8 +139,9 @@ sub new_client { # $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"); - _send_file($conn, "$main::data/issue"); + $conn->_send_file("$main::data/issue"); $conn->send_raw("login: "); + $conn->_dotimeout(60); } else { $conn->disconnect(); } @@ -142,12 +151,13 @@ sub start_connect { my $call = shift; my $fn = shift; - my $conn = ExtMsg->new(\&main::rec); + my $conn = ExtMsg->new(\&main::new_channel); $conn->conns($call); my $f = new IO::File $fn; push @{$conn->{cmd}}, <$f>; $f->close; + $conn->{state} = 'WC'; $conn->_dotimeout($deftimeout); $conn->_docmd; } @@ -188,7 +198,8 @@ sub _doconnect { my ($conn, $sort, $line) = @_; my $r; - + + $sort = lc $sort; dbg('connect', "CONNECT sort: $sort command: $line"); if ($sort eq 'telnet') { # this is a straight network connect @@ -201,11 +212,53 @@ sub _doconnect dbg('connect', "***Connect Failed to $host $port $!"); } } 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', "started pid: $conn->{pid} as $line"); + } 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 ($^O =~ /^MS/) { +# $SIG{HUP} = 'IGNORE'; + $SIG{HUP} = $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = 'DEFAULT'; + alarm(0); + } + exec "$line" or dbg('err', "exec '$line' failed $!"); + } + } else { + dbg('err', "cannot fork"); + $r = undef; + } + } else { + dbg('err', "no socket pair $!"); + } } else { dbg('err', "invalid type of connection ($sort)"); - $conn->disconnect; } + $conn->disconnect unless $r; return $r; } @@ -222,9 +275,9 @@ sub _dotimeout my $conn = shift; my $val = shift; dbg('connect', "timeout set to $val"); - my $old = $conn->{timeout}->del if $conn->{timeout}; - $conn->{timeout} = Timer->new($val, sub{ &_timeout($conn) }); + $conn->{timeout}->del if $conn->{timeout}; $conn->{timeval} = $val; + $conn->{timeout} = Timer->new($val, sub{ &_timedout($conn) }); } sub _dolineend @@ -242,20 +295,21 @@ sub _dochat my $conn = shift; my $cmd = shift; my $line = shift; - + if ($line) { my ($expect, $send) = $cmd =~ /^\s*\'(.*)\'\s+\'(.*)\'/; if ($expect) { dbg('connect', "expecting: \"$expect\" received: \"$line\""); - if ($conn->{abort} && $line =~ /$conn->{abort}/i) { + if ($conn->{abort} && $line =~ /\Q$conn->{abort}/i) { dbg('connect', "aborted on /$conn->{abort}/"); $conn->disconnect; delete $conn->{cmd}; return; } - if ($line =~ /$expect/i) { + if ($line =~ /\Q$expect/i) { dbg('connect', "got: \"$expect\" sending: \"$send\""); $conn->send_later($send); + delete $conn->{msg}; # get rid any input if a match return; } } @@ -264,10 +318,12 @@ sub _dochat unshift @{$conn->{cmd}}, $cmd; } -sub _timeout +sub _timedout { my $conn = shift; dbg('connect', "timed out after $conn->{timeval} seconds"); + $conn->{timeout}->del; + delete $conn->{timeout}; $conn->disconnect; } @@ -277,10 +333,11 @@ sub _doclient my $conn = shift; my $line = shift; my @f = split /\s+/, $line; - $conn->{call} = uc $f[0] if $f[0]; + my $call = uc $f[0] if $f[0]; + $conn->conns($call); $conn->{csort} = $f[1] if $f[1]; $conn->{state} = 'C'; - &{$conn->{rproc}}($conn, "O$conn->{call}|telnet"); + &{$conn->{rproc}}($conn, "O$call|telnet"); delete $conn->{cmd}; $conn->{timeout}->del if $conn->{timeout}; }