AnyEvent-Fork/Fork.pm

=head1 NAME

AnyEvent::Fork - everything you wanted to use fork() for, but couldn't

ATTENTION, this is a very early release, and very untested. Consider it a
technology preview.

=head1 SYNOPSIS

   use AnyEvent::Fork;

   ##################################################################
   # create a single new process, tell it to run your worker function

   AnyEvent::Fork
      ->new
      ->require ("MyModule")
      ->run ("MyModule::worker, sub {
         my ($master_filehandle) = @_;

         # now $master_filehandle is connected to the
         # $slave_filehandle in the new process.
      });

   # MyModule::worker might look like this
   sub MyModule::worker {
      my ($slave_filehandle) = @_;

      # now $slave_filehandle is connected to the $master_filehandle
      # in the original prorcess. have fun!
   }

   ##################################################################
   # create a pool of server processes all accepting on the same socket

   # create listener socket
   my $listener = ...;

   # create a pool template, initialise it and give it the socket
   my $pool = AnyEvent::Fork
                 ->new
                 ->require ("Some::Stuff", "My::Server")
                 ->send_fh ($listener);

   # now create 10 identical workers
   for my $id (1..10) {
      $pool
         ->fork
         ->send_arg ($id)
         ->run ("My::Server::run");
   }

   # now do other things - maybe use the filehandle provided by run
   # to wait for the processes to die. or whatever.

   # My::Server::run might look like this
   sub My::Server::run {
      my ($slave, $listener, $id) = @_;

      close $slave; # we do not use the socket, so close it to save resources

      # we could go ballistic and use e.g. AnyEvent here, or IO::AIO,
      # or anything we usually couldn't do in a process forked normally.
      while (my $socket = $listener->accept) {
         # do sth. with new socket
      }
   }

=head1 DESCRIPTION

This module allows you to create new processes, without actually forking
them from your current process (avoiding the problems of forking), but
preserving most of the advantages of fork.

It can be used to create new worker processes or new independent
subprocesses for short- and long-running jobs, process pools (e.g. for use
in pre-forked servers) but also to spawn new external processes (such as
CGI scripts from a webserver), which can be faster (and more well behaved)
than using fork+exec in big processes.

Special care has been taken to make this module useful from other modules,
while still supporting specialised environments such as L<App::Staticperl>
or L<PAR::Packer>.

=head1 PROBLEM STATEMENT

There are two ways to implement parallel processing on UNIX like operating
systems - fork and process, and fork+exec and process. They have different
advantages and disadvantages that I describe below, together with how this
module tries to mitigate the disadvantages.

=over 4

=item Forking from a big process can be very slow (a 5GB process needs
0.05s to fork on my 3.6GHz amd64 GNU/Linux box for example). This overhead
is often shared with exec (because you have to fork first), but in some
circumstances (e.g. when vfork is used), fork+exec can be much faster.

This module can help here by telling a small(er) helper process to fork,
or fork+exec instead.

=item Forking usually creates a copy-on-write copy of the parent
process. Memory (for example, modules or data files that have been
will not take additional memory). When exec'ing a new process, modules
and data files might need to be loaded again, at extra cpu and memory
cost. Likewise when forking, all data structures are copied as well - if
the program frees them and replaces them by new data, the child processes
will retain the memory even if it isn't used.

This module allows the main program to do a controlled fork, and allows
modules to exec processes safely at any time. When creating a custom
process pool you can take advantage of data sharing via fork without
risking to share large dynamic data structures that will blow up child
memory usage.

=item Exec'ing a new perl process might be difficult and slow. For
example, it is not easy to find the correct path to the perl interpreter,
and all modules have to be loaded from disk again. Long running processes
might run into problems when perl is upgraded for example.

This module supports creating pre-initialised perl processes to be used
as template, and also tries hard to identify the correct path to the perl
interpreter. With a cooperative main program, exec'ing the interpreter
might not even be necessary.

=item Forking might be impossible when a program is running. For example,
POSIX makes it almost impossible to fork from a multithreaded program and
do anything useful in the child - strictly speaking, if your perl program
uses posix threads (even indirectly via e.g. L<IO::AIO> or L<threads>),
you cannot call fork on the perl level anymore, at all.

This module can safely fork helper processes at any time, by caling
fork+exec in C, in a POSIX-compatible way.

=item Parallel processing with fork might be inconvenient or difficult
to implement. For example, when a program uses an event loop and creates
watchers it becomes very hard to use the event loop from a child
program, as the watchers already exist but are only meaningful in the
parent. Worse, a module might want to use such a system, not knowing
whether another module or the main program also does, leading to problems.

This module only lets the main program create pools by forking (because
only the main program can know when it is still safe to do so) - all other
pools are created by fork+exec, after which such modules can again be
loaded.

=back

=head1 CONCEPTS

