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 $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);

   # 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

Win32 is a loser - code has been written for this platform, pain has been
felt, but in the end, this platform is just too broken - maybe a later
version can do it.

=head1 AUTHOR

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

=cut

1

Revision:	1.9
Committed:	Thu Apr 4 03:45:12 2013 UTC (11 years, 2 months ago) by root
Branch:	MAIN
Changes since 1.8:	+179 -12 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3	root	1.4	AnyEvent::Fork - everything you wanted to use fork() for, but couldn't
4	root	1.1
5	root	1.9	ATTENTION, this is a very early release, and very untested. Consider it a
6			technology preview.
7
8	root	1.1	=head1 SYNOPSIS
9
10	root	1.4	use AnyEvent::Fork;
11	root	1.1
12	root	1.9	##################################################################
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	root	1.1	=head1 DESCRIPTION
70
71	root	1.4	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	root	1.1
81	root	1.5	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	root	1.1	=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	root	1.3	=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	root	1.9	Example:
177
178			AnyEvent::Fork
179			->new
180			->require ("Some::Module")
181			->run ("Some::Module::run", sub {
182			my ($fork_fh) = @_;
183			});
184
185	root	1.3	=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	root	1.9	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	root	1.3	=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	root	1.9	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	root	1.3	=back
235
236			=head1 FUNCTIONS
237
238	root	1.1	=over 4
239
240			=cut
241
242	root	1.4	package AnyEvent::Fork;
243	root	1.1
244			use common::sense;
245
246			use Socket ();
247
248			use AnyEvent;
249	root	1.4	use AnyEvent::Fork::Util;
250	root	1.1	use AnyEvent::Util ();
251
252	root	1.4	our $PERL; # the path to the perl interpreter, deduces with various forms of magic
253	root	1.1
254	root	1.4	=item my $pool = new AnyEvent::Fork key => value...
255	root	1.1
256			Create a new process pool. The following named parameters are supported:
257
258			=over 4
259
260			=back
261
262			=cut
263
264	root	1.5	# the early fork template process
265			our $EARLY;
266
267	root	1.4	# the empty template process
268			our $TEMPLATE;
269
270			sub _cmd {
271			my $self = shift;
272
273	root	1.9	#TODO: maybe append the packet to any existing string command already in the queue
274
275	root	1.4	# ideally, we would want to use "a (w/a)*" as format string, but perl versions
276	root	1.5	# from at least 5.8.9 to 5.16.3 are all buggy and can't unpack it.
277	root	1.4	push @{ $self->[2] }, pack "N/a", pack "(w/a)*", @_;
278
279			$self->[3] \|\|= AE::io $self->[1], 1, sub {
280	root	1.9	# send the next "thing" in the queue - either a reference to an fh,
281			# or a plain string.
282
283	root	1.4	if (ref $self->[2][0]) {
284	root	1.9	# send fh
285	root	1.4	AnyEvent::Fork::Util::fd_send fileno $self->[1], fileno ${ $self->[2][0] }
286			and shift @{ $self->[2] };
287	root	1.5
288	root	1.4	} else {
289	root	1.9	# send string
290	root	1.4	my $len = syswrite $self->[1], $self->[2][0]
291			or do { undef $self->[3]; die "AnyEvent::Fork: command write failure: $!" };
292	root	1.5
293	root	1.4	substr $self->[2][0], 0, $len, "";
294			shift @{ $self->[2] } unless length $self->[2][0];
295			}
296
297			unless (@{ $self->[2] }) {
298			undef $self->[3];
299	root	1.9	# invoke run callback
300	root	1.4	$self->[0]->($self->[1]) if $self->[0];
301			}
302			};
303			}
304	root	1.1
305	root	1.4	sub _new {
306			my ($self, $fh) = @_;
307	root	1.1
308	root	1.6	AnyEvent::Util::fh_nonblocking $fh, 1;
309
310	root	1.4	$self = bless [
311			undef, # run callback
312	root	1.1	$fh,
313	root	1.4	[], # write queue - strings or fd's
314			undef, # AE watcher
315			], $self;
316
317			$self
318	root	1.1	}
319
320	root	1.6	# fork template from current process, used by AnyEvent::Fork::Early/Template
321			sub _new_fork {
322			my ($fh, $slave) = AnyEvent::Util::portable_socketpair;
323	root	1.7	my $parent = $$;
324
325	root	1.6	my $pid = fork;
326
327			if ($pid eq 0) {
328			require AnyEvent::Fork::Serve;
329	root	1.7	$AnyEvent::Fork::Serve::OWNER = $parent;
330	root	1.6	close $fh;
331	root	1.7	$0 = "$_[1] of $parent";
332	root	1.6	AnyEvent::Fork::Serve::serve ($slave);
333			AnyEvent::Fork::Util::_exit 0;
334			} elsif (!$pid) {
335			die "AnyEvent::Fork::Early/Template: unable to fork template process: $!";
336			}
337
338			AnyEvent::Fork->_new ($fh)
339			}
340
341	root	1.4	=item my $proc = new AnyEvent::Fork
342	root	1.1
343	root	1.4	Create a new "empty" perl interpreter process and returns its process
344			object for further manipulation.
345	root	1.1
346	root	1.4	The new process is forked from a template process that is kept around
347			for this purpose. When it doesn't exist yet, it is created by a call to
348			C<new_exec> and kept around for future calls.
349
350	root	1.9	When the process object is destroyed, it will release the file handle
351			that connects it with the new process. When the new process has not yet
352			called C<run>, then the process will exit. Otherwise, what happens depends
353			entirely on the code that is executed.
354
355	root	1.4	=cut
356
357			sub new {
358			my $class = shift;
359	root	1.1
360	root	1.4	$TEMPLATE \|\|= $class->new_exec;
361			$TEMPLATE->fork
362	root	1.1	}
363
364	root	1.4	=item $new_proc = $proc->fork
365
366			Forks C<$proc>, creating a new process, and returns the process object
367			of the new process.
368
369			If any of the C<send_> functions have been called before fork, then they
370			will be cloned in the child. For example, in a pre-forked server, you
371			might C<send_fh> the listening socket into the template process, and then
372			keep calling C<fork> and C<run>.
373
374			=cut
375
376			sub fork {
377			my ($self) = @_;
378	root	1.1
379			my ($fh, $slave) = AnyEvent::Util::portable_socketpair;
380	root	1.4
381			$self->send_fh ($slave);
382			$self->_cmd ("f");
383
384			AnyEvent::Fork->_new ($fh)
385			}
386
387			=item my $proc = new_exec AnyEvent::Fork
388
389			Create a new "empty" perl interpreter process and returns its process
390			object for further manipulation.
391
392			Unlike the C<new> method, this method I<always> spawns a new perl process
393			(except in some cases, see L<AnyEvent::Fork::Early> for details). This
394			reduces the amount of memory sharing that is possible, and is also slower.
395
396			You should use C<new> whenever possible, except when having a template
397			process around is unacceptable.
398
399			The path to the perl interpreter is divined usign various methods - first
400			C<$^X> is investigated to see if the path ends with something that sounds
401			as if it were the perl interpreter. Failing this, the module falls back to
402			using C<$Config::Config{perlpath}>.
403
404			=cut
405
406			sub new_exec {
407			my ($self) = @_;
408
409	root	1.5	return $EARLY->fork
410			if $EARLY;
411
412	root	1.4	# first find path of perl
413			my $perl = $;
414
415			# first we try $^X, but the path must be absolute (always on win32), and end in sth.
416			# that looks like perl. this obviously only works for posix and win32
417			unless (
418			(AnyEvent::Fork::Util::WIN32 \|\| $perl =~ m%^/%)
419			&& $perl =~ m%[/\\]perl(?:[0-9]+(\.[0-9]+)+)?(\.exe)?$%i
420			) {
421			# if it doesn't look perlish enough, try Config
422			require Config;
423			$perl = $Config::Config{perlpath};
424			$perl =~ s/(?:\Q$Config::Config{_exe}\E)?$/$Config::Config{_exe}/;
425			}
426
427			require Proc::FastSpawn;
428
429			my ($fh, $slave) = AnyEvent::Util::portable_socketpair;
430			Proc::FastSpawn::fd_inherit (fileno $slave);
431
432			# quick. also doesn't work in win32. of course. what did you expect
433			#local $ENV{PERL5LIB} = join ":", grep !ref, @INC;
434	root	1.1	my %env = %ENV;
435	root	1.8	$env{PERL5LIB} = join +(AnyEvent::Fork::Util::WIN32 ? ";" : ":"), grep !ref, @INC;
436	root	1.1
437	root	1.4	Proc::FastSpawn::spawn (
438			$perl,
439	root	1.7	["perl", "-MAnyEvent::Fork::Serve", "-e", "AnyEvent::Fork::Serve::me", fileno $slave, $$],
440	root	1.4	[map "$_=$env{$_}", keys %env],
441			) or die "unable to spawn AnyEvent::Fork server: $!";
442
443			$self->_new ($fh)
444			}
445
446	root	1.9	=item $proc = $proc->eval ($perlcode, @args)
447
448			Evaluates the given C<$perlcode> as ... perl code, while setting C<@_> to
449			the strings specified by C<@args>.
450
451			This call is meant to do any custom initialisation that might be required
452			(for example, the C<require> method uses it). It's not supposed to be used
453			to completely take over the process, use C<run> for that.
454
455			The code will usually be executed after this call returns, and there is no
456			way to pass anything back to the calling process. Any evaluation errors
457			will be reported to stderr and cause the process to exit.
458
459			Returns the process object for easy chaining of method calls.
460
461			=cut
462
463			sub eval {
464			my ($self, $code, @args) = @_;
465
466			$self->_cmd (e => $code, @args);
467
468			$self
469			}
470
471	root	1.4	=item $proc = $proc->require ($module, ...)
472	root	1.1
473	root	1.9	Tries to load the given module(s) into the process
474	root	1.1
475	root	1.4	Returns the process object for easy chaining of method calls.
476	root	1.1
477	root	1.9	=cut
478
479			sub require {
480			my ($self, @modules) = @_;
481
482			s%::%/%g for @modules;
483			$self->eval ('require "$_.pm" for @_', @modules);
484
485			$self
486			}
487
488	root	1.4	=item $proc = $proc->send_fh ($handle, ...)
489	root	1.1
490	root	1.4	Send one or more file handles (I<not> file descriptors) to the process,
491			to prepare a call to C<run>.
492	root	1.1
493	root	1.4	The process object keeps a reference to the handles until this is done,
494			so you must not explicitly close the handles. This is most easily
495			accomplished by simply not storing the file handles anywhere after passing
496			them to this method.
497
498			Returns the process object for easy chaining of method calls.
499
500	root	1.9	Example: pass an fh to a process, and release it without closing. it will
501			be closed automatically when it is no longer used.
502
503			$proc->send_fh ($my_fh);
504			undef $my_fh; # free the reference if you want, but DO NOT CLOSE IT
505
506	root	1.4	=cut
507
508			sub send_fh {
509			my ($self, @fh) = @_;
510
511			for my $fh (@fh) {
512			$self->_cmd ("h");
513			push @{ $self->[2] }, \$fh;
514			}
515
516			$self
517	root	1.1	}
518
519	root	1.4	=item $proc = $proc->send_arg ($string, ...)
520
521			Send one or more argument strings to the process, to prepare a call to
522			C<run>. The strings can be any octet string.
523
524			Returns the process object for easy chaining of emthod calls.
525
526			=cut
527	root	1.1
528	root	1.4	sub send_arg {
529			my ($self, @arg) = @_;
530	root	1.1
531	root	1.4	$self->_cmd (a => @arg);
532	root	1.1
533			$self
534			}
535
536	root	1.4	=item $proc->run ($func, $cb->($fh))
537
538			Enter the function specified by the fully qualified name in C<$func> in
539			the process. The function is called with the communication socket as first
540			argument, followed by all file handles and string arguments sent earlier
541			via C<send_fh> and C<send_arg> methods, in the order they were called.
542
543			If the called function returns, the process exits.
544
545			Preparing the process can take time - when the process is ready, the
546			callback is invoked with the local communications socket as argument.
547
548			The process object becomes unusable on return from this function.
549
550			If the communication socket isn't used, it should be closed on both sides,
551			to save on kernel memory.
552
553			The socket is non-blocking in the parent, and blocking in the newly
554			created process. The close-on-exec flag is set on both. Even if not used
555			otherwise, the socket can be a good indicator for the existance of the
556	root	1.8	process - if the other process exits, you get a readable event on it,
557	root	1.4	because exiting the process closes the socket (if it didn't create any
558			children using fork).
559
560	root	1.9	Example: create a template for a process pool, pass a few strings, some
561			file handles, then fork, pass one more string, and run some code.
562
563			my $pool = AnyEvent::Fork
564			->new
565			->send_arg ("str1", "str2")
566			->send_fh ($fh1, $fh2);
567
568			for (1..2) {
569			$pool
570			->fork
571			->send_arg ("str3")
572			->run ("Some::function", sub {
573			my ($fh) = @_;
574
575			# fh is nonblocking, but we trust that the OS can accept these
576			# extra 3 octets anyway.
577			syswrite $fh, "hi #$_\n";
578
579			# $fh is being closed here, as we don't store it anywhere
580			});
581			}
582
583			# Some::function might look like this - all parameters passed before fork
584			# and after will be passed, in order, after the communications socket.
585			sub Some::function {
586			my ($fh, $str1, $str2, $fh1, $fh2, $str3) = @_;
587
588			print scalar <$fh>; # prints "hi 1\n" and "hi 2\n"
589			}
590
591	root	1.4	=cut
592
593			sub run {
594			my ($self, $func, $cb) = @_;
595
596			$self->[0] = $cb;
597	root	1.9	$self->_cmd (r => $func);
598	root	1.4	}
599
600	root	1.1	=back
601
602	root	1.8	=head1 PORTABILITY NOTES
603
604			Win32 is a loser - code has been written for this platform, pain has been
605			felt, but in the end, this platform is just too broken - maybe a later
606			version can do it.
607
608	root	1.1	=head1 AUTHOR
609
610			Marc Lehmann <schmorp@schmorp.de>
611			http://home.schmorp.de/
612
613			=cut
614
615			1
616