Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 186 lines (147 sloc) 6.094 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185
#!/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;
Something went wrong with that request. Please try again.