bidirectional pipe problem --- process doesn't see input

[Darren Stuart Embry <ds...@louisville.edu>]

Environment --- perl-5.6.0/mod_perl-1.24 on an apache-1.3.12 server.

Problem --- I'm trying to use the IPC::Open2 module to do a
bidirectional pipe in a mod_perl handler, but it is not working
properly.

What happens is that the program I want to read from/write to
doesn't see what I'm inputting into it but I can still see what
it's outputting.  So the program's running.  And that's even
though I'm autoflushing all input and output handles, both from
the parent and inside the script.

The same thing happens if I use pipe() and fork() manually, so I
don't think this is strictly a problem with IPC::Open2().

This problem does not occur if I'm using perl-5.005_03, all
other things (Apache version, mod_perl version) being equal.

This problem does also not occur when I run a program using such
code from the command line, all other things (perl version)
being equal.

Files included in this post, in order:

- WebOnAStick::Test::Test (don't ask about the name), a demo module I
  wrote which implements the two different forms of using a
  bidirectional pipe, and which also serves as the content handler.

- test-io, the program I want to read from and write to.

- test-io2, a command-line program that uses the demo Perl modoule to
  illustrate that bidirectional pipes work fine from the command line.

The content handler's output:

	<H2>Input</H2>

	<PRE>
	This is a test.  foo.
	This is another test.  foo.
	</PRE>

	<H2>Output 1</H2>

	<PRE>
	I received 0 lines.
	</PRE>

	<H2>Output 2</H2>

	<PRE>
	I received 0 lines.
	</PRE>

The command line program's (test-io2) output:

	<OUTPUT_1>
	{test-io was here}This is a test.  bar.
	{test-io was here}This is another test.  bar.
	I received 2 lines.
	</OUTPUT_1>
	<OUTPUT_2>
	{test-io was here}This is a test.  bar.
	{test-io was here}This is another test.  bar.
	I received 2 lines.
	</OUTPUT_2>

Thanks a lot,
Darren

========================================================================

package WebOnAStick::Test::Test;
###---------------------------------------------------------------------
### This module contains try_pipe_1() and try_pipe_2(), two different
### demonstrations of how to use a bidirectional pipe.  The first uses
### IPC::Open2(); the second uses pipe() and fork().  It also
### contains a mod_perl content handler to demonstrate that the code
### doesn't work properly when using perl-5.6.0/mod_perl-1.24.  This
### type of code works properly when using perl-5.005_03/mod_perl-1.24
### (well, you'd have to change the our declarations, obviously), and 
### it also works just fine from the command line.
###---------------------------------------------------------------------
use strict;
use Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw();
our @EXPORT_OK = qw(try_pipe_1 try_pipe_2);

use Apache::Constants qw(:common);
use IPC::Open2;
use IO::Handle;

sub try_pipe_1 {
    my $input = shift();
    my @pipe = ('/home/dse/bin/test-io');
    my $rh = new IO::Handle; my $wh = new IO::Handle;
    my $pid = open2($rh,$wh,@pipe); # can't pass undef handles under 5.005...
    unless($pid) {
        return (0,"open2 failed: $!\n");
    }
    $rh->autoflush(); $wh->autoflush();
    $wh->print($input); $wh->close();
    my $output = join('',<$rh>); $rh->close();
    waitpid($pid,0);
    return (1,$output);
}

sub try_pipe_2 {
    my $input = shift();
    my @pipe = ('/home/dse/bin/test-io');
    my $r1 = new IO::Handle; my $w1 = new IO::Handle; pipe($r1,$w1);
    my $r2 = new IO::Handle; my $w2 = new IO::Handle; pipe($r2,$w2);
    $w1->autoflush(); $r2->autoflush();
    $w2->autoflush(); $r1->autoflush();
    my $pid = fork();
    if (!defined($pid)) {
        return (0,"could not fork: $!\n");
    }
    if (!$pid) {
        # child: read from pipe1, write to pipe2
        close($w1); close($r2);
        open(STDIN,'<&='.fileno($r1));
        open(STDOUT,'>&='.fileno($w2));
        select(STDIN); $|=1;
        select(STDOUT); $|=1;
        exec(@pipe) or exit(86);
    }
    # parent: read from pipe2, write to pipe1
    close($r1); close($w2);
    $w1->print($input); $w1->close();
    waitpid($pid,0);
    my $output = join('',<$r2>); $r2->close();
    return (1,$output);
}

use HTML::Entities;

sub handler {
    my $r = shift();
    my $input = "This is a test.  foo.\nThis is another test.  foo.\n";
    my ($status1,$output1) = try_pipe_1($input);
    if (!$status1) {
        $r->log_error($output1);
        return SERVER_ERROR;
    }
    my ($status2,$output2) = try_pipe_2($input);
    if (!$status2) {
        $r->log_error($output2);
        return SERVER_ERROR;
    }
    $r->content_type('text/html');
    $r->send_http_header();
    $r->print("<H2>Input</H2>\n");
    $r->print("<PRE>".encode_entities($input)."</PRE>\n\n");
    $r->print("<H2>Output 1</H2>\n");
    $r->print("<PRE>".encode_entities($output1)."</PRE>\n\n");
    $r->print("<H2>Output 2</H2>\n");
    $r->print("<PRE>".encode_entities($output2)."</PRE>\n\n");
    return OK;
}

1;

========================================================================

#!/usr/bin/perl -w
###---------------------------------------------------------------------
### This is test-io, a simple script that modifies every line
### of input and prints the results, and also prints a line
### telling how many lines of input it read.
###---------------------------------------------------------------------
use strict;
select(STDIN); $| = 1;
select(STDOUT); $| = 1;
my $count = 0;
while (<>) {
    ++$count;
    chomp;
    s/foo/bar/g;
    s/^/{test-io was here}/g;
    print "$_\n";
}
print "I received $count lines.\n";

========================================================================

#!/usr/bin/perl -w
###---------------------------------------------------------------------
### This is test-io2, a script that demonstrates that IPC::Open2
### (and manual pipe hacking) works fine from the command line.
###---------------------------------------------------------------------
use strict;
use lib '/usr/local/webonastick/perl';
use WebOnAStick::Test::Test qw(try_pipe_1 try_pipe_2);
my $input = "This is a test.  foo.\nThis is another test.  foo.\n";
my ($status1,$output1) = try_pipe_1($input);
die "FAILED #1: $output1\n" unless $status1;
my ($status2,$output2) = try_pipe_2($input);
die "FAILED #2: $output2\n" unless $status2;
print "<OUTPUT_1>\n$output1</OUTPUT_1>\n";
print "<OUTPUT_2>\n$output2</OUTPUT_2>\n";

========================================================================

-- 
Darren Stuart Embry.  DNRC Resident Stick Figure Artist.
http://www.webonastick.com/
    ``Do pardon me for crediting the average person with intelligence.''
	-- Beverley White, in alt.religion.kibology