X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FExtMsg.pm;h=8a5e4612926b9b5da6a8212f6404090f62c78fab;hb=3f64c5686df118fa3f3a1d66a87f25b89eb1732a;hp=6ea47a516b06f69d9a43f74681cb0b8423855a04;hpb=15ee0303d77c205e68144dfd8d8a4e0110bbe5ea;p=spider.git diff --git a/perl/ExtMsg.pm b/perl/ExtMsg.pm index 6ea47a51..8a5e4612 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,7 +59,7 @@ sub dequeue my $conn = shift; my $msg; - if ($conn->{sort} eq 'ax25' && exists $conn->{msg}) { + if ($conn->{csort} eq 'ax25' && exists $conn->{msg}) { $conn->{msg} =~ s/\cM/\cJ/g; } if ($conn->{state} eq 'WC') { @@ -69,7 +70,7 @@ sub dequeue } } if ($conn->{state} eq 'WC' && exists $conn->{cmd} && @{$conn->{cmd}} == 0) { - $conn->to_connected($conn->{call}, 'O', 'telnet'); + $conn->to_connected($conn->{call}, 'O', $conn->{csort}); } } elsif ($conn->{msg} =~ /\cJ/) { my @lines = $conn->{msg} =~ /([^\cM\cJ]*)\cM?\cJ/g; @@ -82,14 +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->to_connected($msg, 'A', 'telnet'); + $conn->to_connected($msg, 'A', $conn->{csort}); } else { $conn->send_now("Sorry $msg is an invalid callsign"); $conn->disconnect; @@ -98,7 +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->to_connected($conn->{call}, 'O', 'telnet'); + $conn->to_connected($conn->{call}, 'O', $conn->{csort}); } } } @@ -114,36 +115,44 @@ sub to_connected delete $conn->{cmd}; $conn->{timeout}->del if $conn->{timeout}; delete $conn->{timeout}; - $conn->_send_file("$main::data/connected"); &{$conn->{rproc}}($conn, "$dir$call|$sort"); + $conn->_send_file("$main::data/connected"); } sub new_client { my $server_conn = shift; my $sock = $server_conn->{sock}->accept(); - my $conn = $server_conn->new($server_conn->{rproc}); - $conn->{sock} = $sock; - - my ($rproc, $eproc) = &{$server_conn->{rproc}} ($conn, $conn->{peerhost} = $sock->peerhost(), $conn->{peerport} = $sock->peerport()); - if ($eproc) { - $conn->{eproc} = $eproc; - Msg::set_event_handler ($sock, "error" => $eproc); + if ($sock) { + my $conn = $server_conn->new($server_conn->{rproc}); + $conn->{sock} = $sock; + Msg::blocking($sock, 0); + $conn->{blocking} = 0; + + my ($rproc, $eproc) = &{$server_conn->{rproc}} ($conn, $conn->{peerhost} = $sock->peerhost(), $conn->{peerport} = $sock->peerport()); + dbg('connll', "accept $conn->{cnum} from $conn->{peerhost} $conn->{peerport}"); + 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); + } else { + &{$conn->{eproc}}() if $conn->{eproc}; + $conn->disconnect(); + } + } else { + dbg('err', "ExtMsg: error on accept ($!)"); } - 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); - } else { - $conn->disconnect(); - } } sub start_connect @@ -156,6 +165,7 @@ sub start_connect my $f = new IO::File $fn; push @{$conn->{cmd}}, <$f>; $f->close; + $conn->{state} = 'WC'; $conn->_dotimeout($deftimeout); $conn->_docmd; } @@ -209,35 +219,58 @@ sub _doconnect } else { dbg('connect', "***Connect Failed to $host $port $!"); } + } elsif ($sort eq 'agw') { + # turn it into an AGW object + bless $conn, 'AGWMsg'; + $r = $conn->connect($line); } elsif ($sort eq 'ax25' || $sort eq 'prog') { - my $pid = fork(); - if (defined $pid) { - if (!$pid) { - # in child, unset warnings, disable debugging and general clean up from us - $^W = 0; - eval "{ package DB; sub DB {} }"; - DXChannel::closeall(); - for (@main::listeners) { - $_->close_server; - } - unless ($^O =~ /^MS/) { - $SIG{HUP} = 'IGNORE'; - $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = $SIG{__WARN__} = 'DEFAULT'; - alarm(0); - } - exec "$line" or dbg('cron', "exec '$line' failed $!"); + 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 ($main::is_win) { +# $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; } - dbg('connect', "program $sort $line started"); - $conn->{pid} = $pid; - $conn->{sort} = $sort; - $conn->{lineend} = "\cM" if $sort eq 'ax25'; } else { - dbg('connect', "can't $sort fork for $line $!"); + dbg('err', "no socket pair $!"); } } else { dbg('err', "invalid type of connection ($sort)"); - $conn->disconnect; } + $conn->disconnect unless $r; return $r; } @@ -279,15 +312,17 @@ sub _dochat 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) { - dbg('connect', "got: \"$expect\" sending: \"$send\""); - $conn->send_later($send); + if ($line =~ /\Q$expect/i) { + if (length $send) { + dbg('connect', "got: \"$expect\" sending: \"$send\""); + $conn->send_later("D$conn->{call}|$send"); + } delete $conn->{msg}; # get rid any input if a match return; } @@ -301,8 +336,6 @@ sub _timedout { my $conn = shift; dbg('connect', "timed out after $conn->{timeval} seconds"); - $conn->{timeout}->del; - delete $conn->{timeout}; $conn->disconnect; } @@ -316,7 +349,7 @@ sub _doclient $conn->conns($call); $conn->{csort} = $f[1] if $f[1]; $conn->{state} = 'C'; - &{$conn->{rproc}}($conn, "O$call|telnet"); + &{$conn->{rproc}}($conn, "O$call|$conn->{csort}"); delete $conn->{cmd}; $conn->{timeout}->del if $conn->{timeout}; } @@ -331,7 +364,9 @@ sub _send_file if ($f) { while (<$f>) { chomp; - $conn->send_raw($_ . $conn->{lineend}); + my $l = $_; + dbg('connll', "connect $conn->{cnum}: $l"); + $conn->send_raw($l . $conn->{lineend}); } $f->close; }