X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FMsg.pm;h=45c0ab7c48b68f6bdd2f80d2a8fbd3c027ef0f57;hb=f87323c2926605792ee02b84783d8f3d4dbd605f;hp=ef43b0bc24618b6033aa52520a009defdae1318e;hpb=dbf7523a9b228dbdf1d03109afde351b8b194fab;p=spider.git diff --git a/perl/Msg.pm b/perl/Msg.pm index ef43b0bc..45c0ab7c 100644 --- a/perl/Msg.pm +++ b/perl/Msg.pm @@ -212,7 +212,10 @@ sub connect { blocking($sock, 0); $conn->{blocking} = 0; + # does the host resolve? my $ip = gethostbyname($to_host); + return undef unless $ip; + # my $r = $sock->connect($to_port, $ip); my $r = connect($sock, pack_sockaddr_in($to_port, $ip)); return undef unless $r || _err_will_block($!); @@ -226,7 +229,57 @@ sub connect { return $conn; } -sub disconnect { +sub start_program +{ + my ($conn, $line, $sort) = @_; + my $pid; + + 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) { + $a->autoflush(1); + $b->autoflush(1); + $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 for $line"); + } + } else { + dbg("no socket pair $! for $line"); + } + return $pid; +} + +sub disconnect +{ my $conn = shift; return if exists $conn->{disconnecting}; @@ -260,7 +313,6 @@ sub disconnect { unless ($main::is_win) { kill 'TERM', $conn->{pid} if exists $conn->{pid}; } - } sub send_now {