develooper 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


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About