X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FExtMsg.pm;h=1f543fc035bdc5e9f0c98a9760076edc7708c3c5;hb=e5c28b46a0f70c78747672091a8edd749aa8488c;hp=4dbefbc594c13e7edc2b18071a6c5a442404ef26;hpb=49a14209678e26e31b2a9c89aec330c1a7a87b80;p=spider.git diff --git a/perl/ExtMsg.pm b/perl/ExtMsg.pm index 4dbefbc5..1f543fc0 100644 --- a/perl/ExtMsg.pm +++ b/perl/ExtMsg.pm @@ -5,7 +5,7 @@ # This is where the cluster handles direct connections coming both in # and out # -# $Id$ +# # # Copyright (c) 2001 - Dirk Koopman G1TLH # @@ -21,17 +21,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) = @_; @@ -152,7 +151,7 @@ sub to_connected delete $conn->{cmd}; $conn->{timeout}->del if $conn->{timeout}; delete $conn->{timeout}; - $conn->nolinger; + $conn->nolinger unless $conn->isa('AGWMsg'); &{$conn->{rproc}}($conn, "$dir$call|$sort"); $conn->_send_file("$main::data/connected") unless $conn->{outgoing}; } @@ -272,49 +271,7 @@ sub _doconnect bless $conn, 'AGWMsg'; $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)"); }