This module can create new processes either by executing a new perl
process, or by forking from an existing "template" process.

Each such process comes with its own file handle that can be used to
communicate with it (it's actually a socket - one end in the new process,
one end in the main process), and among the things you can do in it are
load modules, fork new processes, send file handles to it, and execute
functions.

There are multiple ways to create additional processes to execute some
jobs:

=over 4

=item fork a new process from the "default" template process, load code,
run it

This module has a "default" template process which it executes when it is
needed the first time. Forking from this process shares the memory used
for the perl interpreter with the new process, but loading modules takes
time, and the memory is not shared with anything else.

This is ideal for when you only need one extra process of a kind, with the
option of starting and stipping it on demand.

Example:

   AnyEvent::Fork
      ->new
      ->require ("Some::Module")
      ->run ("Some::Module::run", sub {
         my ($fork_fh) = @_;
      });

=item fork a new template process, load code, then fork processes off of
it and run the code

When you need to have a bunch of processes that all execute the same (or
very similar) tasks, then a good way is to create a new template process
for them, loading all the modules you need, and then create your worker
processes from this new template process.

This way, all code (and data structures) that can be shared (e.g. the
modules you loaded) is shared between the processes, and each new process
consumes relatively little memory of its own.

The disadvantage of this approach is that you need to create a template
process for the sole purpose of forking new processes from it, but if you
only need a fixed number of proceses you can create them, and then destroy
the template process.

Example:

   my $template = AnyEvent::Fork->new->require ("Some::Module");
   
   for (1..10) {
      $template->fork->run ("Some::Module::run", sub {
         my ($fork_fh) = @_;
      });
   }

   # at this point, you can keep $template around to fork new processes
   # later, or you can destroy it, which causes it to vanish.

=item execute a new perl interpreter, load some code, run it

This is relatively slow, and doesn't allow you to share memory between
multiple processes.

The only advantage is that you don't have to have a template process
hanging around all the time to fork off some new processes, which might be
an advantage when there are long time spans where no extra processes are
needed.

Example:

   AnyEvent::Fork
      ->new_exec
      ->require ("Some::Module")
      ->run ("Some::Module::run", sub {
         my ($fork_fh) = @_;
      });

=back

=head1 FUNCTIONS

=over 4

=cut

package AnyEvent::Fork;

use common::sense;

use Socket ();

use AnyEvent;
use AnyEvent::Fork::Util;
use AnyEvent::Util ();

our $VERSION = $AnyEvent::Fork::Util::VERSION;

our $PERL; # the path to the perl interpreter, deduces with various forms of magic

=item my $pool = new AnyEvent::Fork key => value...

Create a new process pool. The following named parameters are supported:

=over 4

=back

=cut

# the early fork template process
our $EARLY;

# the empty template process
our $TEMPLATE;

sub _cmd {
   my $self = shift;

   #TODO: maybe append the packet to any existing string command already in the queue

   # ideally, we would want to use "a (w/a)*" as format string, but perl versions
   # from at least 5.8.9 to 5.16.3 are all buggy and can't unpack it.
   push @{ $self->[2] }, pack "N/a*", pack "(w/a*)*", @_;

   $self->[3] ||= AE::io $self->[1], 1, sub {
      # send the next "thing" in the queue - either a reference to an fh,
      # or a plain string.

      if (ref $self->[2][0]) {
         # send fh
         AnyEvent::Fork::Util::fd_send fileno $self->[1], fileno ${ $self->[2][0] }
            and shift @{ $self->[2] };

      } else {
         # send string
         my $len = syswrite $self->[1], $self->[2][0]
            or do { undef $self->[3]; die "AnyEvent::Fork: command write failure: $!" };

         substr $self->[2][0], 0, $len, "";
         shift @{ $self->[2] } unless length $self->[2][0];
      }

      unless (@{ $self->[2] }) {
         undef $self->[3];
         # invoke run callback
         $self->[0]->($self->[1]) if $self->[0];
      }
   };
}

sub _new {
   my ($self, $fh) = @_;

   AnyEvent::Util::fh_nonblocking $fh, 1;

   $self = bless [
      undef, # run callback
      $fh,
      [],    # write queue - strings or fd's
      undef, # AE watcher
   ], $self;

   $self
}

# fork template from current process, used by AnyEvent::Fork::Early/Template
sub _new_fork {
   my ($fh, $slave) = AnyEvent::Util::portable_socketpair;
   my $parent = $$;

   my $pid = fork;

   if ($pid eq 0) {
      require AnyEvent::Fork::Serve;
      $AnyEvent::Fork::Serve::OWNER = $parent;
      close $fh;
      $0 = "$_[1] of $parent";
      AnyEvent::Fork::Serve::serve ($slave);
      AnyEvent::Fork::Util::_exit 0;
   } elsif (!$pid) {
      die "AnyEvent::Fork::Early/Template: unable to fork template process: $!";
   }

   AnyEvent::Fork->_new ($fh)
}

