#!/usr/bin/perl -w -I.. # 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;