Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

187 lines (148 sloc) 6.101 kb
#!/usr/bin/perl -w -I..
# $Id$
# This is another of the earlier test programs. It creates a single
# session whose job is to create more of itself. There is a built-in
# limit of 200 sessions, after which they all politely stop.
# This program's main purpose in life is to test POE's parent/child
# relationships, signal propagation and garbage collection.
use strict;
use lib '../lib';
sub POE::Kernel::ASSERT_DEFAULT () { 1 }
use POE;
#==============================================================================
# These subs implement the guts of a forkbomb session. Its only
# mission in life is to spawn more of itself until it dies.
my $count = 0; # session counter for limiting runtime
#------------------------------------------------------------------------------
# This sub handles POE's standard _start event. It initializes the
# session.
sub _start {
my ($kernel, $heap) = @_[KERNEL, HEAP];
# assign the next count to this session
$heap->{'id'} = ++$count;
printf "%4d has started.\n", $heap->{'id'};
# register signal handlers
$kernel->sig('INT', 'signal_handler');
$kernel->sig('ZOMBIE', 'signal_handler');
# start forking
$kernel->yield('fork');
# return something interesting
return "i am $heap->{'id'}";
}
#------------------------------------------------------------------------------
# This sub handles POE's standard _stop event. It acknowledges that
# the session is stopped.
sub _stop {
printf "%4d has stopped.\n", $_[HEAP]->{'id'};
}
#------------------------------------------------------------------------------
# This sub handles POE's standard _child event. It acknowledges that
# the session is gaining or losing a child session.
my %english = ( lose => 'is losing',
gain => 'is gaining',
create => 'has created'
);
sub _child {
my ($kernel, $heap, $direction, $child, $return) =
@_[KERNEL, HEAP, ARG0, ARG1, ARG2];
printf( "%4d %s child %s%s\n",
$heap->{'id'},
$english{$direction},
$kernel->call($child, 'fetch_id'),
(($direction eq 'create') ? (" (child returned: $return)") : '')
);
}
#------------------------------------------------------------------------------
# This sub handles POE's standard _parent event. It acknowledges that
# the child session's parent is changing.
sub _parent {
my ($kernel, $heap, $old_parent, $new_parent) = @_[KERNEL, HEAP, ARG0, ARG1];
printf( "%4d parent is changing from %d to %d\n",
$heap->{'id'},
$kernel->call($old_parent, 'fetch_id'),
$kernel->call($new_parent, 'fetch_id')
);
}
#------------------------------------------------------------------------------
# This sub acknowledges receipt of signals. It's registered as the
# handler for SIGINT and SIGZOMBIE. It returns 0 to tell the kernel
# that the signals were not handled. This causes the kernel to stop
# the session for certain "terminal" signals (such as SIGINT).
sub signal_handler {
my ($heap, $signal_name) = @_[HEAP, ARG0];
printf( "%4d has received SIG%s\n", $heap->{'id'}, $signal_name);
# tell Kernel that this wasn't handled
return 0;
}
#------------------------------------------------------------------------------
# This is the main part of the test. This state uses the yield()
# function to loop until certain conditions are met.
my $max_sessions = 200;
my $half_sessions = int($max_sessions / 2);
sub fork {
my ($kernel, $heap) = @_[KERNEL, HEAP];
# Only consider continuing if the maximum number of sessions has not
# yet been reached.
if ($count < $max_sessions) {
# flip a coin; heads == spawn
if (rand() < 0.5) {
printf "%4d is starting a new child...\n", $heap->{'id'};
&create_new_forkbomber();
}
# tails == don't spawn
else {
printf "%4d is just spinning its wheels this time...\n", $heap->{'id'};
}
# Randomly decide to die (or not) if half the sessions have been
# reached.
if (($count < $half_sessions) || (rand() < 0.05)) {
$kernel->yield('fork');
}
else {
printf "%4d has decided to die. Bye!\n", $heap->{'id'};
# NOTE: Child sessions will keep a parent session alive.
# Because of this, the program forces a stop by sending itself a
# _stop event. This normally isn't necessary.
# NOTE: The main session (#1) is allowed to linger. This
# prevents strange things from happening when it exits
# prematurely.
if ($heap->{'id'} != 1) {
$kernel->yield('_stop');
}
}
}
else {
printf "%4d notes that the session limit is met. Bye!\n", $heap->{'id'};
# Please see the two NOTEs above.
if ($heap->{'id'} != 1) {
$kernel->yield('_stop');
}
}
}
#------------------------------------------------------------------------------
# This is a helper event handler. It is called directly by parents
# and children to help identify the sessions being given or taken
# away. It is just a public interface to the session's numeric ID.
sub fetch_id {
return $_[HEAP]->{'id'};
}
#==============================================================================
# This is a helper function that creates a new forkbomber session.
sub create_new_forkbomber {
POE::Session->create(
inline_states => {
'_start' => \&_start,
'_stop' => \&_stop,
'_child' => \&_child,
'_parent' => \&_parent,
'signal_handler' => \&signal_handler,
'fork' => \&fork,
'fetch_id' => \&fetch_id,
}
);
}
#==============================================================================
# Create the initial forkbomber session, and run the kernel.
&create_new_forkbomber();
$poe_kernel->run();
exit;
Jump to Line
Something went wrong with that request. Please try again.