=item my $proc = new AnyEvent::Fork

Create a new "empty" perl interpreter process and returns its process
object for further manipulation.

The new process is forked from a template process that is kept around
for this purpose. When it doesn't exist yet, it is created by a call to
C<new_exec> and kept around for future calls.

When the process object is destroyed, it will release the file handle
that connects it with the new process. When the new process has not yet
called C<run>, then the process will exit. Otherwise, what happens depends
entirely on the code that is executed.

=cut

sub new {
   my $class = shift;

   $TEMPLATE ||= $class->new_exec;
   $TEMPLATE->fork
}

=item $new_proc = $proc->fork

Forks C<$proc>, creating a new process, and returns the process object
of the new process.

If any of the C<send_> functions have been called before fork, then they
will be cloned in the child. For example, in a pre-forked server, you
might C<send_fh> the listening socket into the template process, and then
keep calling C<fork> and C<run>.

=cut

sub fork {
   my ($self) = @_;

   my ($fh, $slave) = AnyEvent::Util::portable_socketpair;

   $self->send_fh ($slave);
   $self->_cmd ("f");

   AnyEvent::Fork->_new ($fh)
}

=item my $proc = new_exec AnyEvent::Fork

Create a new "empty" perl interpreter process and returns its process
object for further manipulation.

Unlike the C<new> method, this method I<always> spawns a new perl process
(except in some cases, see L<AnyEvent::Fork::Early> for details). This
reduces the amount of memory sharing that is possible, and is also slower.

You should use C<new> whenever possible, except when having a template
process around is unacceptable.

The path to the perl interpreter is divined usign various methods - first
C<$^X> is investigated to see if the path ends with something that sounds
as if it were the perl interpreter. Failing this, the module falls back to
using C<$Config::Config{perlpath}>.

=cut

sub new_exec {
   my ($self) = @_;

   return $EARLY->fork
      if $EARLY;

   # first find path of perl
   my $perl = $;

   # first we try $^X, but the path must be absolute (always on win32), and end in sth.
   # that looks like perl. this obviously only works for posix and win32
   unless (
      (AnyEvent::Fork::Util::WIN32 || $perl =~ m%^/%)
      && $perl =~ m%[/\\]perl(?:[0-9]+(\.[0-9]+)+)?(\.exe)?$%i
   ) {
      # if it doesn't look perlish enough, try Config
      require Config;
      $perl = $Config::Config{perlpath};
      $perl =~ s/(?:\Q$Config::Config{_exe}\E)?$/$Config::Config{_exe}/;
   }

   require Proc::FastSpawn;

   my ($fh, $slave) = AnyEvent::Util::portable_socketpair;
   Proc::FastSpawn::fd_inherit (fileno $slave);

   # new fh's should always be set cloexec (due to $^F),
   # but hey, not on win32, so we always clear the inherit flag.
   Proc::FastSpawn::fd_inherit (fileno $fh, 0);

   # quick. also doesn't work in win32. of course. what did you expect
   #local $ENV{PERL5LIB} = join ":", grep !ref, @INC;
   my %env = %ENV;
   $env{PERL5LIB} = join +(AnyEvent::Fork::Util::WIN32 ? ";" : ":"), grep !ref, @INC;

   Proc::FastSpawn::spawn (
      $perl,
      ["perl", "-MAnyEvent::Fork::Serve", "-e", "AnyEvent::Fork::Serve::me", fileno $slave, $$],
      [map "$_=$env{$_}", keys %env],
   ) or die "unable to spawn AnyEvent::Fork server: $!";

   $self->_new ($fh)
}

=item $proc = $proc->eval ($perlcode, @args)

Evaluates the given C<$perlcode> as ... perl code, while setting C<@_> to
the strings specified by C<@args>.

This call is meant to do any custom initialisation that might be required
(for example, the C<require> method uses it). It's not supposed to be used
to completely take over the process, use C<run> for that.

The code will usually be executed after this call returns, and there is no
way to pass anything back to the calling process. Any evaluation errors
will be reported to stderr and cause the process to exit.

Returns the process object for easy chaining of method calls.

=cut

sub eval {
   my ($self, $code, @args) = @_;

   $self->_cmd (e => $code, @args);

   $self
}

=item $proc = $proc->require ($module, ...)

Tries to load the given module(s) into the process

Returns the process object for easy chaining of method calls.

=cut

sub require {
   my ($self, @modules) = @_;

   s%::%/%g for @modules;
   $self->eval ('require "$_.pm" for @_', @modules);

   $self
}

=item $proc = $proc->send_fh ($handle, ...)

Send one or more file handles (I<not> file descriptors) to the process,
to prepare a call to C<run>.

