Hi,
My collegue Nick Williams and I had a stab at making POE::Wheel::Run
work on Win32. The attached patch makes it work with both code refs
and external programs, all regression tests pass, after adjusting the
wheel_run.t to not die anymore and use the correct commandline
quotation.
The patch solves two issues with fork+exec on windows. Firstly it
appears the stdio handles are not separated properly after the fork, so
reopening these in the child onto the Pipe::TwoWay handles actually
changes them in the parent as well. First closing them works, after that
the CODE subroutine ref branch is working properly.
The exec is at that point not working yet because the internal Perl
implementation of fork+exec on Windows remembers the underlying Windows
handles of stdio at the time of the fork to use later for the exec. To
repoint these you need the OS call 'SetStdHandle'. Even though this is
used in the perl core, it is not exposed to the Perl level. It is also
not exposed through Win32API::File, which does have FdGetOsFHandle,
necessary to get the Windows native file handles associated with the
Pipe::TwoWay.
We were stuck at this point, until we found that Win32::Console uses
_SetStdHandle internally and unwittingly exposes it. So we pull both of
these modules in conditionally and use them. If there is a better way of
getting at SetStdHandle we would like to know.
Also this match makes use of POE::Kernel::RUNNING_IN_HELL, which is
changed to be a compile time installed constant subroutine. If that is
deemed micro optimization or just plain wrong to use cross package
like that, please adjust accordingly. I've been restrained from
renaming it :-)
Comments and most definitely testing very welcome.
Cheers,
--
Merijn Broeren | She doesn't want you to understand her. She knows that's
Software Geek | impossible. She just wants you to understand yourself,
| everything else is negotiable.
diff -u -r 0.3009/src/distro/lib/POE/Kernel.pm
0.3009-ms1/src/distro/lib/POE/Kernel.pm
--- 0.3009/src/distro/lib/POE/Kernel.pm 2004-12-02 15:41:54.000000000 +0000
+++ 0.3009-ms1/src/distro/lib/POE/Kernel.pm 2005-04-08 15:26:09.000000000
+0100
@@ -58,11 +58,19 @@
#------------------------------------------------------------------------------
# Perform some optional setup.
-sub RUNNING_IN_HELL () { $^O eq 'MSWin32' }
BEGIN {
local $SIG{'__DIE__'} = 'DEFAULT';
+ {
+ no strict 'refs';
+ if ($^O eq 'MSWin32') {
+ *{ __PACKAGE__ . '::RUNNING_IN_HELL' } = sub { 1 };
+ } else {
+ *{ __PACKAGE__ . '::RUNNING_IN_HELL' } = sub { 0 };
+ }
+ }
+
# POE runs better with Time::HiRes, but it also runs without it.
{ no strict 'refs';
diff -u -r 0.3009/src/distro/lib/POE/Wheel/Run.pm
0.3009-ms1/src/distro/lib/POE/Wheel/Run.pm
--- 0.3009/src/distro/lib/POE/Wheel/Run.pm 2004-12-21 23:15:09.000000000
+0000
+++ 0.3009-ms1/src/distro/lib/POE/Wheel/Run.pm 2005-04-11 14:42:36.000000000
+0100
@@ -17,7 +17,6 @@
BEGIN {
die "$^O does not support fork()\n" if $^O eq 'MacOS';
- die "$^O does not fully support fork+exec\n" if $^O eq 'MSWin32';
local $SIG{'__DIE__'} = 'DEFAULT';
eval { require IO::Pty; };
@@ -27,6 +26,16 @@
eval 'sub PTY_AVAILABLE () { 1 }';
}
+ if (POE::Kernel::RUNNING_IN_HELL) {
+ eval { require Win32::Console; };
+ if ($@) { die "Running on Win32, need Win32::Console but failed to
load:\n$@" }
+ else { Win32::Console->import(); };
+
+ eval { require Win32API::File; };
+ if ($@) { die "Running on Win32, need Win32API::File but failed to
load:\n$@" }
+ else { Win32API::File->import( qw(FdGetOsFHandle) ); };
+ }
+
# How else can I get them out?!
if (eval '&IO::Tty::Constant::TIOCSCTTY') {
*TIOCSCTTY = *IO::Tty::Constant::TIOCSCTTY;
@@ -380,6 +389,11 @@
close $stdin_write;
close $stdout_read;
close $stderr_read if defined $stderr_read;
+
+ # Need to close on Win32 because std handles aren't dup'ed, no harm
elsewhere
+ # Close STDERR later to not influence possible die
+ close STDIN;
+ close STDOUT;
# Redirect STDIN from the read end of the stdin pipe.
open( STDIN, "<&" . fileno($stdin_read) )
@@ -389,6 +403,9 @@
open( STDOUT, ">&" . fileno($stdout_write) )
or die "can't redirect stdout in child pid $$: $!";
+ # Need to close on Win32 because std handles aren't dup'ed, no harm
elsewhere
+ close STDERR;
+
# Redirect STDERR to the write end of the stderr pipe. If the
# stderr pipe's undef, then we use STDOUT.
open( STDERR, ">&" . fileno($stderr_write) )
@@ -399,16 +416,22 @@
select STDOUT; $| = 1;
# Tell the parent that the stdio has been set up.
- close $sem_pipe_read unless $^O eq 'MSWin32';
+ close $sem_pipe_read;
print $sem_pipe_write "go\n";
- close $sem_pipe_write unless $^O eq 'MSWin32';
+ close $sem_pipe_write;
- # Exec the program depending on its form.
- if (ref($program) eq 'ARRAY') {
- exec(@$program, @$prog_args)
- or die "can't exec (@$program) in child pid $$: $!";
+ if (POE::Kernel::RUNNING_IN_HELL) {
+ # The Win32 pseudo fork sets up the std handles in the child based on
the true win32 handles
+ # For the exec these get remembered, so manipulation of STDIN/OUT/ERR
is not enough. Only
+ # necessary for the exec, as Perl CODE subroutine goes through 0/1/2
which are correct.
+ # But ofcourse that coderef might invoke exec, so better do it
regardless.
+ # HACK: Using Win32::Console as nothing else exposes SetStdHandle
+ Win32::Console::_SetStdHandle(STD_INPUT_HANDLE(),
FdGetOsFHandle(fileno($stdin_read)));
+ Win32::Console::_SetStdHandle(STD_OUTPUT_HANDLE(),
FdGetOsFHandle(fileno($stdout_write)));
+ Win32::Console::_SetStdHandle(STD_ERROR_HANDLE(),
FdGetOsFHandle(fileno($stderr_write)));
}
- elsif (ref($program) eq 'CODE') {
+ # Exec the program depending on its form.
+ if (ref($program) eq 'CODE') {
# Close any close-on-exec file descriptors.
if ($close_on_call) {
@@ -423,16 +446,23 @@
# Try to exit without triggering END or object destructors.
# Give up with a plain exit if we must.
- eval { POSIX::_exit(0); };
- eval { kill KILL => $$; };
- eval { exec("$^X -e 0"); };
+ # On win32 cannot _exit as it will kill *all* threads, meaning parent too
+ unless (POE::Kernel::RUNNING_IN_HELL) {
+ eval { POSIX::_exit(0); };
+ eval { kill KILL => $$; };
+ eval { exec("$^X -e 0"); };
+ };
exit(0);
+ } else {
+ if (ref($program) eq 'ARRAY') {
+ exec(@$program, @$prog_args)
+ or die "can't exec (@$program) in child pid $$: $!";
+ }
+ else {
+ exec(join(" ", $program, @$prog_args))
+ or die "can't exec ($program) in child pid $$: $!";
+ }
}
- else {
- exec(join(" ", $program, @$prog_args))
- or die "can't exec ($program) in child pid $$: $!";
- }
-
die "insanity check passed";
}
diff -u -r 0.3009/src/distro/tests/30_loops/00_base/wheel_run.pm
0.3009-ms1/src/distro/tests/30_loops/00_base/wheel_run.pm
--- 0.3009/src/distro/tests/30_loops/00_base/wheel_run.pm 2004-11-22
00:13:53.000000000 +0000
+++ 0.3009-ms1/src/distro/tests/30_loops/00_base/wheel_run.pm 2005-04-11
12:15:47.000000000 +0100
@@ -18,9 +18,6 @@
if ($^O eq "MacOS") {
$error = "$^O does not support fork";
}
- elsif ($^O eq "MSWin32") {
- $error = "$^O does not support fork/exec properly";
- }
if ($error) {
print "1..0 # Skip $error\n";
@@ -151,8 +148,10 @@
my $tty_flush_count = 0;
+my $os_quote = ($^O eq 'MSWin32') ? q(") : q(');
+
my $program =
- ( "$^X -we '" .
+ ( "$^X -we $os_quote" .
'$/ = q(!); select STDERR; $| = 1; select STDOUT; $| = 1; ' .
'my $out = shift; '.
'my $err = shift; '.
@@ -163,7 +162,7 @@
' print(STDERR qq($err: $_)) if s/^err //; ' .
' } ' .
'} ' .
- 'exit 0;\''
+ "exit 0; $os_quote"
);
{ POE::Session->create
