From 4a89177a94f3a5ca3f3a1d1231ae5cdd6abd5155 Mon Sep 17 00:00:00 2001 From: minima Date: Thu, 22 Mar 2001 18:03:33 +0000 Subject: [PATCH] added back in ax25 OUTGOING support --- perl/DXDebug.pm | 9 ++++--- perl/ExtMsg.pm | 62 +++++++++++++++++++++++++++++++++++++------------ 2 files changed, 53 insertions(+), 18 deletions(-) diff --git a/perl/DXDebug.pm b/perl/DXDebug.pm index ac452413..b55d01fc 100644 --- a/perl/DXDebug.pm +++ b/perl/DXDebug.pm @@ -21,7 +21,7 @@ use DXLog (); use Carp qw(cluck); %dbglevel = (); -$fp = DXLog::new('debug', 'dat', 'd'); +$fp = undef; # Avoid generating "subroutine redefined" warnings with the following # hack (from CGI::Carp): @@ -71,18 +71,21 @@ sub dbginit $SIG{__WARN__} = sub { _store($@, Carp::shortmess(@_)); }; $SIG{__DIE__} = sub { _store($@, Carp::longmess(@_)); }; } + + $fp = DXLog::new('debug', 'dat', 'd'); } sub dbgclose { $SIG{__DIE__} = $SIG{__WARN__} = 'DEFAULT'; - $fp->close(); + $fp->close() if $fp; + undef $fp; } sub dbg { my $l = shift; - if ($dbglevel{$l} || $l eq 'err') { + if ($fp && ($dbglevel{$l} || $l eq 'err')) { my @in = @_; my $t = time; for (@in) { diff --git a/perl/ExtMsg.pm b/perl/ExtMsg.pm index 9b4bb061..e181722d 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->{sort}); } } elsif ($conn->{msg} =~ /\cJ/) { my @lines = $conn->{msg} =~ /([^\cM\cJ]*)\cM?\cJ/g; @@ -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->{sort}); } } } @@ -157,6 +157,7 @@ sub start_connect my $f = new IO::File $fn; push @{$conn->{cmd}}, <$f>; $f->close; + $conn->{state} = 'WC'; $conn->_dotimeout($deftimeout); $conn->_docmd; } @@ -211,22 +212,53 @@ sub _doconnect dbg('connect', "***Connect Failed to $host $port $!"); } } 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 ($^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('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,13 +300,13 @@ 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) { + 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 -- 2.43.0