Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 187 lines (148 sloc) 6.151 kb
a8879dc @perigrin add benchmarking scripts
authored
1 #!/usr/bin/perl -w -I..
2 # $Id: forkbomb.perl 1746 2005-01-28 22:57:30Z rcaputo $
3
4 # This is another of the earlier test programs. It creates a single
5 # session whose job is to create more of itself. There is a built-in
6 # limit of 200 sessions, after which they all politely stop.
7
8 # This program's main purpose in life is to test POE's parent/child
9 # relationships, signal propagation and garbage collection.
10
11 use strict;
12 use lib '../lib';
13
14 sub POE::Kernel::ASSERT_DEFAULT () { 1 }
15
16 use POE;
17
18 #==============================================================================
19 # These subs implement the guts of a forkbomb session. Its only
20 # mission in life is to spawn more of itself until it dies.
21
22 my $count = 0; # session counter for limiting runtime
23
24 #------------------------------------------------------------------------------
25 # This sub handles POE's standard _start event. It initializes the
26 # session.
27
28 sub _start {
29 my ($kernel, $heap) = @_[KERNEL, HEAP];
30 # assign the next count to this session
31 $heap->{'id'} = ++$count;
32 printf "%4d has started.\n", $heap->{'id'};
33 # register signal handlers
34 $kernel->sig('INT', 'signal_handler');
35 $kernel->sig('ZOMBIE', 'signal_handler');
36 # start forking
37 $kernel->yield('fork');
38 # return something interesting
39 return "i am $heap->{'id'}";
40 }
41
42 #------------------------------------------------------------------------------
43 # This sub handles POE's standard _stop event. It acknowledges that
44 # the session is stopped.
45
46 sub _stop {
47 printf "%4d has stopped.\n", $_[HEAP]->{'id'};
48 }
49
50 #------------------------------------------------------------------------------
51 # This sub handles POE's standard _child event. It acknowledges that
52 # the session is gaining or losing a child session.
53
54 my %english = ( lose => 'is losing',
55 gain => 'is gaining',
56 create => 'has created'
57 );
58
59 sub _child {
60 my ($kernel, $heap, $direction, $child, $return) =
61 @_[KERNEL, HEAP, ARG0, ARG1, ARG2];
62
63 printf( "%4d %s child %s%s\n",
64 $heap->{'id'},
65 $english{$direction},
66 $kernel->call($child, 'fetch_id'),
67 (($direction eq 'create') ? (" (child returned: $return)") : '')
68 );
69 }
70
71 #------------------------------------------------------------------------------
72 # This sub handles POE's standard _parent event. It acknowledges that
73 # the child session's parent is changing.
74
75 sub _parent {
76 my ($kernel, $heap, $old_parent, $new_parent) = @_[KERNEL, HEAP, ARG0, ARG1];
77 printf( "%4d parent is changing from %d to %d\n",
78 $heap->{'id'},
79 $kernel->call($old_parent, 'fetch_id'),
80 $kernel->call($new_parent, 'fetch_id')
81 );
82 }
83
84 #------------------------------------------------------------------------------
85 # This sub acknowledges receipt of signals. It's registered as the
86 # handler for SIGINT and SIGZOMBIE. It returns 0 to tell the kernel
87 # that the signals were not handled. This causes the kernel to stop
88 # the session for certain "terminal" signals (such as SIGINT).
89
90 sub signal_handler {
91 my ($heap, $signal_name) = @_[HEAP, ARG0];
92 printf( "%4d has received SIG%s\n", $heap->{'id'}, $signal_name);
93 # tell Kernel that this wasn't handled
94 return 0;
95 }
96
97 #------------------------------------------------------------------------------
98 # This is the main part of the test. This state uses the yield()
99 # function to loop until certain conditions are met.
100
c3322a5 update the benchmark scripts so they are more intensive
Chris Prather authored
101 my $max_sessions = 800;
a8879dc @perigrin add benchmarking scripts
authored
102 my $half_sessions = int($max_sessions / 2);
103
104 sub fork {
105 my ($kernel, $heap) = @_[KERNEL, HEAP];
106
107 # Only consider continuing if the maximum number of sessions has not
108 # yet been reached.
109
110 if ($count < $max_sessions) {
111 # flip a coin; heads == spawn
112 if (rand() < 0.5) {
113 printf "%4d is starting a new child...\n", $heap->{'id'};
114 &create_new_forkbomber();
115 }
116 # tails == don't spawn
117 else {
118 printf "%4d is just spinning its wheels this time...\n", $heap->{'id'};
119 }
120
121 # Randomly decide to die (or not) if half the sessions have been
122 # reached.
123
124 if (($count < $half_sessions) || (rand() < 0.05)) {
125 $kernel->yield('fork');
126 }
127 else {
128 printf "%4d has decided to die. Bye!\n", $heap->{'id'};
129
130 # NOTE: Child sessions will keep a parent session alive.
131 # Because of this, the program forces a stop by sending itself a
132 # _stop event. This normally isn't necessary.
133
134 # NOTE: The main session (#1) is allowed to linger. This
135 # prevents strange things from happening when it exits
136 # prematurely.
137
138 if ($heap->{'id'} != 1) {
139 $kernel->yield('_stop');
140 }
141 }
142 }
143 else {
144 printf "%4d notes that the session limit is met. Bye!\n", $heap->{'id'};
145
146 # Please see the two NOTEs above.
147
148 if ($heap->{'id'} != 1) {
149 $kernel->yield('_stop');
150 }
151 }
152 }
153
154 #------------------------------------------------------------------------------
155 # This is a helper event handler. It is called directly by parents
156 # and children to help identify the sessions being given or taken
157 # away. It is just a public interface to the session's numeric ID.
158
159 sub fetch_id {
160 return $_[HEAP]->{'id'};
161 }
162
163 #==============================================================================
164 # This is a helper function that creates a new forkbomber session.
165
166 sub create_new_forkbomber {
167 POE::Session->create(
168 inline_states => {
169 '_start' => \&_start,
170 '_stop' => \&_stop,
171 '_child' => \&_child,
172 '_parent' => \&_parent,
173 'signal_handler' => \&signal_handler,
174 'fork' => \&fork,
175 'fetch_id' => \&fetch_id,
176 }
177 );
178 }
179
180 #==============================================================================
181 # Create the initial forkbomber session, and run the kernel.
182
183 &create_new_forkbomber();
184 $poe_kernel->run();
185
186 exit;
Something went wrong with that request. Please try again.