ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent-Fork/Fork.pm
(Generate patch)

Comparing AnyEvent-Fork/Fork.pm (file contents):
Revision 1.18 by root, Sat Apr 6 01:33:56 2013 UTC vs.
Revision 1.24 by root, Sat Apr 6 08:32:23 2013 UTC

… …
4 4
5=head1 SYNOPSIS 5=head1 SYNOPSIS
6 6
7 use AnyEvent::Fork; 7 use AnyEvent::Fork;
8 8
9 ################################################################## 9 AnyEvent::Fork
10 ->new
11 ->require ("MyModule")
12 ->run ("MyModule::server", my $cv = AE::cv);
13
14 my $fh = $cv->recv;
15
16=head1 DESCRIPTION
17
18This module allows you to create new processes, without actually forking
19them from your current process (avoiding the problems of forking), but
20preserving most of the advantages of fork.
21
22It can be used to create new worker processes or new independent
23subprocesses for short- and long-running jobs, process pools (e.g. for use
24in pre-forked servers) but also to spawn new external processes (such as
25CGI scripts from a web server), which can be faster (and more well behaved)
26than using fork+exec in big processes.
27
28Special care has been taken to make this module useful from other modules,
29while still supporting specialised environments such as L<App::Staticperl>
30or L<PAR::Packer>.
31
32=head1 WHAT THIS MODULE IS NOT
33
34This module only creates processes and lets you pass file handles and
35strings to it, and run perl code. It does not implement any kind of RPC -
36there is no back channel from the process back to you, and there is no RPC
37or message passing going on.
38
39If you need some form of RPC, you can either implement it yourself
40in whatever way you like, use some message-passing module such
41as L<AnyEvent::MP>, some pipe such as L<AnyEvent::ZeroMQ>, use
42L<AnyEvent::Handle> on both sides to send e.g. JSON or Storable messages,
43and so on.
44
45=head1 EXAMPLES
46
10 # create a single new process, tell it to run your worker function 47=head2 Create a single new process, tell it to run your worker function.
11 48
12 AnyEvent::Fork 49 AnyEvent::Fork
13 ->new 50 ->new
14 ->require ("MyModule") 51 ->require ("MyModule")
15 ->run ("MyModule::worker, sub { 52 ->run ("MyModule::worker, sub {
… …
25 62
26 # now $slave_filehandle is connected to the $master_filehandle 63 # now $slave_filehandle is connected to the $master_filehandle
27 # in the original prorcess. have fun! 64 # in the original prorcess. have fun!
28 } 65 }
29 66
30 ##################################################################
31 # create a pool of server processes all accepting on the same socket 67=head2 Create a pool of server processes all accepting on the same socket.
32 68
33 # create listener socket 69 # create listener socket
34 my $listener = ...; 70 my $listener = ...;
35 71
36 # create a pool template, initialise it and give it the socket 72 # create a pool template, initialise it and give it the socket
… …
61 while (my $socket = $listener->accept) { 97 while (my $socket = $listener->accept) {
62 # do sth. with new socket 98 # do sth. with new socket
63 } 99 }
64 } 100 }
65 101
66=head1 DESCRIPTION 102=head2 use AnyEvent::Fork as a faster fork+exec
67 103
68This module allows you to create new processes, without actually forking 104This runs /bin/echo hi, with stdout redirected to /tmp/log and stderr to
69them from your current process (avoiding the problems of forking), but 105the communications socket. It is usually faster than fork+exec, but still
70preserving most of the advantages of fork. 106let's you prepare the environment.
71 107
72It can be used to create new worker processes or new independent 108 open my $output, ">/tmp/log" or die "$!";
73subprocesses for short- and long-running jobs, process pools (e.g. for use
74in pre-forked servers) but also to spawn new external processes (such as
75CGI scripts from a web server), which can be faster (and more well behaved)
76than using fork+exec in big processes.
77 109
78Special care has been taken to make this module useful from other modules, 110 AnyEvent::Fork
79while still supporting specialised environments such as L<App::Staticperl> 111 ->new
80or L<PAR::Packer>. 112 ->eval ('
113 sub run {
114 my ($fh, $output, @cmd) = @_;
81 115
82=head1 WHAT THIS MODULE IS NOT 116 # perl will clear close-on-exec on STDOUT/STDERR
117 open STDOUT, ">&", $output or die;
118 open STDERR, ">&", $fh or die;
83 119
84This module only creates processes and lets you pass file handles and 120 exec @cmd;
85strings to it, and run perl code. It does not implement any kind of RPC - 121 }
86there is no back channel from the process back to you, and there is no RPC 122 ')
87or message passing going on. 123 ->send_fh ($output)
124 ->send_arg ("/bin/echo", "hi")
125 ->run ("run", my $cv = AE::cv);
88 126
89If you need some form of RPC, you can either implement it yourself 127 my $stderr = $cv->recv;
90in whatever way you like, use some message-passing module such
91as L<AnyEvent::MP>, some pipe such as L<AnyEvent::ZeroMQ>, use
92L<AnyEvent::Handle> on both sides to send e.g. JSON or Storable messages,
93and so on.
94 128
95=head1 PROBLEM STATEMENT 129=head1 PROBLEM STATEMENT
96 130
97There are two ways to implement parallel processing on UNIX like operating 131There are two ways to implement parallel processing on UNIX like operating
98systems - fork and process, and fork+exec and process. They have different 132systems - fork and process, and fork+exec and process. They have different
… …
258use AnyEvent; 292use AnyEvent;
259use AnyEvent::Util (); 293use AnyEvent::Util ();
260 294
261use IO::FDPass; 295use IO::FDPass;
262 296
263our $VERSION = 0.2; 297our $VERSION = 0.5;
264 298
265our $PERL; # the path to the perl interpreter, deduces with various forms of magic 299our $PERL; # the path to the perl interpreter, deduces with various forms of magic
266 300
267=item my $pool = new AnyEvent::Fork key => value... 301=item my $pool = new AnyEvent::Fork key => value...
268 302
… …
284 my $self = shift; 318 my $self = shift;
285 319
286 # ideally, we would want to use "a (w/a)*" as format string, but perl 320 # ideally, we would want to use "a (w/a)*" as format string, but perl
287 # versions from at least 5.8.9 to 5.16.3 are all buggy and can't unpack 321 # versions from at least 5.8.9 to 5.16.3 are all buggy and can't unpack
288 # it. 322 # it.
289 push @{ $self->[2] }, pack "L/a*", pack "(w/a*)*", @_; 323 push @{ $self->[2] }, pack "a L/a*", $_[0], $_[1];
290 324
291 unless ($self->[3]) { 325 $self->[3] ||= AE::io $self->[1], 1, sub {
292 my $wcb = sub {
293 do { 326 do {
294 # send the next "thing" in the queue - either a reference to an fh, 327 # send the next "thing" in the queue - either a reference to an fh,
295 # or a plain string. 328 # or a plain string.
296 329
297 if (ref $self->[2][0]) { 330 if (ref $self->[2][0]) {
298 # send fh 331 # send fh
299 unless (IO::FDPass::send fileno $self->[1], fileno ${ $self->[2][0] }) { 332 unless (IO::FDPass::send fileno $self->[1], fileno ${ $self->[2][0] }) {
300 return if $! == Errno::EAGAIN || $! == Errno::EWOULDBLOCK; 333 return if $! == Errno::EAGAIN || $! == Errno::EWOULDBLOCK;
301 undef $self->[3]; 334 undef $self->[3];
302 die "AnyEvent::Fork: file descriptor send failure: $!"; 335 die "AnyEvent::Fork: file descriptor send failure: $!";
303 }
304
305 shift @{ $self->[2] };
306
307 } else {
308 # send string
309 my $len = syswrite $self->[1], $self->[2][0];
310
311 unless ($len) {
312 return if $! == Errno::EAGAIN || $! == Errno::EWOULDBLOCK;
313 undef $self->[3];
314 die "AnyEvent::Fork: command write failure: $!";
315 }
316
317 substr $self->[2][0], 0, $len, "";
318 shift @{ $self->[2] } unless length $self->[2][0];
319 } 336 }
337
338 shift @{ $self->[2] };
339
340 } else {
341 # send string
342 my $len = syswrite $self->[1], $self->[2][0];
343
344 unless ($len) {
345 return if $! == Errno::EAGAIN || $! == Errno::EWOULDBLOCK;
346 undef $self->[3];
347 die "AnyEvent::Fork: command write failure: $!";
348 }
349
350 substr $self->[2][0], 0, $len, "";
351 shift @{ $self->[2] } unless length $self->[2][0];
352 }
320 } while @{ $self->[2] }; 353 } while @{ $self->[2] };
321 354
322 # everything written 355 # everything written
323 undef $self->[3]; 356 undef $self->[3];
357
324 # invoke run callback 358 # invoke run callback, if any
325 $self->[0]->($self->[1]) if $self->[0]; 359 $self->[4]->($self->[1]) if $self->[4];
326 };
327
328 $wcb->();
329
330 $self->[3] ||= AE::io $self->[1], 1, $wcb
331 if @{ $self->[2] };
332 } 360 };
333 361
334 () # make sure we don't leak the watcher 362 () # make sure we don't leak the watcher
335} 363}
336 364
337sub _new { 365sub _new {
338 my ($self, $fh) = @_; 366 my ($self, $fh, $pid) = @_;
339 367
340 AnyEvent::Util::fh_nonblocking $fh, 1; 368 AnyEvent::Util::fh_nonblocking $fh, 1;
341 369
342 $self = bless [ 370 $self = bless [
343 undef, # run callback 371 $pid,
344 $fh, 372 $fh,
345 [], # write queue - strings or fd's 373 [], # write queue - strings or fd's
346 undef, # AE watcher 374 undef, # AE watcher
347 ], $self; 375 ], $self;
348 376
… …
366 exit 0; 394 exit 0;
367 } elsif (!$pid) { 395 } elsif (!$pid) {
368 die "AnyEvent::Fork::Early/Template: unable to fork template process: $!"; 396 die "AnyEvent::Fork::Early/Template: unable to fork template process: $!";
369 } 397 }
370 398
371 AnyEvent::Fork->_new ($fh) 399 AnyEvent::Fork->_new ($fh, $pid)
372} 400}
373 401
374=item my $proc = new AnyEvent::Fork 402=item my $proc = new AnyEvent::Fork
375 403
376Create a new "empty" perl interpreter process and returns its process 404Create a new "empty" perl interpreter process and returns its process
… …
469 # quick. also doesn't work in win32. of course. what did you expect 497 # quick. also doesn't work in win32. of course. what did you expect
470 #local $ENV{PERL5LIB} = join ":", grep !ref, @INC; 498 #local $ENV{PERL5LIB} = join ":", grep !ref, @INC;
471 my %env = %ENV; 499 my %env = %ENV;
472 $env{PERL5LIB} = join +($^O eq "MSWin32" ? ";" : ":"), grep !ref, @INC; 500 $env{PERL5LIB} = join +($^O eq "MSWin32" ? ";" : ":"), grep !ref, @INC;
473 501
474 Proc::FastSpawn::spawn ( 502 my $pid = Proc::FastSpawn::spawn (
475 $perl, 503 $perl,
476 ["perl", "-MAnyEvent::Fork::Serve", "-e", "AnyEvent::Fork::Serve::me", fileno $slave, $$], 504 ["perl", "-MAnyEvent::Fork::Serve", "-e", "AnyEvent::Fork::Serve::me", fileno $slave, $$],
477 [map "$_=$env{$_}", keys %env], 505 [map "$_=$env{$_}", keys %env],
478 ) or die "unable to spawn AnyEvent::Fork server: $!"; 506 ) or die "unable to spawn AnyEvent::Fork server: $!";
479 507
480 $self->_new ($fh) 508 $self->_new ($fh, $pid)
509}
510
511=item $pid = $proc->pid
512
513Returns the process id of the process I<iff it is a direct child of the
514process> running AnyEvent::Fork, and C<undef> otherwise.
515
516Normally, only processes created via C<< AnyEvent::Fork->new_exec >> and
517L<AnyEvent::Fork::Template> are direct children, and you are responsible
518to clean up their zombies when they die.
519
520All other processes are not direct children, and will be cleaned up by
521AnyEvent::Fork.
522
523=cut
524
525sub pid {
526 $_[0][0]
481} 527}
482 528
483=item $proc = $proc->eval ($perlcode, @args) 529=item $proc = $proc->eval ($perlcode, @args)
484 530
485Evaluates the given C<$perlcode> as ... perl code, while setting C<@_> to 531Evaluates the given C<$perlcode> as ... perl code, while setting C<@_> to
486the strings specified by C<@args>. 532the strings specified by C<@args>, in the "main" package.
487 533
488This call is meant to do any custom initialisation that might be required 534This call is meant to do any custom initialisation that might be required
489(for example, the C<require> method uses it). It's not supposed to be used 535(for example, the C<require> method uses it). It's not supposed to be used
490to completely take over the process, use C<run> for that. 536to completely take over the process, use C<run> for that.
491 537
492The code will usually be executed after this call returns, and there is no 538The code will usually be executed after this call returns, and there is no
493way to pass anything back to the calling process. Any evaluation errors 539way to pass anything back to the calling process. Any evaluation errors
494will be reported to stderr and cause the process to exit. 540will be reported to stderr and cause the process to exit.
495 541
542If you want to execute some code to take over the process (see the
543"fork+exec" example in the SYNOPSIS), you should compile a function via
544C<eval> first, and then call it via C<run>. This also gives you access to
545any arguments passed via the C<send_xxx> methods, such as file handles.
546
496Returns the process object for easy chaining of method calls. 547Returns the process object for easy chaining of method calls.
497 548
498=cut 549=cut
499 550
500sub eval { 551sub eval {
501 my ($self, $code, @args) = @_; 552 my ($self, $code, @args) = @_;
502 553
503 $self->_cmd (e => $code, @args); 554 $self->_cmd (e => pack "(w/a*)*", $code, @args);
504 555
505 $self 556 $self
506} 557}
507 558
508=item $proc = $proc->require ($module, ...) 559=item $proc = $proc->require ($module, ...)
… …
568=cut 619=cut
569 620
570sub send_arg { 621sub send_arg {
571 my ($self, @arg) = @_; 622 my ($self, @arg) = @_;
572 623
573 $self->_cmd (a => @arg); 624 $self->_cmd (a => pack "(w/a*)*", @arg);
574 625
575 $self 626 $self
576} 627}
577 628
578=item $proc->run ($func, $cb->($fh)) 629=item $proc->run ($func, $cb->($fh))
579 630
580Enter the function specified by the fully qualified name in C<$func> in 631Enter the function specified by the function name in C<$func> in the
581the process. The function is called with the communication socket as first 632process. The function is called with the communication socket as first
582argument, followed by all file handles and string arguments sent earlier 633argument, followed by all file handles and string arguments sent earlier
583via C<send_fh> and C<send_arg> methods, in the order they were called. 634via C<send_fh> and C<send_arg> methods, in the order they were called.
584 635
585If the called function returns, the process exits. 636The function name should be fully qualified, but if it isn't, it will be
637looked up in the main package.
586 638
587Preparing the process can take time - when the process is ready, the 639If the called function returns, doesn't exist, or any error occurs, the
640process exits.
641
642Preparing the process is done in the background - when all commands have
588callback is invoked with the local communications socket as argument. 643been sent, the callback is invoked with the local communications socket
644as argument. At this point you can start using the socket in any way you
645like.
589 646
590The process object becomes unusable on return from this function. 647The process object becomes unusable on return from this function - any
648further method calls result in undefined behaviour.
591 649
592If the communication socket isn't used, it should be closed on both sides, 650If the communication socket isn't used, it should be closed on both sides,
593to save on kernel memory. 651to save on kernel memory.
594 652
595The socket is non-blocking in the parent, and blocking in the newly 653The socket is non-blocking in the parent, and blocking in the newly
596created process. The close-on-exec flag is set on both. Even if not used 654created process. The close-on-exec flag is set in both.
655
597otherwise, the socket can be a good indicator for the existence of the 656Even if not used otherwise, the socket can be a good indicator for the
598process - if the other process exits, you get a readable event on it, 657existence of the process - if the other process exits, you get a readable
599because exiting the process closes the socket (if it didn't create any 658event on it, because exiting the process closes the socket (if it didn't
600children using fork). 659create any children using fork).
601 660
602Example: create a template for a process pool, pass a few strings, some 661Example: create a template for a process pool, pass a few strings, some
603file handles, then fork, pass one more string, and run some code. 662file handles, then fork, pass one more string, and run some code.
604 663
605 my $pool = AnyEvent::Fork 664 my $pool = AnyEvent::Fork
… …
613 ->send_arg ("str3") 672 ->send_arg ("str3")
614 ->run ("Some::function", sub { 673 ->run ("Some::function", sub {
615 my ($fh) = @_; 674 my ($fh) = @_;
616 675
617 # fh is nonblocking, but we trust that the OS can accept these 676 # fh is nonblocking, but we trust that the OS can accept these
618 # extra 3 octets anyway. 677 # few octets anyway.
619 syswrite $fh, "hi #$_\n"; 678 syswrite $fh, "hi #$_\n";
620 679
621 # $fh is being closed here, as we don't store it anywhere 680 # $fh is being closed here, as we don't store it anywhere
622 }); 681 });
623 } 682 }
… …
625 # Some::function might look like this - all parameters passed before fork 684 # Some::function might look like this - all parameters passed before fork
626 # and after will be passed, in order, after the communications socket. 685 # and after will be passed, in order, after the communications socket.
627 sub Some::function { 686 sub Some::function {
628 my ($fh, $str1, $str2, $fh1, $fh2, $str3) = @_; 687 my ($fh, $str1, $str2, $fh1, $fh2, $str3) = @_;
629 688
630 print scalar <$fh>; # prints "hi 1\n" and "hi 2\n" 689 print scalar <$fh>; # prints "hi #1\n" and "hi #2\n" in any order
631 } 690 }
632 691
633=cut 692=cut
634 693
635sub run { 694sub run {
636 my ($self, $func, $cb) = @_; 695 my ($self, $func, $cb) = @_;
637 696
638 $self->[0] = $cb; 697 $self->[4] = $cb;
639 $self->_cmd (r => $func); 698 $self->_cmd (r => $func);
640} 699}
641 700
642=back 701=back
643 702
… …
690This section lists typical problems that remain. I hope by recognising 749This section lists typical problems that remain. I hope by recognising
691them, most can be avoided. 750them, most can be avoided.
692 751
693=over 4 752=over 4
694 753
695=item exit runs destructors
696
697=item "leaked" file descriptors for exec'ed processes 754=item "leaked" file descriptors for exec'ed processes
698 755
699POSIX systems inherit file descriptors by default when exec'ing a new 756POSIX systems inherit file descriptors by default when exec'ing a new
700process. While perl itself laudably sets the close-on-exec flags on new 757process. While perl itself laudably sets the close-on-exec flags on new
701file handles, most C libraries don't care, and even if all cared, it's 758file handles, most C libraries don't care, and even if all cared, it's
… …
741 798
742The solution is to either not load these modules before use'ing 799The solution is to either not load these modules before use'ing
743L<AnyEvent::Fork::Early> or L<AnyEvent::Fork::Template>, or to delay 800L<AnyEvent::Fork::Early> or L<AnyEvent::Fork::Template>, or to delay
744initialising them, for example, by calling C<init Gtk2> manually. 801initialising them, for example, by calling C<init Gtk2> manually.
745 802
803=item exit runs destructors
804
805This only applies to users of Lc<AnyEvent::Fork:Early> and
806L<AnyEvent::Fork::Template>.
807
808When a process created by AnyEvent::Fork exits, it might do so by calling
809exit, or simply letting perl reach the end of the program. At which point
810Perl runs all destructors.
811
812Not all destructors are fork-safe - for example, an object that represents
813the connection to an X display might tell the X server to free resources,
814which is inconvenient when the "real" object in the parent still needs to
815use them.
816
817This is obviously not a problem for L<AnyEvent::Fork::Early>, as you used
818it as the very first thing, right?
819
820It is a problem for L<AnyEvent::Fork::Template> though - and the solution
821is to not create objects with nontrivial destructors that might have an
822effect outside of Perl.
823
746=back 824=back
747 825
748=head1 PORTABILITY NOTES 826=head1 PORTABILITY NOTES
749 827
750Native win32 perls are somewhat supported (AnyEvent::Fork::Early is a nop, 828Native win32 perls are somewhat supported (AnyEvent::Fork::Early is a nop,

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines