Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: remove_heap_in…
Fetching contributors…

Cannot retrieve contributors at this time

187 lines (148 sloc) 6.151 kb
#!/usr/bin/perl -w -I..
# $Id: forkbomb.perl 1746 2005-01-28 22:57:30Z rcaputo $
# 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 = 800;
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.