X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FExtMsg.pm;h=4475f6a10cbf6623f5c8f12163acb6cf14f97198;hb=9bba449d12641232d51d259f470ce6b21205c622;hp=9b4bb061a0bf2dc637c45020c8823db2a8ac0932;hpb=51ed97f9175c71dd611f8333adeee346760d6a98;p=spider.git diff --git a/perl/ExtMsg.pm b/perl/ExtMsg.pm index 9b4bb061..4475f6a1 100644 --- a/perl/ExtMsg.pm +++ b/perl/ExtMsg.pm @@ -70,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; @@ -90,7 +90,7 @@ sub dequeue } 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; @@ -99,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}); } } } @@ -115,36 +115,43 @@ 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()); + 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 @@ -157,6 +164,7 @@ sub start_connect my $f = new IO::File $fn; push @{$conn->{cmd}}, <$f>; $f->close; + $conn->{state} = 'WC'; $conn->_dotimeout($deftimeout); $conn->_docmd; } @@ -210,23 +218,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 $sock = new IO::Socket::INET; - local *H; - my $wrt = \*H; - - if ($conn->{pid} = open3("<&$sock", ">&$sock", '', $line)) { - $conn->{sock} = $sock; - $conn->{csort} = $sort; - $conn->{lineend} = "\cM" if $sort eq 'ax25'; - dbg('connect', "started pid: $conn->{pid} as $line"); + 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; + } } else { - dbg('connect', "can't start $line $!"); + dbg('err', "no socket pair $!"); } } else { dbg('err', "invalid type of connection ($sort)"); - $conn->disconnect; } + $conn->disconnect unless $r; return $r; } @@ -268,15 +311,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; } @@ -305,7 +350,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}; } @@ -320,6 +365,7 @@ sub _send_file if ($f) { while (<$f>) { chomp; + dbg('connll', $_); $conn->send_raw($_ . $conn->{lineend}); } $f->close;