bulk88 has asked for the wisdom of the Perl Monks concerning the following question:
I need to do a Win32 fork, and the child needs to stay waiting on the parent until the parent signals for the child to exit, then the parent waits until the child exits. I got the code from perlfork. Tried it on 5.12 and 5.17 same result.
use strict;
use warnings;
my ($child, $parent);
pipe($child, $parent) or die;
my $pid = fork();
die "fork() failed: $!" unless defined $pid;
if ($pid) {
close $child;
}
else {
close $parent;
print "child waiting\n";
my $read;
read($child, $read, 1);
print "child exiting\n";
exit(0);
}
print $parent "exit now\r\n\r";
print "parent going to wait\n";
waitpid($pid, 0);
All I get in console is
parent going to wait
child waiting
and then I kill perl.exe since it hung. If I add a "close($parent);" after "print $parent "exit now\r\n\r";" it works. I dont know why. Can someone explain what is happening here?
update: the real purpose of this code is for it to be part of a unit test to make an XS module psuedo-fork safe. Since the object was copied during the fork, when the child psuedo proc exits, the C resource is freed, and using the object in the parent caused a crash. The C resource has its own internal reference count which can be queried in C, so I need to check refcount before the fork, make sure it is 1, do a fork, check refcount, make sure it is 2, then tell the child to exit, when child exists, check refcount, make sure it is 1. If no solution was possible (BrowserUK gave 2), I would have been forced to add Win32::IPC as a build/test dep.
Re: pipe fork win32
by BrowserUk (Patriarch) on Aug 26, 2012 at 01:37 UTC
|
use strict;
use warnings;
my ($child, $parent);
pipe($child, $parent) or die;
my $pid = fork();
die "fork() failed: $!" unless defined $pid;
if ($pid) {
close $child;
}
else {
close $parent;
print "child waiting\n";
my $read;
read($child, $read, 1);
print "child exiting\n";
exit(0);
}
print $parent "exit now\r\n\r" x 373;
print "parent going to wait\n";
waitpid($pid, 0);
With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
| [reply] [Watch: Dir/Any] [d/l] |
|
If I change 373 in "print $parent "exit now\r\n\r" x 373;" to 745 (744 hangs) it works.
C:\Documents and Settings\Owner\Desktop>perl -e "print (length(\"exit
+now\r\n\r\
" x 745).\"\n\");"
8195
I guess is somewhat explained by the hung C callstack of the child of my first script.
ntdll.dll!_KiFastSystemCallRet@0()
ntdll.dll!_NtReadFile@36() + 0xc
kernel32.dll!_ReadFile@20() + 0x67
> msvcr71.dll!_read_lk(int fh=3, void * buf=0x00963fec, unsigned in
+t cnt=8192) Line 154 + 0x15 C
msvcr71.dll!_read(int fh=3, void * buf=0x00963fec, unsigned int c
+nt=8192) Line 75 + 0xc C
perl517.dll!win32_read(int fd=3, void * buf=0x00963fec, unsigned
+int cnt=8192) Line 3209 + 0x12 C
perl517.dll!PerlLIORead(IPerlLIO * piPerl=0x00346654, int handle=
+3, void * buffer=0x00963fec, unsigned int count=8192) Line 1033 + 0x
+11 C++
perl517.dll!PerlIOUnix_read(interpreter * my_perl=0x0093502c, _Pe
+rlIO * * f=0x00935e8c, void * vbuf=0x00963fec, unsigned int count=819
+2) Line 2789 + 0x22 C
perl517.dll!Perl_PerlIO_read(interpreter * my_perl=0x0093502c, _P
+erlIO * * f=0x00935e8c, void * vbuf=0x00963fec, unsigned int count=81
+92) Line 1679 + 0x3e C
perl517.dll!PerlIOBuf_fill(interpreter * my_perl=0x0093502c, _Per
+lIO * * f=0x00935aa4) Line 4033 + 0x1b C
perl517.dll!Perl_PerlIO_fill(interpreter * my_perl=0x0093502c, _P
+erlIO * * f=0x00935aa4) Line 1776 + 0x36 C
perl517.dll!PerlIOBase_read(interpreter * my_perl=0x0093502c, _Pe
+rlIO * * f=0x00935aa4, void * vbuf=0x0095b49c, unsigned int count=1)
+ Line 2170 + 0xd C
perl517.dll!PerlIOBuf_read(interpreter * my_perl=0x0093502c, _Per
+lIO * * f=0x00935aa4, void * vbuf=0x0095b49c, unsigned int count=1)
+Line 4054 + 0x15 C
perl517.dll!Perl_PerlIO_read(interpreter * my_perl=0x0093502c, _P
+erlIO * * f=0x00935aa4, void * vbuf=0x0095b49c, unsigned int count=1)
+ Line 1679 + 0x3e C
perl517.dll!Perl_pp_sysread(interpreter * my_perl=0x0093502c) Li
+ne 1775 + 0x18 C
perl517.dll!Perl_runops_debug(interpreter * my_perl=0x0093502c)
+Line 2126 + 0xd C
perl517.dll!win32_start_child(void * arg=0x0093502c) Line 1742 +
+ 0xd C++
kernel32.dll!_BaseThreadStart@8() + 0x37
0x2000/8192 was passed as the read amount to ReadFile. Does anyone know what should have happened on Windows? What happens on Unix? 8192 read also? or it will still succeed for POSIX reasons? is the 8192 read length a bug or correct? | [reply] [Watch: Dir/Any] [d/l] [select] |
|
If I change 373 in "print $parent "exit now\r\n\r" x 373;" to 745 (744 hangs) it works.
Hm. I used 373 because that is the lowest value on my system that worked (373 * 11 > 4096), so my system (Vista64) is using a 4096 byte buffer.
I thought all Windows systems used that size. I wonder why yours is using 8k? What version of windows are you running? Are you using a home-built version of Perl? Did you tweak the value?
With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
| [reply] [Watch: Dir/Any] |
|
|
|
|
|
|
Re: pipe fork win32
by BrowserUk (Patriarch) on Aug 26, 2012 at 01:44 UTC
|
use strict;
use warnings;
sub debuf{ select( ( select( $_[0] ), $|++ )[0] ) }
my ($child, $parent);
pipe($child, $parent) or die;
debuf( $parent );
my $pid = fork();
die "fork() failed: $!" unless defined $pid;
if ($pid) {
close $child;
}
else {
close $parent;
print "child waiting\n";
my $read;
read($child, $read, 1);
print "child exiting\n";
exit(0);
}
print $parent "exit now\r\n\r";
print "parent going to wait\n";
waitpid($pid, 0);
With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
| [reply] [Watch: Dir/Any] [d/l] |
|
This also works. Why? what did you do?
I read select but why? My sockets and File I/O knowledge is not very good. Wouldn't changing default handle break "print "parent going to wait\n";" line and make it go to the child (it doesn't in real life, I got that line in the console) instead of to console? "print $parent "exit now\r\n\r";" says an explicit handle, it is not using a default handle why would changing the default handle affect it?
| [reply] [Watch: Dir/Any] |
|
I read select but why?
All the debuf() does is apply $|++ to $parent, thus making the handle line-buffered rather than block buffered.
Hence, the \n in print $parent "exit now\r\n\r"; causes the buffer to be flushed through and the read then completes.
(BTW: The \rs do nothing! As the pipe is in text mode, the \n will be translated to \cM\cJ on write and then back to \cJ when read back.)
why would changing the default handle affect it?
if you look closely at debuf(), it selects the handle ($parent) that is passed to it; does the $++ whilst that handle is selected, and then re-selects the original default handle. Ie. It is equivalent to:
sub debuf{
my $old = select( $_[0] );
$|++;
select( $old }
}
With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
/code | [reply] [Watch: Dir/Any] [d/l] [select] |
|
|
Re: pipe fork win32
by Marshall (Canon) on Aug 26, 2012 at 04:03 UTC
|
This Windows fork() is a weird thing, because it uses threads to emulate what a Unix fork() would do.
I tried to write a simple scenario, but ran into problems with sleep(). My 'work-around' in the child process is not efficient, but it appears to work on Win XP, Perl 5.10.1.
I'd like to know a bit more about the application... The parent can send various flavors of "kill" to the child (you know its process id - and "kill" is basically a one bit message) and the child can have a signal handler to intercept this and figure out what to do. I don't see the need for any kind of "read" operation between the parent and the child, but maybe I don't understand what you need.
BrowserUk knows way more about communication between Windows threads than I do, but it doesn't sound like that is required? Setting up an IP connection between the client and the parent is possible, but I'm not sure of the need for that.
This is not a "server" it just forks a single child. More complex scenarios are possible.
#/usr/bin/perl -w
use strict;
my $pid = fork();
die "fork() failed: $!" unless defined $pid;
if ($pid)
{
print "I am the child pid =$pid...\n";
while (1)
{
`ping 127.0.0.1 -n 5 > nul`;
# sleep() won't work on Windows in multiple threads
# the pid is a negative number and this a
# thread (fork emulation)
# there is Windows "weirdness" with sleep
# here I started a command that will "wait"
# for awhile before returning.
# this is inefficent, but appears to work
print "I am still the child ". localtime()."\n";
}
}
else
{
print "I am the parent\n";
while (sleep(2))
{
print "I am still the parent ". localtime(), "\n";
}
}
__END__
C:\TEMP>perl client_server.pl
I am the child pid =-5428...
I am the parent
I am still the parent Sat Aug 25 20:29:13 2012
I am still the parent Sat Aug 25 20:29:15 2012
I am still the child Sat Aug 25 20:29:16 2012
I am still the parent Sat Aug 25 20:29:17 2012
I am still the parent Sat Aug 25 20:29:19 2012
I am still the child Sat Aug 25 20:29:20 2012
I am still the parent Sat Aug 25 20:29:21 2012
I am still the parent Sat Aug 25 20:29:23 2012
I am still the child Sat Aug 25 20:29:24 2012
I am still the parent Sat Aug 25 20:29:25 2012
I am still the parent Sat Aug 25 20:29:27 2012
I am still the child Sat Aug 25 20:29:28 2012
I am still the parent Sat Aug 25 20:29:29 2012
Terminating on signal SIGINT(2)
#I hit CTL-C in the command window...
#the parent was running in the foreground...
| [reply] [Watch: Dir/Any] [d/l] |
|
#/usr/bin/perl -w
use strict;
my $pid = fork();
die "fork() failed: $!" unless defined $pid;
if ($pid) {
print "I am the child pid =$pid...\n";
while ( sleep 1 ) {
print "I am still the child ". localtime()."\n";
}
}
else {
print "I am the parent\n";
while (sleep(2)) {
print "I am still the parent ". localtime(), "\n";
}
}
__END__
C:\test>junk57
I am the child pid =-3552...
I am the parent
I am still the child Sun Aug 26 07:46:33 2012
I am still the parent Sun Aug 26 07:46:34 2012
I am still the child Sun Aug 26 07:46:34 2012
I am still the child Sun Aug 26 07:46:35 2012
I am still the parent Sun Aug 26 07:46:36 2012
I am still the child Sun Aug 26 07:46:36 2012
I am still the child Sun Aug 26 07:46:37 2012
I am still the parent Sun Aug 26 07:46:38 2012
I am still the child Sun Aug 26 07:46:38 2012
Terminating on signal SIGINT(2)
BTW: The question above isn't sarcasm, but a real question.
I vaguely recollect hearing or reading someone else say something similar a long time ago, but I know it has never been true -- at least not since the long gone days of cooperative multithreading -- so I'd really like to know where the idea comes from?
With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
RIP Neil Armstrong
| [reply] [Watch: Dir/Any] [d/l] |
|
| [reply] [Watch: Dir/Any] [d/l] |
|
|
|
|
|
|
|
Perl sleep on windows in a VM or 100% CPU usage or C debugger breakpoints, or bad driver that likes lock all the CPUs and then spin sleep for too long to freeze the PC can cause an overflow in Perl's sleep, and then only a random Windows message (mouse move, repaint, idk what else, but there WILL be one, thx MS) will breakout of the sleep hang, see https://rt.perl.org/rt3/Ticket/Display.html?id=33096 causing the sleep to take more seconds than it should have. win32/win32.c#l2163 in perl.git for the offending code.
| [reply] [Watch: Dir/Any] |
|
|
|
Re: pipe fork win32
by bojinlund (Monsignor) on Aug 26, 2012 at 07:46 UTC
|
| [reply] [Watch: Dir/Any] |
|
| [reply] [Watch: Dir/Any] |
|
|