From 2f917f01abd5893e2e2f28b3abc842ddfb4ef9cd Mon Sep 17 00:00:00 2001 From: minima Date: Thu, 26 Sep 2002 01:16:22 +0000 Subject: [PATCH] changed connect strategy to factorise for external programs --- Changes | 5 ++++- perl/ExtMsg.pm | 44 +---------------------------------------- perl/Msg.pm | 53 ++++++++++++++++++++++++++++++++++++++++++++++++-- 3 files changed, 56 insertions(+), 46 deletions(-) diff --git a/Changes b/Changes index afc981a3..bb017b03 100644 --- a/Changes +++ b/Changes @@ -7,13 +7,16 @@ to your spider crontab like: 00,05,10,15,20,25,30,35,40,45,50,55 * * * * run_cmd('mrtg all') -You will also need to do an indexmaker in the html directory. I put the +You will also need to do an indexmaker once in the html directory. I put the index page into /spider/html/mrtg/stats.html YMMV. I do: indexmaker --output stats.html --columns=1 --title "MRTG statistics for GB7DJK" ../../mrtg/mrtg.cfg But all on one line. +2. I have made a technical change to the way ax25 connects outward on unix +boxes are done. I currently have no way of testing this. I think it still +works. 22Sep02======================================================================= 1. Add changes to the installation manual for Windows users from K1XX 21Sep02======================================================================= diff --git a/perl/ExtMsg.pm b/perl/ExtMsg.pm index 8324a8ca..f1472789 100644 --- a/perl/ExtMsg.pm +++ b/perl/ExtMsg.pm @@ -272,49 +272,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)"); } diff --git a/perl/Msg.pm b/perl/Msg.pm index cf15ff76..45c0ab7c 100644 --- a/perl/Msg.pm +++ b/perl/Msg.pm @@ -229,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}; @@ -263,7 +313,6 @@ sub disconnect { unless ($main::is_win) { kill 'TERM', $conn->{pid} if exists $conn->{pid}; } - } sub send_now { -- 2.43.0