The process object keeps a reference to the handles until this is done,
so you must not explicitly close the handles. This is most easily
accomplished by simply not storing the file handles anywhere after passing
them to this method.

Returns the process object for easy chaining of method calls.

Example: pass an fh to a process, and release it without closing. it will
be closed automatically when it is no longer used.

   $proc->send_fh ($my_fh);
   undef $my_fh; # free the reference if you want, but DO NOT CLOSE IT

=cut

sub send_fh {
   my ($self, @fh) = @_;

   for my $fh (@fh) {
      $self->_cmd ("h");
      push @{ $self->[2] }, \$fh;
   }

   $self
}

=item $proc = $proc->send_arg ($string, ...)

Send one or more argument strings to the process, to prepare a call to
C<run>. The strings can be any octet string.

Returns the process object for easy chaining of emthod calls.

=cut

sub send_arg {
   my ($self, @arg) = @_;

   $self->_cmd (a => @arg);

   $self
}

=item $proc->run ($func, $cb->($fh))

Enter the function specified by the fully qualified name in C<$func> in
the process. The function is called with the communication socket as first
argument, followed by all file handles and string arguments sent earlier
via C<send_fh> and C<send_arg> methods, in the order they were called.

If the called function returns, the process exits.

Preparing the process can take time - when the process is ready, the
callback is invoked with the local communications socket as argument.

The process object becomes unusable on return from this function.

If the communication socket isn't used, it should be closed on both sides,
to save on kernel memory.

The socket is non-blocking in the parent, and blocking in the newly
created process. The close-on-exec flag is set on both. Even if not used
otherwise, the socket can be a good indicator for the existance of the
process - if the other process exits, you get a readable event on it,
because exiting the process closes the socket (if it didn't create any
children using fork).

Example: create a template for a process pool, pass a few strings, some
file handles, then fork, pass one more string, and run some code.

   my $pool = AnyEvent::Fork
                 ->new
                 ->send_arg ("str1", "str2")
                 ->send_fh ($fh1, $fh2);

   for (1..2) {
      $pool
         ->fork
         ->send_arg ("str3")
         ->run ("Some::function", sub {
            my ($fh) = @_;

            # fh is nonblocking, but we trust that the OS can accept these
            # extra 3 octets anyway.
            syswrite $fh, "hi #$_\n";

            # $fh is being closed here, as we don't store it anywhere
         });
   }

   # Some::function might look like this - all parameters passed before fork
   # and after will be passed, in order, after the communications socket.
   sub Some::function {
      my ($fh, $str1, $str2, $fh1, $fh2, $str3) = @_;

      print scalar <$fh>; # prints "hi 1\n" and "hi 2\n"
   }

=cut

sub run {
   my ($self, $func, $cb) = @_;

   $self->[0] = $cb;
   $self->_cmd (r => $func);
}

=back

=head1 PORTABILITY NOTES

Native win32 perls are somewhat supported (AnyEvent::Fork::Early is a nop,
and ::Template is not going to work), and it cost a lot of blood and sweat
to make it so, mostly due to the bloody broken perl that nobody seems to
care about. The fork emulation is a bad joke - I have yet to see something
useful that you cna do with it without running into memory corruption
issues or other braindamage. Hrrrr.

Cygwin perl is not supported at the moment, as it should implement fd
passing, but doesn't, and rolling my own is hard, as cygwin doesn't
support enough functionality to do it.

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut

1

