Front page | perl.perl5.porters |
Postings from May 2003
[perl #22219] Bug in open3() under Perl 5.8
Thread Previous
From:
Andy Belsey
Date:
May 16, 2003 11:19
Subject:
[perl #22219] Bug in open3() under Perl 5.8
Message ID:
rt-22219-57670.18.2764030059748@bugs6.perl.org
# New Ticket Created by Andy Belsey
# Please include the string: [perl #22219]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt2/Ticket/Display.html?id=22219 >
This is a bug report for perl from Andrew.Belsey@sun.com,
generated with the help of perlbug 1.34 running under perl v5.8.0.
-----------------------------------------------------------------
[Please enter your report here]
Summary
The descendent processes from an IPC::Open3 call under Perl 5.8
still have handles open to the original pipes created by the open3
code in the Open3.pm module. Even if the child re-forks and
closes/redirects its stdin, stdout and stderr streams, these handles
remain open. This does not happen in Perl versions before 5.8. The
behaviour is the same under both Solaris and Linux.
Example Code
The spawner.pl file below uses the open3 function to fork off a
process to execute the child.pl file (also below). Then, spawner.pl
reads and processes the stdout/stderr streams from the forked child
until these are both closed, whereupon it reaps the exit status of
the child. The child.pl script does this:
1. prints a message to its stdout
2. prints a message to its stderr
3. forks twice to become a proper daemon (closing and redirecting
its standard streams)
4. parent exits
5. (grand)child prints messages to stdout/stderr, sleeps and prints
a final message to both stdout and stderr then exits
In versions of Perl before 5.8, you can see that the spawner.pl
script behaves as expected, it sees the child exiting and
immediately after that it sees the child file handles close.
However, with 5.8, spawner.pl doesn't see the child handles close
until the grandchild process has finished. Note that only the Perl
version running the spawner.pl script is important. I tried a Tcl
version of the child with the same result.
I also tried using lsof to see what files are open in the child
process and I see three extra FIFO's in the 5.8 case which I suspect
are the original pipes created by the open3 call. I can't see why
there are still open in the child though.
spawner.pl:
######################################################################
#!/usr/bin/perl -w
use strict;
use POSIX;
use IPC::Open3;
use IO::Select;
use IO::Handle;
sub set_non_blocking {
my $flags = fcntl(${$_[0]}, F_GETFL(), 0);
fcntl(${$_[0]}, F_SETFL(), $flags | O_NONBLOCK());
}
# this is a forking daemon script
my $cmdLine = './child.pl';
# watch for SIGCHLD signals
$SIG{CHLD} = sub {
print "received a SIGCHLD\n";
};
my ($childIN, $childOUT, $childERR) =
(IO::Handle->new(),
IO::Handle->new(),
IO::Handle->new());
my $pid = open3($childIN, $childOUT, $childERR, $cmdLine);
close($childIN);
print "forked pid $pid to execute '$cmdLine'\n";
set_non_blocking($childOUT);
set_non_blocking($childERR);
# asynch I/O loop, select on child streams
my $selector = new IO::Select;
$selector->add($childOUT, $childERR);
my @ready;
MAINLOOP: while(1) {
# nothing readable?
unless (@ready = $selector->can_read(0.5)) {
# check if all handles have closed
last MAINLOOP unless $selector->handles();
}
print "select() returned ".
scalar @ready.
" ready handle(s)\n";
# we have something to read on one or more handles,
# so we fetch all we can from all that are ready
my ($bytesRead, $data) = ();
foreach my $fh (@ready) {
# we'll try to read in 8k chunks
my $bytesToRead = 8192;
my $handle;
if ($fh == $childERR) {
$handle = 'child STDERR';
} else {
$handle = 'child STDOUT';
}
print "$handle is ready to read\n";
# read all the available bytes for this handle
READLOOP: while ($bytesToRead) {
my $bytes = sysread $fh, $data, $bytesToRead;
if (defined $bytes) {
print " read $bytes bytes from $handle\n";
# check if handle was closed
if ($bytes == 0) {
print " $handle was closed\n";
$selector->remove($fh);
close $fh;
} else {
$bytesToRead -= $bytes;
chomp $data;
print " data: '$data'\n";
}
} else {
# blocked, nothing left to read, or
# error back to the select() call
print " no more data available\n";
last READLOOP;
}
}
}
}
# blocking wait for the child's exit status
waitpid($pid,0);
my $exitValue = POSIX::WEXITSTATUS($?);
my $signalNum = POSIX::WTERMSIG($?);
my $dumpedCore = $? & 128;
print "exit/sig/core status for child pid ".
"$pid: ($exitValue, ".
"$signalNum, $dumpedCore)\n";
exit 0;
######################################################################
child.pl:
######################################################################
#!/usr/bin/perl -w
use strict;
use POSIX;
# how long the child sleeps between messages
use constant DELAY => 5;
# the name of the daemon's log file
use constant LOGNAME => 'child.log';
# autoflush stdout
$| = 1;
print STDOUT "message to child's STDOUT: about to fork\n";
print STDERR "message to child's STDERR: about to fork\n";
# fork
die "can't fork\n" unless defined(my $child = fork());
# parent exits here
exit 0 if $child;
# setsid (to become process and session group leader)
die "can't setsid()\n" if (POSIX::setsid() == -1);
# fork again
die "can't fork\n" unless defined($child = fork());
# parent exits here (again)
exit 0 if $child;
# redirect STDOUT
my $logfile = "perl_child.log";
close STDOUT;
open(STDOUT, ">".LOGNAME);
# stderr stream same as stdout
close STDERR;
open(STDERR, ">&STDOUT");
# stdin becomes /dev/null
close STDIN;
open(STDIN, '/dev/null');
# ------------------------------------------------------
# now, we're a proper daemon
# ------------------------------------------------------
print STDOUT "message to child's STDOUT: forked, about to sleep\n";
print STDERR "message to child's STDERR: forked, about to sleep\n";
sleep DELAY;
print STDOUT "message to child's STDOUT: awake, about to exit\n";
print STDERR "message to child's STDERR: awake, about to exit\n";
exit 0;
######################################################################
[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
category=core
severity=medium
---
Site configuration information for perl v5.8.0:
Configured by ab122688 at Fri May 16 11:16:15 BST 2003.
Summary of my perl5 (revision 5.0 version 8 subversion 0) configuration:
Platform:
osname=solaris, osvers=2.8, archname=sun4-solaris
uname='sunos matamata 5.8 generic_108528-19 sun4u sparc sunw,ultra-80 '
config_args='-Doptimize=-g'
hint=recommended, useposix=true, d_sigaction=define
usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
use64bitint=undef use64bitall=undef uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler:
cc='gcc', ccflags ='-DDEBUGGING -fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
optimize='-g',
cppflags='-DDEBUGGING -fno-strict-aliasing -I/usr/local/include'
ccversion='', gccversion='2.95.3 20010315 (release)', gccosandvers='solaris2.8'
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=4321
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
alignbytes=8, prototype=define
Linker and Libraries:
ld='gcc', ldflags =' -L/usr/local/lib '
libpth=/usr/local/lib /usr/lib /usr/ccs/lib
libs=-lsocket -lnsl -ldl -lm -lc
perllibs=-lsocket -lnsl -ldl -lm -lc
libc=/lib/libc.so, so=so, useshrplib=false, libperl=libperl.a
gnulibc_version=''
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags=' '
cccdlflags='-fPIC', lddlflags='-G -L/usr/local/lib'
Locally applied patches:
---
@INC for perl v5.8.0:
/usr/local/lib/perl5/5.8.0/sun4-solaris
/usr/local/lib/perl5/5.8.0
/usr/local/lib/perl5/site_perl/5.8.0/sun4-solaris
/usr/local/lib/perl5/site_perl/5.8.0
/usr/local/lib/perl5/site_perl
.
---
Environment for perl v5.8.0:
HOME=/home/ab122688
LANG=C
LANGUAGE (unset)
LC_ALL=C
LC_CTYPE=C
LD_LIBRARY_PATH=/spare/andy/mozilla
LOGDIR (unset)
PATH=/usr/local/ActiveTcl/bin:/usr/local/ActivePython-2.2:/usr/bin:/home/ab122688/bin:/usr/dt/bin:/usr/openwin/bin:/usr/bin:/usr/sbin:/sbin:/usr/ucb:/usr/local/bin:/usr/dist/local/exe:/usr/dist/exe:/usr/lib/lp/postscript:.:/usr/dt/bin:/usr/openwin/bin:/usr/local/mysql/bin:/opt/sfw/bin:/opt/ajuba/TclPro1.5/solaris-sparc/bin
PERL_BADLANG (unset)
SHELL=/bin/csh
Thread Previous