Revision:	1.12
Committed:	Thu Apr 4 07:27:09 2013 UTC (11 years, 1 month ago) by root
Branch:	MAIN
CVS Tags:	rel-0_01
Changes since 1.11:	+2 -0 lines
Log Message:	0.01
#	Content
1	=head1 NAME
2
3	AnyEvent::Fork - everything you wanted to use fork() for, but couldn't
4
5	ATTENTION, this is a very early release, and very untested. Consider it a
6	technology preview.
7
8	=head1 SYNOPSIS
9
10	use AnyEvent::Fork;
11
12	##################################################################
13	# create a single new process, tell it to run your worker function
14
15	AnyEvent::Fork
16	->new
17	->require ("MyModule")
18	->run ("MyModule::worker, sub {
19	my ($master_filehandle) = @_;
20
21	# now $master_filehandle is connected to the
22	# $slave_filehandle in the new process.
23	});
24
25	# MyModule::worker might look like this
26	sub MyModule::worker {
27	my ($slave_filehandle) = @_;
28
29	# now $slave_filehandle is connected to the $master_filehandle
30	# in the original prorcess. have fun!
31	}
32
33	##################################################################
34	# create a pool of server processes all accepting on the same socket
35
36	# create listener socket
37	my $listener = ...;
38
39	# create a pool template, initialise it and give it the socket
40	my $pool = AnyEvent::Fork
41	->new
42	->require ("Some::Stuff", "My::Server")
43	->send_fh ($listener);
44
45	# now create 10 identical workers
46	for my $id (1..10) {
47	$pool
48	->fork
49	->send_arg ($id)
50	->run ("My::Server::run");
51	}
52
53	# now do other things - maybe use the filehandle provided by run
54	# to wait for the processes to die. or whatever.
55
56	# My::Server::run might look like this
57	sub My::Server::run {
58	my ($slave, $listener, $id) = @_;
59
60	close $slave; # we do not use the socket, so close it to save resources
61
62	# we could go ballistic and use e.g. AnyEvent here, or IO::AIO,
63	# or anything we usually couldn't do in a process forked normally.
64	while (my $socket = $listener->accept) {
65	# do sth. with new socket
66	}
67	}
68
69	=head1 DESCRIPTION
70
71	This module allows you to create new processes, without actually forking
72	them from your current process (avoiding the problems of forking), but
73	preserving most of the advantages of fork.
74
75	It can be used to create new worker processes or new independent
76	subprocesses for short- and long-running jobs, process pools (e.g. for use
77	in pre-forked servers) but also to spawn new external processes (such as
78	CGI scripts from a webserver), which can be faster (and more well behaved)
79	than using fork+exec in big processes.
80
81	Special care has been taken to make this module useful from other modules,
82	while still supporting specialised environments such as L<App::Staticperl>
83	or L<PAR::Packer>.
84
85	=head1 PROBLEM STATEMENT
86
87	There are two ways to implement parallel processing on UNIX like operating
88	systems - fork and process, and fork+exec and process. They have different
89	advantages and disadvantages that I describe below, together with how this
90	module tries to mitigate the disadvantages.
91
92	=over 4
93
94	=item Forking from a big process can be very slow (a 5GB process needs
95	0.05s to fork on my 3.6GHz amd64 GNU/Linux box for example). This overhead
96	is often shared with exec (because you have to fork first), but in some
97	circumstances (e.g. when vfork is used), fork+exec can be much faster.
98
99	This module can help here by telling a small(er) helper process to fork,
100	or fork+exec instead.
101
102	=item Forking usually creates a copy-on-write copy of the parent
103	process. Memory (for example, modules or data files that have been
104	will not take additional memory). When exec'ing a new process, modules
105	and data files might need to be loaded again, at extra cpu and memory
106	cost. Likewise when forking, all data structures are copied as well - if
107	the program frees them and replaces them by new data, the child processes
108	will retain the memory even if it isn't used.
109
110	This module allows the main program to do a controlled fork, and allows
111	modules to exec processes safely at any time. When creating a custom
112	process pool you can take advantage of data sharing via fork without
113	risking to share large dynamic data structures that will blow up child
114	memory usage.
115
116	=item Exec'ing a new perl process might be difficult and slow. For
117	example, it is not easy to find the correct path to the perl interpreter,
118	and all modules have to be loaded from disk again. Long running processes
119	might run into problems when perl is upgraded for example.
120
121	This module supports creating pre-initialised perl processes to be used
122	as template, and also tries hard to identify the correct path to the perl
123	interpreter. With a cooperative main program, exec'ing the interpreter
124	might not even be necessary.
125
126	=item Forking might be impossible when a program is running. For example,
127	POSIX makes it almost impossible to fork from a multithreaded program and
128	do anything useful in the child - strictly speaking, if your perl program
129	uses posix threads (even indirectly via e.g. L<IO::AIO> or L<threads>),
130	you cannot call fork on the perl level anymore, at all.
131
132	This module can safely fork helper processes at any time, by caling
133	fork+exec in C, in a POSIX-compatible way.
134
135	=item Parallel processing with fork might be inconvenient or difficult
136	to implement. For example, when a program uses an event loop and creates
137	watchers it becomes very hard to use the event loop from a child
138	program, as the watchers already exist but are only meaningful in the
139	parent. Worse, a module might want to use such a system, not knowing
140	whether another module or the main program also does, leading to problems.
141
142	This module only lets the main program create pools by forking (because
143	only the main program can know when it is still safe to do so) - all other
144	pools are created by fork+exec, after which such modules can again be
145	loaded.
146
147	=back
148
149	=head1 CONCEPTS
150
151	This module can create new processes either by executing a new perl
152	process, or by forking from an existing "template" process.
153
154	Each such process comes with its own file handle that can be used to
155	communicate with it (it's actually a socket - one end in the new process,
156	one end in the main process), and among the things you can do in it are
157	load modules, fork new processes, send file handles to it, and execute
158	functions.
159
160	There are multiple ways to create additional processes to execute some
161	jobs:
162
163	=over 4
164
165	=item fork a new process from the "default" template process, load code,
166	run it
167
168	This module has a "default" template process which it executes when it is
169	needed the first time. Forking from this process shares the memory used
170	for the perl interpreter with the new process, but loading modules takes
171	time, and the memory is not shared with anything else.
172
173	This is ideal for when you only need one extra process of a kind, with the
174	option of starting and stipping it on demand.
175
176	Example:
177
178	AnyEvent::Fork
179	->new
180	->require ("Some::Module")
181	->run ("Some::Module::run", sub {
182	my ($fork_fh) = @_;
183	});
184
185	=item fork a new template process, load code, then fork processes off of
186	it and run the code
187
188	When you need to have a bunch of processes that all execute the same (or
189	very similar) tasks, then a good way is to create a new template process
190	for them, loading all the modules you need, and then create your worker
191	processes from this new template process.
192
193	This way, all code (and data structures) that can be shared (e.g. the
194	modules you loaded) is shared between the processes, and each new process
195	consumes relatively little memory of its own.
196
197	The disadvantage of this approach is that you need to create a template
198	process for the sole purpose of forking new processes from it, but if you
199	only need a fixed number of proceses you can create them, and then destroy
200	the template process.
201
202	Example:
203
204	my $template = AnyEvent::Fork->new->require ("Some::Module");
205
206	for (1..10) {
207	$template->fork->run ("Some::Module::run", sub {
208	my ($fork_fh) = @_;
209	});
210	}
211
212	# at this point, you can keep $template around to fork new processes
213	# later, or you can destroy it, which causes it to vanish.
214
215	=item execute a new perl interpreter, load some code, run it
216
217	This is relatively slow, and doesn't allow you to share memory between
218	multiple processes.
219
220	The only advantage is that you don't have to have a template process
221	hanging around all the time to fork off some new processes, which might be
222	an advantage when there are long time spans where no extra processes are
223	needed.
224
225	Example:
226
227	AnyEvent::Fork
228	->new_exec
229	->require ("Some::Module")
230	->run ("Some::Module::run", sub {
231	my ($fork_fh) = @_;
232	});
233
234	=back
235
236	=head1 FUNCTIONS
237
238	=over 4
239
240	=cut
241
242	package AnyEvent::Fork;
243
244	use common::sense;
245
246	use Socket ();
247
248	use AnyEvent;
249	use AnyEvent::Fork::Util;
250	use AnyEvent::Util ();
251
252	our $VERSION = $AnyEvent::Fork::Util::VERSION;
253
254	our $PERL; # the path to the perl interpreter, deduces with various forms of magic
255
256	=item my $pool = new AnyEvent::Fork key => value...
257
258	Create a new process pool. The following named parameters are supported:
259
260	=over 4
261
262	=back
263
264	=cut
265
266	# the early fork template process
267	our $EARLY;
268
269	# the empty template process
270	our $TEMPLATE;
271
272	sub _cmd {
273	my $self = shift;
274
275	#TODO: maybe append the packet to any existing string command already in the queue
276
277	# ideally, we would want to use "a (w/a)*" as format string, but perl versions
278	# from at least 5.8.9 to 5.16.3 are all buggy and can't unpack it.
279	push @{ $self->[2] }, pack "N/a", pack "(w/a)*", @_;
280
281	$self->[3] \|\|= AE::io $self->[1], 1, sub {
282	# send the next "thing" in the queue - either a reference to an fh,
283	# or a plain string.
284
285	if (ref $self->[2][0]) {
286	# send fh
287	AnyEvent::Fork::Util::fd_send fileno $self->[1], fileno ${ $self->[2][0] }
288	and shift @{ $self->[2] };
289
290	} else {
291	# send string
292	my $len = syswrite $self->[1], $self->[2][0]
293	or do { undef $self->[3]; die "AnyEvent::Fork: command write failure: $!" };
294
295	substr $self->[2][0], 0, $len, "";
296	shift @{ $self->[2] } unless length $self->[2][0];
297	}
298
299	unless (@{ $self->[2] }) {
300	undef $self->[3];
301	# invoke run callback
302	$self->[0]->($self->[1]) if $self->[0];
303	}
304	};
305	}
306
307	sub _new {
308	my ($self, $fh) = @_;
309
310	AnyEvent::Util::fh_nonblocking $fh, 1;
311
312	$self = bless [
313	undef, # run callback
314	$fh,
315	[], # write queue - strings or fd's
316	undef, # AE watcher
317	], $self;
318
319	$self
320	}
321
322	# fork template from current process, used by AnyEvent::Fork::Early/Template
323	sub _new_fork {
324	my ($fh, $slave) = AnyEvent::Util::portable_socketpair;
325	my $parent = $$;
326
327	my $pid = fork;
328
329	if ($pid eq 0) {
330	require AnyEvent::Fork::Serve;
331	$AnyEvent::Fork::Serve::OWNER = $parent;
332	close $fh;
333	$0 = "$_[1] of $parent";
334	AnyEvent::Fork::Serve::serve ($slave);
335	AnyEvent::Fork::Util::_exit 0;
336	} elsif (!$pid) {
337	die "AnyEvent::Fork::Early/Template: unable to fork template process: $!";
338	}
339
340	AnyEvent::Fork->_new ($fh)
341	}
342
343	=item my $proc = new AnyEvent::Fork
344
345	Create a new "empty" perl interpreter process and returns its process
346	object for further manipulation.
347
348	The new process is forked from a template process that is kept around
349	for this purpose. When it doesn't exist yet, it is created by a call to
350	C<new_exec> and kept around for future calls.
351
352	When the process object is destroyed, it will release the file handle
353	that connects it with the new process. When the new process has not yet
354	called C<run>, then the process will exit. Otherwise, what happens depends
355	entirely on the code that is executed.
356
357	=cut
358
359	sub new {
360	my $class = shift;
361
362	$TEMPLATE \|\|= $class->new_exec;
363	$TEMPLATE->fork
364	}
365
366	=item $new_proc = $proc->fork
367
368	Forks C<$proc>, creating a new process, and returns the process object
369	of the new process.
370
371	If any of the C<send_> functions have been called before fork, then they
372	will be cloned in the child. For example, in a pre-forked server, you
373	might C<send_fh> the listening socket into the template process, and then
374	keep calling C<fork> and C<run>.
375
376	=cut
377
378	sub fork {
379	my ($self) = @_;
380
381	my ($fh, $slave) = AnyEvent::Util::portable_socketpair;
382
383	$self->send_fh ($slave);
384	$self->_cmd ("f");
385
386	AnyEvent::Fork->_new ($fh)
387	}
388
389	=item my $proc = new_exec AnyEvent::Fork
390
391	Create a new "empty" perl interpreter process and returns its process
392	object for further manipulation.
393
394	Unlike the C<new> method, this method I<always> spawns a new perl process
395	(except in some cases, see L<AnyEvent::Fork::Early> for details). This
396	reduces the amount of memory sharing that is possible, and is also slower.
397
398	You should use C<new> whenever possible, except when having a template
399	process around is unacceptable.
400
401	The path to the perl interpreter is divined usign various methods - first
402	C<$^X> is investigated to see if the path ends with something that sounds
403	as if it were the perl interpreter. Failing this, the module falls back to
404	using C<$Config::Config{perlpath}>.
405
406	=cut
407
408	sub new_exec {
409	my ($self) = @_;
410
411	return $EARLY->fork
412	if $EARLY;
413
414	# first find path of perl
415	my $perl = $;
416
417	# first we try $^X, but the path must be absolute (always on win32), and end in sth.
418	# that looks like perl. this obviously only works for posix and win32
419	unless (
420	(AnyEvent::Fork::Util::WIN32 \|\| $perl =~ m%^/%)
421	&& $perl =~ m%[/\\]perl(?:[0-9]+(\.[0-9]+)+)?(\.exe)?$%i
422	) {
423	# if it doesn't look perlish enough, try Config
424	require Config;
425	$perl = $Config::Config{perlpath};
426	$perl =~ s/(?:\Q$Config::Config{_exe}\E)?$/$Config::Config{_exe}/;
427	}
428
429	require Proc::FastSpawn;
430
431	my ($fh, $slave) = AnyEvent::Util::portable_socketpair;
432	Proc::FastSpawn::fd_inherit (fileno $slave);
433
434	# new fh's should always be set cloexec (due to $^F),
435	# but hey, not on win32, so we always clear the inherit flag.
436	Proc::FastSpawn::fd_inherit (fileno $fh, 0);
437
438	# quick. also doesn't work in win32. of course. what did you expect
439	#local $ENV{PERL5LIB} = join ":", grep !ref, @INC;
440	my %env = %ENV;
441	$env{PERL5LIB} = join +(AnyEvent::Fork::Util::WIN32 ? ";" : ":"), grep !ref, @INC;
442
443	Proc::FastSpawn::spawn (
444	$perl,
445	["perl", "-MAnyEvent::Fork::Serve", "-e", "AnyEvent::Fork::Serve::me", fileno $slave, $$],
446	[map "$_=$env{$_}", keys %env],
447	) or die "unable to spawn AnyEvent::Fork server: $!";
448
449	$self->_new ($fh)
450	}
451
452	=item $proc = $proc->eval ($perlcode, @args)
453
454	Evaluates the given C<$perlcode> as ... perl code, while setting C<@_> to
455	the strings specified by C<@args>.
456
457	This call is meant to do any custom initialisation that might be required
458	(for example, the C<require> method uses it). It's not supposed to be used
459	to completely take over the process, use C<run> for that.
460
461	The code will usually be executed after this call returns, and there is no
462	way to pass anything back to the calling process. Any evaluation errors
463	will be reported to stderr and cause the process to exit.
464
465	Returns the process object for easy chaining of method calls.
466
467	=cut
468
469	sub eval {
470	my ($self, $code, @args) = @_;
471
472	$self->_cmd (e => $code, @args);
473
474	$self
475	}
476
477	=item $proc = $proc->require ($module, ...)
478
479	Tries to load the given module(s) into the process
480
481	Returns the process object for easy chaining of method calls.
482
483	=cut
484
485	sub require {
486	my ($self, @modules) = @_;
487
488	s%::%/%g for @modules;
489	$self->eval ('require "$_.pm" for @_', @modules);
490
491	$self
492	}
493
494	=item $proc = $proc->send_fh ($handle, ...)
495
496	Send one or more file handles (I<not> file descriptors) to the process,
497	to prepare a call to C<run>.
498
499	The process object keeps a reference to the handles until this is done,
500	so you must not explicitly close the handles. This is most easily
501	accomplished by simply not storing the file handles anywhere after passing
502	them to this method.
503
504	Returns the process object for easy chaining of method calls.
505
506	Example: pass an fh to a process, and release it without closing. it will
507	be closed automatically when it is no longer used.
508
509	$proc->send_fh ($my_fh);
510	undef $my_fh; # free the reference if you want, but DO NOT CLOSE IT
511
512	=cut
513
514	sub send_fh {
515	my ($self, @fh) = @_;
516
517	for my $fh (@fh) {
518	$self->_cmd ("h");
519	push @{ $self->[2] }, \$fh;
520	}
521
522	$self
523	}
524
525	=item $proc = $proc->send_arg ($string, ...)
526
527	Send one or more argument strings to the process, to prepare a call to
528	C<run>. The strings can be any octet string.
529
530	Returns the process object for easy chaining of emthod calls.
531
532	=cut
533
534	sub send_arg {
535	my ($self, @arg) = @_;
536
537	$self->_cmd (a => @arg);
538
539	$self
540	}
541
542	=item $proc->run ($func, $cb->($fh))
543
544	Enter the function specified by the fully qualified name in C<$func> in
545	the process. The function is called with the communication socket as first
546	argument, followed by all file handles and string arguments sent earlier
547	via C<send_fh> and C<send_arg> methods, in the order they were called.
548
549	If the called function returns, the process exits.
550
551	Preparing the process can take time - when the process is ready, the
552	callback is invoked with the local communications socket as argument.
553
554	The process object becomes unusable on return from this function.
555
556	If the communication socket isn't used, it should be closed on both sides,
557	to save on kernel memory.
558
559	The socket is non-blocking in the parent, and blocking in the newly
560	created process. The close-on-exec flag is set on both. Even if not used
561	otherwise, the socket can be a good indicator for the existance of the
562	process - if the other process exits, you get a readable event on it,
563	because exiting the process closes the socket (if it didn't create any
564	children using fork).
565
566	Example: create a template for a process pool, pass a few strings, some
567	file handles, then fork, pass one more string, and run some code.
568
569	my $pool = AnyEvent::Fork
570	->new
571	->send_arg ("str1", "str2")
572	->send_fh ($fh1, $fh2);
573
574	for (1..2) {
575	$pool
576	->fork
577	->send_arg ("str3")
578	->run ("Some::function", sub {
579	my ($fh) = @_;
580
581	# fh is nonblocking, but we trust that the OS can accept these
582	# extra 3 octets anyway.
583	syswrite $fh, "hi #$_\n";
584
585	# $fh is being closed here, as we don't store it anywhere
586	});
587	}
588
589	# Some::function might look like this - all parameters passed before fork
590	# and after will be passed, in order, after the communications socket.
591	sub Some::function {
592	my ($fh, $str1, $str2, $fh1, $fh2, $str3) = @_;
593
594	print scalar <$fh>; # prints "hi 1\n" and "hi 2\n"
595	}
596
597	=cut
598
599	sub run {
600	my ($self, $func, $cb) = @_;
601
602	$self->[0] = $cb;
603	$self->_cmd (r => $func);
604	}
605
606	=back
607
608	=head1 PORTABILITY NOTES
609
610	Native win32 perls are somewhat supported (AnyEvent::Fork::Early is a nop,
611	and ::Template is not going to work), and it cost a lot of blood and sweat
612	to make it so, mostly due to the bloody broken perl that nobody seems to
613	care about. The fork emulation is a bad joke - I have yet to see something
614	useful that you cna do with it without running into memory corruption
615	issues or other braindamage. Hrrrr.
616
617	Cygwin perl is not supported at the moment, as it should implement fd
618	passing, but doesn't, and rolling my own is hard, as cygwin doesn't
619	support enough functionality to do it.
620
621	=head1 AUTHOR
622
623	Marc Lehmann <schmorp@schmorp.de>
624	http://home.schmorp.de/
625
626	=cut
627
628	1
629